giles
5c1807c832
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
Tokens → list of {:head :body} / {:query} clauses. SX symbols for
constants and variables (case-distinguished). not(literal) in body
desugars to {:neg literal}. Nested compounds permitted in arg
position for arithmetic; safety analysis (Phase 3) will gate them.
Conformance harness wraps lib/guest/conformance.sh; produces
lib/datalog/scoreboard.{json,md}.
243 lines
6.4 KiB
Plaintext
243 lines
6.4 KiB
Plaintext
;; lib/datalog/parser.sx — Datalog tokens → AST
|
|
;;
|
|
;; Output shapes:
|
|
;; Literal (positive) := (relname arg ... arg) — SX list
|
|
;; Literal (negative) := {:neg (relname arg ... arg)} — dict
|
|
;; Argument := var-symbol | atom-symbol | number | string
|
|
;; | (op-name arg ... arg) — arithmetic compound
|
|
;; Fact := {:head literal :body ()}
|
|
;; Rule := {:head literal :body (lit ... lit)}
|
|
;; Query := {:query (lit ... lit)}
|
|
;; Program := list of facts / rules / queries
|
|
;;
|
|
;; Variables and constants are both SX symbols; the evaluator dispatches
|
|
;; on first-char case ('A'..'Z' or '_' = variable, otherwise constant).
|
|
;;
|
|
;; The parser permits nested compounds in arg position to support
|
|
;; arithmetic (e.g. (is Z (+ X Y))). Safety analysis at rule-load time
|
|
;; rejects compounds whose head is not an arithmetic operator.
|
|
|
|
(define
|
|
dl-pp-peek
|
|
(fn
|
|
(st)
|
|
(let
|
|
((i (get st :idx)) (tokens (get st :tokens)))
|
|
(if (< i (len tokens)) (nth tokens i) {:type "eof" :value nil :pos 0}))))
|
|
|
|
(define
|
|
dl-pp-peek2
|
|
(fn
|
|
(st)
|
|
(let
|
|
((i (+ (get st :idx) 1)) (tokens (get st :tokens)))
|
|
(if (< i (len tokens)) (nth tokens i) {:type "eof" :value nil :pos 0}))))
|
|
|
|
(define
|
|
dl-pp-advance!
|
|
(fn (st) (dict-set! st :idx (+ (get st :idx) 1))))
|
|
|
|
(define
|
|
dl-pp-at?
|
|
(fn
|
|
(st type value)
|
|
(let
|
|
((t (dl-pp-peek st)))
|
|
(and
|
|
(= (get t :type) type)
|
|
(or (= value nil) (= (get t :value) value))))))
|
|
|
|
(define
|
|
dl-pp-error
|
|
(fn
|
|
(st msg)
|
|
(let
|
|
((t (dl-pp-peek st)))
|
|
(error
|
|
(str
|
|
"Parse error at pos "
|
|
(get t :pos)
|
|
": "
|
|
msg
|
|
" (got "
|
|
(get t :type)
|
|
" '"
|
|
(if (= (get t :value) nil) "" (get t :value))
|
|
"')")))))
|
|
|
|
(define
|
|
dl-pp-expect!
|
|
(fn
|
|
(st type value)
|
|
(let
|
|
((t (dl-pp-peek st)))
|
|
(if
|
|
(dl-pp-at? st type value)
|
|
(do (dl-pp-advance! st) t)
|
|
(dl-pp-error
|
|
st
|
|
(str "expected " type (if (= value nil) "" (str " '" value "'"))))))))
|
|
|
|
;; Argument: variable, atom, number, string, or compound (relname/op + parens).
|
|
(define
|
|
dl-pp-parse-arg
|
|
(fn
|
|
(st)
|
|
(let
|
|
((t (dl-pp-peek st)))
|
|
(let
|
|
((ty (get t :type)) (vv (get t :value)))
|
|
(cond
|
|
((= ty "number") (do (dl-pp-advance! st) vv))
|
|
((= ty "string") (do (dl-pp-advance! st) vv))
|
|
((= ty "var") (do (dl-pp-advance! st) (string->symbol vv)))
|
|
((or (= ty "atom") (= ty "op"))
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(if
|
|
(dl-pp-at? st "punct" "(")
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(let
|
|
((args (dl-pp-parse-arg-list st)))
|
|
(do
|
|
(dl-pp-expect! st "punct" ")")
|
|
(cons (string->symbol vv) args))))
|
|
(string->symbol vv))))
|
|
(else (dl-pp-error st "expected term")))))))
|
|
|
|
;; Comma-separated args inside parens.
|
|
(define
|
|
dl-pp-parse-arg-list
|
|
(fn
|
|
(st)
|
|
(let
|
|
((args (list)))
|
|
(do
|
|
(append! args (dl-pp-parse-arg st))
|
|
(define
|
|
dl-pp-arg-loop
|
|
(fn
|
|
()
|
|
(when
|
|
(dl-pp-at? st "punct" ",")
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(append! args (dl-pp-parse-arg st))
|
|
(dl-pp-arg-loop)))))
|
|
(dl-pp-arg-loop)
|
|
args))))
|
|
|
|
;; A positive literal: relname (atom or op) followed by optional (args).
|
|
(define
|
|
dl-pp-parse-positive
|
|
(fn
|
|
(st)
|
|
(let
|
|
((t (dl-pp-peek st)))
|
|
(let
|
|
((ty (get t :type)) (vv (get t :value)))
|
|
(if
|
|
(or (= ty "atom") (= ty "op"))
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(if
|
|
(dl-pp-at? st "punct" "(")
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(let
|
|
((args (dl-pp-parse-arg-list st)))
|
|
(do
|
|
(dl-pp-expect! st "punct" ")")
|
|
(cons (string->symbol vv) args))))
|
|
(list (string->symbol vv))))
|
|
(dl-pp-error st "expected literal head"))))))
|
|
|
|
;; A body literal: positive, or not(positive).
|
|
(define
|
|
dl-pp-parse-body-lit
|
|
(fn
|
|
(st)
|
|
(let
|
|
((t1 (dl-pp-peek st)) (t2 (dl-pp-peek2 st)))
|
|
(if
|
|
(and
|
|
(= (get t1 :type) "atom")
|
|
(= (get t1 :value) "not")
|
|
(= (get t2 :type) "punct")
|
|
(= (get t2 :value) "("))
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(dl-pp-advance! st)
|
|
(let
|
|
((inner (dl-pp-parse-positive st)))
|
|
(do (dl-pp-expect! st "punct" ")") {:neg inner})))
|
|
(dl-pp-parse-positive st)))))
|
|
|
|
;; Comma-separated body literals.
|
|
(define
|
|
dl-pp-parse-body
|
|
(fn
|
|
(st)
|
|
(let
|
|
((lits (list)))
|
|
(do
|
|
(append! lits (dl-pp-parse-body-lit st))
|
|
(define
|
|
dl-pp-body-loop
|
|
(fn
|
|
()
|
|
(when
|
|
(dl-pp-at? st "punct" ",")
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(append! lits (dl-pp-parse-body-lit st))
|
|
(dl-pp-body-loop)))))
|
|
(dl-pp-body-loop)
|
|
lits))))
|
|
|
|
;; Single clause: fact, rule, or query. Consumes trailing dot.
|
|
(define
|
|
dl-pp-parse-clause
|
|
(fn
|
|
(st)
|
|
(cond
|
|
((dl-pp-at? st "op" "?-")
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(let
|
|
((body (dl-pp-parse-body st)))
|
|
(do (dl-pp-expect! st "punct" ".") {:query body}))))
|
|
(else
|
|
(let
|
|
((head (dl-pp-parse-positive st)))
|
|
(cond
|
|
((dl-pp-at? st "op" ":-")
|
|
(do
|
|
(dl-pp-advance! st)
|
|
(let
|
|
((body (dl-pp-parse-body st)))
|
|
(do (dl-pp-expect! st "punct" ".") {:body body :head head}))))
|
|
(else (do (dl-pp-expect! st "punct" ".") {:body (list) :head head}))))))))
|
|
|
|
(define
|
|
dl-parse-program
|
|
(fn
|
|
(tokens)
|
|
(let
|
|
((st {:tokens tokens :idx 0}) (clauses (list)))
|
|
(do
|
|
(define
|
|
dl-pp-prog-loop
|
|
(fn
|
|
()
|
|
(when
|
|
(not (dl-pp-at? st "eof" nil))
|
|
(do
|
|
(append! clauses (dl-pp-parse-clause st))
|
|
(dl-pp-prog-loop)))))
|
|
(dl-pp-prog-loop)
|
|
clauses))))
|
|
|
|
(define dl-parse (fn (src) (dl-parse-program (dl-tokenize src))))
|