rose-ash/lib/prolog/compiler.sx

;; 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)))))))