mk: phase 2B — fresh, defmacro form + call-fresh
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
(fresh (x y z) g1 g2 ...) expands to a let that calls (make-var) for each named var, then mk-conjs the goals. call-fresh is the function-shaped alternative for programmatic goal building. 9 new tests: empty-vars, single var, multi-var multi-goal, fresh under disj, nested fresh, call-fresh equivalents. 91/91 cumulative.
This commit is contained in:
23
lib/minikanren/fresh.sx
Normal file
23
lib/minikanren/fresh.sx
Normal file
@@ -0,0 +1,23 @@
|
||||
;; lib/minikanren/fresh.sx — Phase 2 piece B: `fresh` for introducing
|
||||
;; logic variables inside a goal body.
|
||||
;;
|
||||
;; (fresh (x y z) goal1 goal2 ...)
|
||||
;; ≡ (let ((x (make-var)) (y (make-var)) (z (make-var)))
|
||||
;; (mk-conj goal1 goal2 ...))
|
||||
;;
|
||||
;; A macro rather than a function so user-named vars are real lexical
|
||||
;; bindings — which is also what miniKanren convention expects.
|
||||
;; The empty-vars form (fresh () goal ...) is just a goal grouping.
|
||||
|
||||
(defmacro
|
||||
fresh
|
||||
(vars &rest goals)
|
||||
(quasiquote
|
||||
(let
|
||||
(unquote (map (fn (v) (list v (list (quote make-var)))) vars))
|
||||
(mk-conj (splice-unquote goals)))))
|
||||
|
||||
;; call-fresh — functional alternative for code that builds goals
|
||||
;; programmatically:
|
||||
;; ((call-fresh (fn (x) (== x 7))) empty-s) → ({:_.N 7})
|
||||
(define call-fresh (fn (f) (fn (s) ((f (make-var)) s))))
|
||||
101
lib/minikanren/tests/fresh.sx
Normal file
101
lib/minikanren/tests/fresh.sx
Normal file
@@ -0,0 +1,101 @@
|
||||
;; lib/minikanren/tests/fresh.sx — Phase 2 piece B tests for `fresh`.
|
||||
|
||||
;; --- empty fresh: pure goal grouping ---
|
||||
|
||||
(mk-test
|
||||
"fresh-empty-vars-equiv-conj"
|
||||
((fresh () (== 1 1)) empty-s)
|
||||
(list empty-s))
|
||||
|
||||
(mk-test
|
||||
"fresh-empty-vars-no-goals-is-succeed"
|
||||
((fresh ()) empty-s)
|
||||
(list empty-s))
|
||||
|
||||
;; --- single var ---
|
||||
|
||||
(mk-test
|
||||
"fresh-one-var-bound"
|
||||
(let
|
||||
((s (first ((fresh (x) (== x 7)) empty-s))))
|
||||
(let ((vs (vals s))) (first vs)))
|
||||
7)
|
||||
|
||||
;; --- multiple vars + multiple goals ---
|
||||
|
||||
(mk-test
|
||||
"fresh-two-vars-three-goals"
|
||||
(let
|
||||
((q (mk-var "q"))
|
||||
(g
|
||||
(fresh
|
||||
(x y)
|
||||
(== x 10)
|
||||
(== y 20)
|
||||
(== q (list x y)))))
|
||||
(mk-walk* q (first (g empty-s))))
|
||||
(list 10 20))
|
||||
|
||||
(mk-test
|
||||
"fresh-three-vars"
|
||||
(let
|
||||
((q (mk-var "q"))
|
||||
(g
|
||||
(fresh
|
||||
(a b c)
|
||||
(== a 1)
|
||||
(== b 2)
|
||||
(== c 3)
|
||||
(== q (list a b c)))))
|
||||
(mk-walk* q (first (g empty-s))))
|
||||
(list 1 2 3))
|
||||
|
||||
;; --- fresh interacts with disj ---
|
||||
|
||||
(mk-test
|
||||
"fresh-with-disj"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((g (fresh (x) (mk-disj (== x 1) (== x 2)) (== q x))))
|
||||
(let
|
||||
((res (stream-take 5 (g empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res))))
|
||||
(list 1 2))
|
||||
|
||||
;; --- nested fresh ---
|
||||
|
||||
(mk-test
|
||||
"fresh-nested"
|
||||
(let
|
||||
((q (mk-var "q"))
|
||||
(g
|
||||
(fresh
|
||||
(x)
|
||||
(fresh
|
||||
(y)
|
||||
(== x 1)
|
||||
(== y 2)
|
||||
(== q (list x y))))))
|
||||
(mk-walk* q (first (g empty-s))))
|
||||
(list 1 2))
|
||||
|
||||
;; --- call-fresh (functional alternative) ---
|
||||
|
||||
(mk-test
|
||||
"call-fresh-binds-and-walks"
|
||||
(let
|
||||
((s (first ((call-fresh (fn (x) (== x 99))) empty-s))))
|
||||
(first (vals s)))
|
||||
99)
|
||||
|
||||
(mk-test
|
||||
"call-fresh-distinct-from-outer-vars"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((g (call-fresh (fn (x) (mk-conj (== x 5) (== q (list x x)))))))
|
||||
(mk-walk* q (first (g empty-s)))))
|
||||
(list 5 5))
|
||||
|
||||
(mk-tests-run!)
|
||||
Reference in New Issue
Block a user