; Copyright 2005-2007 Kevin Reid, under the terms of the MIT X license
; found at http://www.opensource.org/licenses/mit-license.html ................

(defpackage :e.lisp-test.compiler-seq
  (:use :cl :e.lisp-test :e.elib :e.elang :e.kernel))
(cl:in-package :e.lisp-test.compiler-seq)

(defun n (nt)
  (e.syntax::build-nodes nt))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *scope*
    (e.knot::make-scope "seqCompilerDemoScope"
      `(("any" ,+the-any-guard+)
        ("true" ,+e-true+)
        ("nullOk" ,(type-specifier-to-guard 'null))
        ("throw" ,e.knot::+the-thrower+))))
  (defparameter *layout*
    (list (cons "any"
                (make-instance 'e.compiler:value-binding :value
                  +the-any-guard+))
          (cons "true"
                (make-instance 'e.compiler:value-binding :value
                  +e-true+))
          (cons "nullOk"
                (make-instance 'e.compiler:value-binding :value
                  (type-specifier-to-guard 'null)))
          (cons "throw"
                (make-instance 'e.compiler:value-binding :value
                  e.knot::+the-thrower+)))))

(deftest e.literal
  (e.compiler.seq::sequence-expr (n '(|LiteralExpr| 1)) nil 'r)
  ((r '1))
  nil)

(deftest e.noun
  (e.compiler.seq::sequence-expr (n '(|NounExpr| "any")) *layout* 'r)
  ((r '#.+the-any-guard+))
  #.*layout*)

(deftest p.ignore
  (e.compiler.seq::sequence-patt (n '(|IgnorePattern|)) *layout* 's 'e)
  ()
  #.*layout*)

(defun ev (expr)
  (nth-value 0 (eval (e.compiler.seq::sequence-e-to-cl
                       (n expr)
                       *layout*
                       `',*scope*))))

(deftest eval.e.literal
  (ev '(|LiteralExpr| 1))
  1)

(deftest eval.e.seq
  (ev '(|SeqExpr| (|NounExpr| "any") (|LiteralExpr| 2)))
  2)

(deftest eval.define.nothing
  (ev '(|DefineExpr| (|IgnorePattern|) nil (|LiteralExpr| 0)))
  0)

(deftest eval.define.final
  (ev '(|SeqExpr| (|DefineExpr| (|FinalPattern| (|NounExpr| "x") nil)
                                nil
                                (|LiteralExpr| 0))
                  (|NounExpr| "x")))
  0)

(deftest eval.if.simple1
  (ev '(|IfExpr| (|NounExpr| "true")
                 (|LiteralExpr| "a")
                 (|LiteralExpr| "b")))
  "a")

(deftest eval.if.elaborate
  (ev '(|SeqExpr|
         (|DefineExpr| (|FinalPattern| (|NounExpr| "x") nil)
                       nil
                       (|NounExpr| "true"))
         (|IfExpr| (|DefineExpr| (|FinalPattern| (|NounExpr| "y") nil)
                                 nil
                                 (|NounExpr| "x"))
                   (|NounExpr| "x")
                   (|LiteralExpr| "b"))))
  #.+e-true+)

(deftest eval.call
  (ev '(|CallExpr| (|LiteralExpr| "a")
                   "add"
                   (|LiteralExpr| "b")))
  "ab")

(deftest eval.catch.ok
  (ev `(|CatchExpr| (|LiteralExpr| 0)
                    (|FinalPattern| (|NounExpr| "p") nil)
                    (|NounExpr| "p")))
  0)

(deftest eval.catch.nok
  (e-quote
    (ev `(|CatchExpr| (|CallExpr| (|NounExpr| "throw")
                                  "run"
                                  (|LiteralExpr| "biff"))
                      (|FinalPattern| (|NounExpr| "p") nil)
                      (|NounExpr| "p"))))
  "<sealed problem>")

(deftest pattern-has-no-side-effects.no
  (remove-if-not #'e.compiler.seq::pattern-has-no-side-effects
    (mapcar #'n '((|FinalPattern|   (|NounExpr| "a") (|NounExpr| "b"))
                  (|VarPattern|     (|NounExpr| "a") (|NounExpr| "b"))
                  (|ListPattern|)
                  (|ViaPattern| (|NounExpr| "a") (|IgnorePattern|)))))
  ())

(deftest pattern-has-no-side-effects.yes
  (remove-if #'e.compiler.seq::pattern-has-no-side-effects
    (mapcar #'n '((|FinalPattern|   (|NounExpr| "a") nil)
                  (|BindingPattern| (|NounExpr| "a"))
                  (|VarPattern|     (|NounExpr| "a") nil)
                  (|IgnorePattern|))))
  ())