;; lib/guest/tests/ast.sx — exercises every constructor / predicate /
;; accessor in lib/guest/ast.sx so future ports have a stable contract
;; to point at.

(define gast-test-pass 0)
(define gast-test-fail 0)
(define gast-test-fails (list))

(define
  gast-test
  (fn (name actual expected)
    (if (= actual expected)
      (set! gast-test-pass (+ gast-test-pass 1))
      (begin
        (set! gast-test-fail (+ gast-test-fail 1))
        (append! gast-test-fails {:name name :expected expected :actual actual})))))

;; Constructors round-trip.
(gast-test "literal-int"    (ast-literal-value (ast-literal 42)) 42)
(gast-test "literal-str"    (ast-literal-value (ast-literal "hi")) "hi")
(gast-test "literal-bool"   (ast-literal-value (ast-literal true)) true)
(gast-test "var-name"       (ast-var-name (ast-var "x")) "x")
(gast-test "app-fn"         (ast-app-fn (ast-app (ast-var "f") (list (ast-literal 1)))) (ast-var "f"))
(gast-test "app-args-len"   (len (ast-app-args (ast-app (ast-var "f") (list (ast-literal 1))))) 1)
(gast-test "lambda-params"  (ast-lambda-params (ast-lambda (list "x" "y") (ast-var "x"))) (list "x" "y"))
(gast-test "lambda-body"    (ast-lambda-body (ast-lambda (list "x") (ast-var "x"))) (ast-var "x"))
(gast-test "let-bindings"   (len (ast-let-bindings (ast-let (list {:name "x" :value (ast-literal 1)}) (ast-var "x")))) 1)
(gast-test "letrec-body"    (ast-letrec-body (ast-letrec (list) (ast-literal 0))) (ast-literal 0))
(gast-test "if-test"        (ast-if-test (ast-if (ast-literal true) (ast-literal 1) (ast-literal 0))) (ast-literal true))
(gast-test "if-then"        (ast-if-then (ast-if (ast-literal true) (ast-literal 1) (ast-literal 0))) (ast-literal 1))
(gast-test "if-else"        (ast-if-else (ast-if (ast-literal true) (ast-literal 1) (ast-literal 0))) (ast-literal 0))
(gast-test "match-pattern"  (ast-match-clause-pattern (ast-match-clause "P" (ast-literal 1))) "P")
(gast-test "match-body"     (ast-match-clause-body (ast-match-clause "P" (ast-literal 1))) (ast-literal 1))
(gast-test "module-name"    (ast-module-name (ast-module "m" (list))) "m")
(gast-test "import-name"    (ast-import-name (ast-import "lib/foo")) "lib/foo")

;; Predicates fire only on matching kinds.
(gast-test "is-literal"     (ast-literal? (ast-literal 1)) true)
(gast-test "not-literal"    (ast-literal? (ast-var "x")) false)
(gast-test "is-var"         (ast-var? (ast-var "x")) true)
(gast-test "is-app"         (ast-app? (ast-app (ast-var "f") (list))) true)
(gast-test "is-lambda"      (ast-lambda? (ast-lambda (list) (ast-literal 0))) true)
(gast-test "is-let"         (ast-let? (ast-let (list) (ast-literal 0))) true)
(gast-test "is-letrec"      (ast-letrec? (ast-letrec (list) (ast-literal 0))) true)
(gast-test "is-if"          (ast-if? (ast-if (ast-literal true) (ast-literal 1) (ast-literal 0))) true)
(gast-test "is-match"       (ast-match-clause? (ast-match-clause "P" (ast-literal 1))) true)
(gast-test "is-module"      (ast-module? (ast-module "m" (list))) true)
(gast-test "is-import"      (ast-import? (ast-import "x")) true)

;; ast? recognises any canonical node.
(gast-test "ast?-literal"   (ast? (ast-literal 0)) true)
(gast-test "ast?-foreign"   (ast? (list "lua-num" 0)) false)
(gast-test "ast?-non-list"  (ast? 42) false)

;; ast-kind dispatch.
(gast-test "kind-literal"   (ast-kind (ast-literal 0)) :literal)
(gast-test "kind-import"    (ast-kind (ast-import "x")) :import)

(define gast-tests-run!
  (fn ()
    {:passed gast-test-pass
     :failed gast-test-fail
     :total  (+ gast-test-pass gast-test-fail)}))