;; lib/prolog/compiler.sx — clause compiler: parse-AST clauses → SX closures ;; ;; Each compiled clause is a lambda (fn (goal trail db cut-box k) bool) ;; that creates fresh vars, builds the instantiated head/body, and calls ;; pl-unify! + pl-solve! directly — no AST walk at solve time. ;; ;; Usage: ;; (pl-db-load! db (pl-parse src)) ;; (pl-compile-db! db) ;; ; pl-solve-user! in runtime.sx automatically prefers compiled clauses ;; (pl-solve-once! db goal trail) ;; Collect unique variable names from a parse-AST clause into a dict. (define pl-cmp-vars-into! (fn (ast seen) (cond ((not (list? ast)) nil) ((empty? ast) nil) ((= (first ast) "var") (let ((name (nth ast 1))) (when (and (not (= name "_")) (not (dict-has? seen name))) (dict-set! seen name true)))) ((= (first ast) "compound") (for-each (fn (a) (pl-cmp-vars-into! a seen)) (nth ast 2))) ((= (first ast) "clause") (begin (pl-cmp-vars-into! (nth ast 1) seen) (pl-cmp-vars-into! (nth ast 2) seen)))))) ;; Return list of unique var names in a clause (head + body, excluding _). (define pl-cmp-collect-vars (fn (clause) (let ((seen {})) (pl-cmp-vars-into! clause seen) (keys seen)))) ;; Create a fresh runtime var for each name in the list; return name->var dict. (define pl-cmp-make-var-map (fn (var-names) (let ((m {})) (for-each (fn (name) (dict-set! m name (pl-mk-rt-var name))) var-names) m))) ;; Instantiate a parse-AST term using a pre-built var-map. ;; ("var" "_") always gets a fresh anonymous var. (define pl-cmp-build-term (fn (ast var-map) (cond ((pl-var? ast) ast) ((not (list? ast)) ast) ((empty? ast) ast) ((= (first ast) "var") (let ((name (nth ast 1))) (if (= name "_") (pl-mk-rt-var "_") (dict-get var-map name)))) ((or (= (first ast) "atom") (= (first ast) "num") (= (first ast) "str")) ast) ((= (first ast) "compound") (list "compound" (nth ast 1) (map (fn (a) (pl-cmp-build-term a var-map)) (nth ast 2)))) ((= (first ast) "clause") (list "clause" (pl-cmp-build-term (nth ast 1) var-map) (pl-cmp-build-term (nth ast 2) var-map))) (true ast)))) ;; Compile one parse-AST clause to a lambda. ;; Pre-computes var names at compile time; creates fresh vars per call. (define pl-compile-clause (fn (clause) (let ((var-names (pl-cmp-collect-vars clause)) (head-ast (nth clause 1)) (body-ast (nth clause 2))) (fn (goal trail db cut-box k) (let ((var-map (pl-cmp-make-var-map var-names))) (let ((fresh-head (pl-cmp-build-term head-ast var-map)) (fresh-body (pl-cmp-build-term body-ast var-map))) (let ((mark (pl-trail-mark trail))) (if (pl-unify! goal fresh-head trail) (let ((r (pl-solve! db fresh-body trail cut-box k))) (if r true (begin (pl-trail-undo-to! trail mark) false))) (begin (pl-trail-undo-to! trail mark) false))))))))) ;; Try a list of compiled clause lambdas — same cut semantics as pl-try-clauses!. (define pl-try-compiled-clauses! (fn (db goal trail compiled-clauses outer-cut-box outer-was-cut inner-cut-box k) (cond ((empty? compiled-clauses) false) (true (let ((r ((first compiled-clauses) goal trail db inner-cut-box k))) (cond (r true) ((dict-get inner-cut-box :cut) false) ((and (not outer-was-cut) (dict-get outer-cut-box :cut)) false) (true (pl-try-compiled-clauses! db goal trail (rest compiled-clauses) outer-cut-box outer-was-cut inner-cut-box k)))))))) ;; Compile all clauses in DB and store in :compiled table. ;; After this call, pl-solve-user! will dispatch via compiled lambdas. ;; Note: clauses assert!-ed after this call are not compiled. (define pl-compile-db! (fn (db) (let ((src-table (dict-get db :clauses)) (compiled-table {})) (for-each (fn (key) (dict-set! compiled-table key (map pl-compile-clause (dict-get src-table key)))) (keys src-table)) (dict-set! db :compiled compiled-table) db))) ;; Cross-validate: load src into both a plain and a compiled DB, ;; run goal-str through each, return true iff solution counts match. ;; Use this to keep the interpreter as the reference implementation. (define pl-compiled-matches-interp? (fn (src goal-str) (let ((db-interp (pl-mk-db)) (db-comp (pl-mk-db))) (pl-db-load! db-interp (pl-parse src)) (pl-db-load! db-comp (pl-parse src)) (pl-compile-db! db-comp) (let ((gi (pl-instantiate (pl-parse-goal goal-str) {})) (gc (pl-instantiate (pl-parse-goal goal-str) {}))) (= (pl-solve-count! db-interp gi (pl-mk-trail)) (pl-solve-count! db-comp gc (pl-mk-trail)))))))