(ns old-test
  (:require
   [clojure.core.match :refer [match]]
   [clojure.spec.alpha :as s]
   [clojure.test :as t]
   [old :as sut]))

(t/deftest scheme-base-test
  (t/is (s/valid? ::sut/environment (:env sut/scheme-base)))
  (t/is (s/valid? ::sut/symtable (:symtable sut/scheme-base))))

(t/deftest nearest-test
  #_(t/is (= [:primitive 'lambda]
           (sut/lookup ['lambda #{}]
                       sut/scheme-base-env
                       (sut/symtable-for-env sut/scheme-base-env))))
  (t/is (= [#{0 1}]
           (sut/nearest ['x #{0 1 2}]
                        [#{0} #{0 1} #{0 3}]))))

(t/deftest pattern-spec
  (t/testing "var"
    (let [pattern-var? #(match (s/conform ::pattern %)
                          [:var _] true
                          _ false)]
      (t/is (pattern-var? 'abc))
      (t/is (not (pattern-var? '_)))
      (t/is (not (pattern-var? '...)))))
  (t/testing "list"
    (t/are [l e t x] (= [l e t]
                        ((juxt :leading :ellipsis :trailing)
                         (s/conform ::pattern x)))
      nil nil nil '()
      '(a) nil nil '(a)
      '(a b) nil nil '(a b)
      '(a) 'b nil '(a b ...)
      '(a) 'b '(c) '(a b ... c)
      '(a) 'b '(c d) '(a b ... c d))
    (t/are [p] (s/invalid? ::pattern p)
      '... '(...) '(... a b c)
      '(a ... b ...)))
  (t/testing "simple data"
    (t/is (= 'a (s/conform ::patern 'a)))))

(t/deftest expand-test
  (t/testing "unbound symbol"
    (t/is (thrown? Exception (sut/expand 'x))))
  (t/testing "lambda"
    (t/is (= '(lambda (x) x)
             (sut/us-expand '(λ (x) x)))))
  (t/testing "let-syntax"
    (t/is (= '(let-syntax ((m (syntax-rules
                               ()
                               ((m) 123))))
                456)
             (sut/expand
              '(let-syntax ((m (syntax-rules
                                ()
                                ((m) 123))))
                 456)))))
  (t/testing "let"
    (t/is (= '(let ((x 123)
                    (y 456))
                (+ x y))
             (sut/us-expand
              '(let ((x 123)
                     (y 456))
                 (+ x y))))))
  (t/testing "application"
    (t/is (= '(lambda (f x) (f x))
             (sut/us-expand '(lambda (f x) (f x))))))
  (t/testing "macros"
    (t/testing "when"
      (t/is (= '(let ((x 123)) (if x 456))
               (sut/us-expand '(let ((x 123))
                                 (when x 456)))))
      (t/is (= '(let (([body #{s0}] 123))
                  (if [body #{s0}]
                    456))
               (sut/rg-expand '(let ((body 123))
                                 (when body 456))))
            "`when` does not clobber caller's scope")
      (t/is (= '(let (([x #{s0}] 123))
                  (let-syntax ((m (syntax-rules () ((m) x))))
                    (lambda ([x #{s1 s2 s0}])
                            [x #{s0 s3}])))
               (sut/rg-expand '(let ((x 123))
                                 (let-syntax ((m (syntax-rules
                                                  ()
                                                  ((m) x))))
                                   (λ (x)
                                      (m))))))
            "`when` does not capture caller's scope")
      (t/is (= '(if 123 (begin (display "hello")
                               (newline)))
               (sut/us-expand '(when 123
                                 (display "hello")
                                 (newline))))
            "`when` captures multiple"))))

(t/deftest prim-lambda-spec
  (t/is (s/valid? ::sut/prim-lambda '(lambda (x) x)))
  (t/is (s/valid? ::sut/prim-lambda '(lambda (x) (display x) (newline)))))

(t/deftest prim-let-spec
  (t/is (s/valid? ::sut/prim-let '(let ((x 123)
                                        (y 456))
                                    (+ x y)))))

(t/deftest prim-let-syntax-spec
  (t/is (s/valid? ::sut/prim-let-syntax
                  '(let-syntax ((m (syntax-rules ()
                                     ((m) 123))))
                     (m)))))

(t/deftest template-spec
  (t/is (s/valid? ::sut/template '(x ... y)))
  (t/is (s/valid? ::sut/template 123))
  (t/is (= '[:list [[:var x]
                    [:ellipsis [:var y]]
                    [:ellipsis [:var z]]
                    [:var a]
                    [:var b]
                    [:var c]]]
           (s/conform ::sut/template '(x y ... z ... a b c)))))

(t/deftest pattern-spec
  (t/is (s/valid? ::sut/pattern '(m))))

(t/deftest rule-spec
  (t/is (s/valid? ::sut/rule '((m) 123))))

(t/deftest prim-syntax-rules-spec
  (t/is (s/valid? ::sut/prim-syntax-rules
                  '(syntax-rules
                    ()
                    ((m) 123)))))

(t/deftest unify-test
  (t/are [result pattern datum] (= result (sut/unify pattern datum))
    {'a 123 'b 456} '(a b) '(123 456)
    nil '(a b) 123

    '{b [:ellipsis ([:ellipsis (1 2)] [:ellipsis (3 4)])]}
    '((b ...) ...)
    '((1 2) (3 4))

    {} '_ 123)
  (t/testing "non-matches"
    (t/are [pattern datum] (= nil (sut/unify pattern datum))
      '(a b c) '(1 2)
      '(a b c) '(1 2))))