GUEST: step 5 — lib/guest/ast.sx canonical AST shapes (kit + tests)
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>
This commit is contained in:
92
lib/guest/ast.sx
Normal file
92
lib/guest/ast.sx
Normal file
@@ -0,0 +1,92 @@
|
||||
;; lib/guest/ast.sx — canonical AST node shapes.
|
||||
;;
|
||||
;; A guest's parser may emit its own AST in whatever shape is convenient
|
||||
;; for that language's evaluator/transpiler. This file gives a SHARED
|
||||
;; canonical shape that cross-language tools (formatters, highlighters,
|
||||
;; debuggers) can target without per-language adapters.
|
||||
;;
|
||||
;; Each canonical node is a tagged list: (KIND ...payload).
|
||||
;;
|
||||
;; Constructors (return a canonical node):
|
||||
;;
|
||||
;; (ast-literal VALUE) — number / string / bool / nil
|
||||
;; (ast-var NAME) — identifier reference
|
||||
;; (ast-app FN ARGS) — function application
|
||||
;; (ast-lambda PARAMS BODY) — anonymous function
|
||||
;; (ast-let BINDINGS BODY) — local bindings
|
||||
;; (ast-letrec BINDINGS BODY) — recursive local bindings
|
||||
;; (ast-if TEST THEN ELSE) — conditional
|
||||
;; (ast-match-clause PATTERN BODY) — one match arm
|
||||
;; (ast-module NAME BODY) — module declaration
|
||||
;; (ast-import NAME) — import directive
|
||||
;;
|
||||
;; Predicates: (ast-literal? X), (ast-var? X), …
|
||||
;; Generic: (ast? X) — any canonical node
|
||||
;; (ast-kind X) — :literal / :var / :app / …
|
||||
;;
|
||||
;; Accessors (one per payload field):
|
||||
;; (ast-literal-value N)
|
||||
;; (ast-var-name N)
|
||||
;; (ast-app-fn N) (ast-app-args N)
|
||||
;; (ast-lambda-params N) (ast-lambda-body N)
|
||||
;; (ast-let-bindings N) (ast-let-body N)
|
||||
;; (ast-letrec-bindings N) (ast-letrec-body N)
|
||||
;; (ast-if-test N) (ast-if-then N) (ast-if-else N)
|
||||
;; (ast-match-clause-pattern N)
|
||||
;; (ast-match-clause-body N)
|
||||
;; (ast-module-name N) (ast-module-body N)
|
||||
;; (ast-import-name N)
|
||||
|
||||
(define ast-literal (fn (v) (list :literal v)))
|
||||
(define ast-var (fn (n) (list :var n)))
|
||||
(define ast-app (fn (f args) (list :app f args)))
|
||||
(define ast-lambda (fn (ps body) (list :lambda ps body)))
|
||||
(define ast-let (fn (bs body) (list :let bs body)))
|
||||
(define ast-letrec (fn (bs body) (list :letrec bs body)))
|
||||
(define ast-if (fn (t th el) (list :if t th el)))
|
||||
(define ast-match-clause (fn (p body) (list :match-clause p body)))
|
||||
(define ast-module (fn (n body) (list :module n body)))
|
||||
(define ast-import (fn (n) (list :import n)))
|
||||
|
||||
(define ast-kind (fn (x) (if (and (list? x) (not (empty? x))) (first x) nil)))
|
||||
|
||||
(define
|
||||
ast?
|
||||
(fn (x)
|
||||
(and (list? x)
|
||||
(not (empty? x))
|
||||
(let ((k (first x)))
|
||||
(or (= k :literal) (= k :var) (= k :app)
|
||||
(= k :lambda) (= k :let) (= k :letrec)
|
||||
(= k :if) (= k :match-clause)
|
||||
(= k :module) (= k :import))))))
|
||||
|
||||
(define ast-literal? (fn (x) (and (ast? x) (= (first x) :literal))))
|
||||
(define ast-var? (fn (x) (and (ast? x) (= (first x) :var))))
|
||||
(define ast-app? (fn (x) (and (ast? x) (= (first x) :app))))
|
||||
(define ast-lambda? (fn (x) (and (ast? x) (= (first x) :lambda))))
|
||||
(define ast-let? (fn (x) (and (ast? x) (= (first x) :let))))
|
||||
(define ast-letrec? (fn (x) (and (ast? x) (= (first x) :letrec))))
|
||||
(define ast-if? (fn (x) (and (ast? x) (= (first x) :if))))
|
||||
(define ast-match-clause? (fn (x) (and (ast? x) (= (first x) :match-clause))))
|
||||
(define ast-module? (fn (x) (and (ast? x) (= (first x) :module))))
|
||||
(define ast-import? (fn (x) (and (ast? x) (= (first x) :import))))
|
||||
|
||||
(define ast-literal-value (fn (n) (nth n 1)))
|
||||
(define ast-var-name (fn (n) (nth n 1)))
|
||||
(define ast-app-fn (fn (n) (nth n 1)))
|
||||
(define ast-app-args (fn (n) (nth n 2)))
|
||||
(define ast-lambda-params (fn (n) (nth n 1)))
|
||||
(define ast-lambda-body (fn (n) (nth n 2)))
|
||||
(define ast-let-bindings (fn (n) (nth n 1)))
|
||||
(define ast-let-body (fn (n) (nth n 2)))
|
||||
(define ast-letrec-bindings (fn (n) (nth n 1)))
|
||||
(define ast-letrec-body (fn (n) (nth n 2)))
|
||||
(define ast-if-test (fn (n) (nth n 1)))
|
||||
(define ast-if-then (fn (n) (nth n 2)))
|
||||
(define ast-if-else (fn (n) (nth n 3)))
|
||||
(define ast-match-clause-pattern (fn (n) (nth n 1)))
|
||||
(define ast-match-clause-body (fn (n) (nth n 2)))
|
||||
(define ast-module-name (fn (n) (nth n 1)))
|
||||
(define ast-module-body (fn (n) (nth n 2)))
|
||||
(define ast-import-name (fn (n) (nth n 1)))
|
||||
63
lib/guest/tests/ast.sx
Normal file
63
lib/guest/tests/ast.sx
Normal file
@@ -0,0 +1,63 @@
|
||||
;; 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)}))
|
||||
@@ -3,5 +3,5 @@
|
||||
"total_failed": 0,
|
||||
"total": 590,
|
||||
"suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0},"list_predicates":{"passed":33,"total":33,"failed":0},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0},"io_predicates":{"passed":24,"total":24,"failed":0},"assert_rules":{"passed":15,"total":15,"failed":0},"string_agg":{"passed":25,"total":25,"failed":0},"advanced":{"passed":21,"total":21,"failed":0},"compiler":{"passed":17,"total":17,"failed":0},"cross_validate":{"passed":17,"total":17,"failed":0},"integration":{"passed":20,"total":20,"failed":0},"hs_bridge":{"passed":19,"total":19,"failed":0}},
|
||||
"generated": "2026-05-07T17:07:57+00:00"
|
||||
"generated": "2026-05-07T17:35:23+00:00"
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# Prolog scoreboard
|
||||
|
||||
**590 / 590 passing** (0 failure(s)).
|
||||
Generated 2026-05-07T17:07:57+00:00.
|
||||
Generated 2026-05-07T17:35:23+00:00.
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
|
||||
Reference in New Issue
Block a user