giles
a774cd26c1
Defines the 10 canonical node kinds called out in the brief — literal,
var, app, lambda, let, letrec, if, match-clause, module, import — plus
predicates, ast-kind dispatch, and per-field accessors. Each node is a
tagged keyword-headed list: (:literal V), (:var N), (:app FN ARGS), …
Also lib/guest/tests/ast.sx — 33 tests exercising every constructor +
predicate + accessor, runnable via (gast-tests-run!) which returns the
{:passed :failed :total} dict the shared conformance driver expects.
PARTIAL — pending real consumers. The brief calls Step 5 "Optional —
guests may keep their own AST" and forcing lua/prolog to switch their
internal AST shape risks regressing 775 passing tests for tooling that
nothing yet calls. Both internal ASTs are untouched; lua still 185/185,
prolog still 590/590. Datalog-on-sx (in flight, see plans/datalog-on-sx.md)
will be the natural first real consumer; lua/prolog converters can land
when a cross-language tool wants them.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
64 lines
3.5 KiB
Plaintext
64 lines
3.5 KiB
Plaintext
;; 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)}))
|