Recover agent-loop progress: lua/prolog/forth/erlang/haskell phases 1-2
Salvaged from worktree-agent-* branches killed during sx-tree MCP outage: - lua: tokenizer + parser + phase-2 transpile (~157 tests) - prolog: tokenizer + parser + unification (72 tests, plan update lost to WIP) - forth: phase-1 reader/interpreter + phase-2 colon/VARIABLE (134 tests) - erlang: tokenizer + parser (114 tests) - haskell: tokenizer + parse tests (43 tests) Cherry-picked file contents only, not branch history, to avoid pulling in unrelated ocaml-vm merge commits that were in those branches' bases.
This commit is contained in:
265
lib/prolog/parser.sx
Normal file
265
lib/prolog/parser.sx
Normal file
@@ -0,0 +1,265 @@
|
||||
;; lib/prolog/parser.sx — tokens → Prolog AST
|
||||
;;
|
||||
;; Phase 1 grammar (NO operator table yet):
|
||||
;; Program := Clause* EOF
|
||||
;; Clause := Term "." | Term ":-" Term "."
|
||||
;; Term := Atom | Var | Number | String | Compound | List
|
||||
;; Compound := atom "(" ArgList ")"
|
||||
;; ArgList := Term ("," Term)*
|
||||
;; List := "[" "]" | "[" Term ("," Term)* ("|" Term)? "]"
|
||||
;;
|
||||
;; Term AST shapes (all tagged lists for uniform dispatch):
|
||||
;; ("atom" name) — atom
|
||||
;; ("var" name) — variable template (parser-time only)
|
||||
;; ("num" value) — integer or float
|
||||
;; ("str" value) — string literal
|
||||
;; ("compound" functor args) — compound term, args is list of term-ASTs
|
||||
;; ("cut") — the cut atom !
|
||||
;;
|
||||
;; A clause is (list "clause" head body). A fact is head with body = ("atom" "true").
|
||||
;;
|
||||
;; The empty list is (atom "[]"). Cons is compound "." with two args:
|
||||
;; [1, 2, 3] → .(1, .(2, .(3, [])))
|
||||
;; [H|T] → .(H, T)
|
||||
|
||||
;; ── Parser state helpers ────────────────────────────────────────────
|
||||
(define
|
||||
pp-peek
|
||||
(fn
|
||||
(st)
|
||||
(let
|
||||
((i (get st :idx)) (tokens (get st :tokens)))
|
||||
(if (< i (len tokens)) (nth tokens i) {:pos 0 :value nil :type "eof"}))))
|
||||
|
||||
(define pp-advance! (fn (st) (dict-set! st :idx (+ (get st :idx) 1))))
|
||||
|
||||
(define
|
||||
pp-at?
|
||||
(fn
|
||||
(st type value)
|
||||
(let
|
||||
((t (pp-peek st)))
|
||||
(and
|
||||
(= (get t :type) type)
|
||||
(or (= value nil) (= (get t :value) value))))))
|
||||
|
||||
(define
|
||||
pp-expect!
|
||||
(fn
|
||||
(st type value)
|
||||
(let
|
||||
((t (pp-peek st)))
|
||||
(if
|
||||
(pp-at? st type value)
|
||||
(do (pp-advance! st) t)
|
||||
(error
|
||||
(str
|
||||
"Parse error at pos "
|
||||
(get t :pos)
|
||||
": expected "
|
||||
type
|
||||
" '"
|
||||
(if (= value nil) "" value)
|
||||
"' got "
|
||||
(get t :type)
|
||||
" '"
|
||||
(if (= (get t :value) nil) "" (get t :value))
|
||||
"'"))))))
|
||||
|
||||
;; ── AST constructors ────────────────────────────────────────────────
|
||||
(define pl-mk-atom (fn (name) (list "atom" name)))
|
||||
(define pl-mk-var (fn (name) (list "var" name)))
|
||||
(define pl-mk-num (fn (n) (list "num" n)))
|
||||
(define pl-mk-str (fn (s) (list "str" s)))
|
||||
(define pl-mk-compound (fn (f args) (list "compound" f args)))
|
||||
(define pl-mk-cut (fn () (list "cut")))
|
||||
|
||||
;; Term tag extractors
|
||||
(define pl-term-tag (fn (t) (if (list? t) (first t) nil)))
|
||||
(define pl-term-val (fn (t) (nth t 1)))
|
||||
(define pl-compound-functor (fn (t) (nth t 1)))
|
||||
(define pl-compound-args (fn (t) (nth t 2)))
|
||||
|
||||
;; Empty-list atom and cons helpers
|
||||
(define pl-nil-term (fn () (pl-mk-atom "[]")))
|
||||
|
||||
(define pl-mk-cons (fn (h t) (pl-mk-compound "." (list h t))))
|
||||
|
||||
;; Build cons list from a list of terms + optional tail
|
||||
(define
|
||||
pl-mk-list-term
|
||||
(fn
|
||||
(items tail)
|
||||
(if
|
||||
(= (len items) 0)
|
||||
tail
|
||||
(pl-mk-cons (first items) (pl-mk-list-term (rest items) tail)))))
|
||||
|
||||
;; ── Term parser ─────────────────────────────────────────────────────
|
||||
(define
|
||||
pp-parse-term
|
||||
(fn
|
||||
(st)
|
||||
(let
|
||||
((t (pp-peek st)))
|
||||
(let
|
||||
((ty (get t :type)) (vv (get t :value)))
|
||||
(cond
|
||||
((= ty "number") (do (pp-advance! st) (pl-mk-num vv)))
|
||||
((= ty "string") (do (pp-advance! st) (pl-mk-str vv)))
|
||||
((= ty "var") (do (pp-advance! st) (pl-mk-var vv)))
|
||||
((and (= ty "op") (= vv "!"))
|
||||
(do (pp-advance! st) (pl-mk-cut)))
|
||||
((and (= ty "punct") (= vv "[")) (pp-parse-list st))
|
||||
((= ty "atom")
|
||||
(do
|
||||
(pp-advance! st)
|
||||
(if
|
||||
(pp-at? st "punct" "(")
|
||||
(do
|
||||
(pp-advance! st)
|
||||
(let
|
||||
((args (pp-parse-arg-list st)))
|
||||
(do (pp-expect! st "punct" ")") (pl-mk-compound vv args))))
|
||||
(pl-mk-atom vv))))
|
||||
(else
|
||||
(error
|
||||
(str
|
||||
"Parse error at pos "
|
||||
(get t :pos)
|
||||
": unexpected "
|
||||
ty
|
||||
" '"
|
||||
(if (= vv nil) "" vv)
|
||||
"'"))))))))
|
||||
|
||||
;; Parse one or more comma-separated terms (arguments).
|
||||
(define
|
||||
pp-parse-arg-list
|
||||
(fn
|
||||
(st)
|
||||
(let
|
||||
((first-arg (pp-parse-term st)) (args (list)))
|
||||
(do
|
||||
(append! args first-arg)
|
||||
(define
|
||||
loop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(pp-at? st "punct" ",")
|
||||
(do
|
||||
(pp-advance! st)
|
||||
(append! args (pp-parse-term st))
|
||||
(loop)))))
|
||||
(loop)
|
||||
args))))
|
||||
|
||||
;; Parse a [ ... ] list literal. Consumes the "[".
|
||||
(define
|
||||
pp-parse-list
|
||||
(fn
|
||||
(st)
|
||||
(do
|
||||
(pp-expect! st "punct" "[")
|
||||
(if
|
||||
(pp-at? st "punct" "]")
|
||||
(do (pp-advance! st) (pl-nil-term))
|
||||
(let
|
||||
((items (list)))
|
||||
(do
|
||||
(append! items (pp-parse-term st))
|
||||
(define
|
||||
comma-loop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(pp-at? st "punct" ",")
|
||||
(do
|
||||
(pp-advance! st)
|
||||
(append! items (pp-parse-term st))
|
||||
(comma-loop)))))
|
||||
(comma-loop)
|
||||
(let
|
||||
((tail (if (pp-at? st "punct" "|") (do (pp-advance! st) (pp-parse-term st)) (pl-nil-term))))
|
||||
(do (pp-expect! st "punct" "]") (pl-mk-list-term items tail)))))))))
|
||||
|
||||
;; ── Body parsing ────────────────────────────────────────────────────
|
||||
;; A clause body is a comma-separated list of goals. We flatten into a
|
||||
;; right-associative `,` compound: (A, B, C) → ','(A, ','(B, C))
|
||||
;; If only one goal, it's that goal directly.
|
||||
(define
|
||||
pp-parse-body
|
||||
(fn
|
||||
(st)
|
||||
(let
|
||||
((first-goal (pp-parse-term st)) (rest-goals (list)))
|
||||
(do
|
||||
(define
|
||||
gloop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(pp-at? st "punct" ",")
|
||||
(do
|
||||
(pp-advance! st)
|
||||
(append! rest-goals (pp-parse-term st))
|
||||
(gloop)))))
|
||||
(gloop)
|
||||
(if
|
||||
(= (len rest-goals) 0)
|
||||
first-goal
|
||||
(pp-build-conj first-goal rest-goals))))))
|
||||
|
||||
(define
|
||||
pp-build-conj
|
||||
(fn
|
||||
(first-goal rest-goals)
|
||||
(if
|
||||
(= (len rest-goals) 0)
|
||||
first-goal
|
||||
(pl-mk-compound
|
||||
","
|
||||
(list
|
||||
first-goal
|
||||
(pp-build-conj (first rest-goals) (rest rest-goals)))))))
|
||||
|
||||
;; ── Clause parsing ──────────────────────────────────────────────────
|
||||
(define
|
||||
pp-parse-clause
|
||||
(fn
|
||||
(st)
|
||||
(let
|
||||
((head (pp-parse-term st)))
|
||||
(let
|
||||
((body (if (pp-at? st "op" ":-") (do (pp-advance! st) (pp-parse-body st)) (pl-mk-atom "true"))))
|
||||
(do (pp-expect! st "punct" ".") (list "clause" head body))))))
|
||||
|
||||
;; Parse an entire program — returns list of clauses.
|
||||
(define
|
||||
pl-parse-program
|
||||
(fn
|
||||
(tokens)
|
||||
(let
|
||||
((st {:idx 0 :tokens tokens}) (clauses (list)))
|
||||
(do
|
||||
(define
|
||||
ploop
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(not (pp-at? st "eof" nil))
|
||||
(do (append! clauses (pp-parse-clause st)) (ploop)))))
|
||||
(ploop)
|
||||
clauses))))
|
||||
|
||||
;; Parse a single query term (no trailing "."). Returns the term.
|
||||
(define
|
||||
pl-parse-query
|
||||
(fn (tokens) (let ((st {:idx 0 :tokens tokens})) (pp-parse-body st))))
|
||||
|
||||
;; Convenience: source → clauses
|
||||
(define pl-parse (fn (src) (pl-parse-program (pl-tokenize src))))
|
||||
|
||||
;; Convenience: source → query term
|
||||
(define pl-parse-goal (fn (src) (pl-parse-query (pl-tokenize src))))
|
||||
Reference in New Issue
Block a user