giles
52070e07fc
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
run.sx: reify-name builds canonical "_.N" symbols; reify-s walks a term left-to-right and assigns each unbound var its index in the discovery order; reify combines the two with two walk* passes. run-n is the runtime defmacro: binds the query var, takes ≤ n stream answers, reifies each. run* and run are sugar around it. First classic miniKanren tests green: (run* q (== q 1)) → (1) (run* q (conde ((== q 1)) ((== q 2)))) → (1 2) (run* q (fresh (x y) (== q (list x y)))) → ((_.0 _.1)) 128/128 cumulative.
57 lines
1.8 KiB
Plaintext
57 lines
1.8 KiB
Plaintext
;; lib/minikanren/run.sx — Phase 3: drive a goal + reify the query var.
|
|
;;
|
|
;; reify-name N — make the canonical "_.N" reified symbol.
|
|
;; reify-s term rs — walk term in rs, add a mapping from each fresh
|
|
;; unbound var to its _.N name (left-to-right order).
|
|
;; reify q s — walk* q in s, build reify-s, walk* again to
|
|
;; substitute reified names in.
|
|
;; run-n n q-name g... — defmacro: bind q-name to a fresh var, conj goals,
|
|
;; take ≤ n answers from the stream, reify each
|
|
;; through q-name. n = -1 takes all (used by run*).
|
|
;; run* — defmacro: (run* q g...) ≡ (run-n -1 q g...)
|
|
;; run — defmacro: (run n q g...) ≡ (run-n n q g...)
|
|
;; The two-segment form is the standard TRS API.
|
|
|
|
(define reify-name (fn (n) (make-symbol (str "_." n))))
|
|
|
|
(define
|
|
reify-s
|
|
(fn
|
|
(term rs)
|
|
(let
|
|
((w (mk-walk term rs)))
|
|
(cond
|
|
((is-var? w) (extend (var-name w) (reify-name (len rs)) rs))
|
|
((mk-list-pair? w) (reduce (fn (acc a) (reify-s a acc)) rs w))
|
|
(:else rs)))))
|
|
|
|
(define
|
|
reify
|
|
(fn
|
|
(term s)
|
|
(let
|
|
((w (mk-walk* term s)))
|
|
(let ((rs (reify-s w (empty-subst)))) (mk-walk* w rs)))))
|
|
|
|
(defmacro
|
|
run-n
|
|
(n q-name &rest goals)
|
|
(quasiquote
|
|
(let
|
|
(((unquote q-name) (make-var)))
|
|
(map
|
|
(fn (s) (reify (unquote q-name) s))
|
|
(stream-take
|
|
(unquote n)
|
|
((mk-conj (splice-unquote goals)) empty-s))))))
|
|
|
|
(defmacro
|
|
run*
|
|
(q-name &rest goals)
|
|
(quasiquote (run-n -1 (unquote q-name) (splice-unquote goals))))
|
|
|
|
(defmacro
|
|
run
|
|
(n q-name &rest goals)
|
|
(quasiquote (run-n (unquote n) (unquote q-name) (splice-unquote goals))))
|