(ns expand-test
  (:require [expand :as sut]
            [clojure.test :as t]
            [clojure.spec.alpha :as s]
            [scm]))

(t/deftest nearest-test
  (t/is (= '#{#{a b}}
           (sut/nearest '#{a b c}
                        '[#{a} #{a b} #{a d}]))
        "unambiguous")
  (t/is (= '#{#{a b} #{a c}}
           (sut/nearest
            '#{a b c} '[#{a} #{a b} #{a c}]))
        "ambiguous")
  (t/is (= #{}
           (sut/nearest
            '#{a b c} '[#{d} #{d e} #{f}]))
        "undefined"))

(t/deftest lookup-test
  (t/is (= [:primitive 'lambda]
           (sut/lookup #scm/stx [lambda #{}]
                       {[:global 'lambda] [:primitive 'lambda]}
                       {['lambda #{}] [:global 'lambda]})))
  (t/is (= [:primitive 'lambda]
           (sut/lookup #scm/stx [lambda #{a b c}]
                       {[:global 'lambda] [:primitive 'lambda]}
                       {['lambda #{}] [:global 'lambda]})))
  (t/is (= [:var]
           (sut/lookup #scm/stx [x #{a b c}]
                       '{[:lexical x A] [:var]
                         [:lexical x B] [:primitive lambda]}
                       '{[x #{a b}] [:lexical x A]
                         [x #{a}] [:lexical x B]}))))

(defn- expand [stx]
  (-> #:library {:name '(user)
                 :declarations [[:import '(primitives+builtins)]
                                [:begin stx]]}
      sut/expand-library
      :library/declarations
      second
      second
      scm/syntax->datum))

(t/deftest expand-test
  (t/is (thrown? Exception (expand #scm/stx x)))
  (t/testing "primitive forms"
    (t/testing "lambda"
      (t/is (= '(lambda (x) x)
               (expand #scm/stx (#scm/stx lambda
                                 #scm/stx (#scm/stx x)
                                 #scm/stx x)))))
    (t/testing "let"
      (t/is (= '(let ((x 123))
                  x)
               (expand #scm/stx (#scm/stx let
                                 #scm/stx (#scm/stx (#scm/stx x
                                                     #scm/stx 123))
                                 #scm/stx x)))))
    (t/testing "if"
      (t/is (= '(if 123 true false)
               (expand #scm/stx (#scm/stx if
                                 #scm/stx 123
                                 #scm/stx true
                                 #scm/stx false)))))))


;;; specs

(t/deftest spec-lambda-formals-test
  (t/are [x] (s/valid? ::sut/lambda-formals x)
    #scm/stx ()
    #scm/stx (#scm/stx a #scm/stx b)
    #scm/stx xs
    (scm/datum->syntax
     (scm/improper-list #scm/stx a
                        #scm/stx b))))

(t/deftest spec-prim-lambda-test
  (t/are [x] (s/valid? ::sut/prim-lambda x)
    #scm/stx (#scm/stx lambda
              #scm/stx (#scm/stx a)
              #scm/stx a)))