partially wroks

parent 0dc263c8
(define-module (logic guile-log prolog goal-functors)
#:use-module ((logic guile-log) #:select
(CUT SCUT <if> <define> <match> <<match>> <lambda>
<let> <apply> <cut> <fail> S <values>
<let> <apply> <cut> <fail> S <values> <scm>
<and> <with-cut> <cc> <pp> <lookup> <var?> <pp> <cut>
<code> </.> procedure-name
define-guile-log))
......@@ -68,9 +68,9 @@
(<define> (subst code vars)
(<<match>> (#:mode -) (code)
(#(("op2*" (and a #((f l))) code))
(#(("op2*" (and a #((f . l))) code))
(<and>
(<values> (vs) (get-vars l))
(<values> (vs) (get-vars (<scm> l)))
(let ((va (map car vs))
(vb (map cdr vs)))
(<values> (c)
......@@ -87,19 +87,19 @@
(#(a)
(<and>
(<values> aa (subst a vars))
(<values> (aa) (subst a vars))
(<cc> (lambda (x) (vector (aa x))))))
(#(a b)
(<and>
(<values> aa (subst a vars))
(<values> bb (subst b vars))
(<values> (aa) (subst a vars))
(<values> (bb) (subst b vars))
(<cc> (lambda (x) (vector (aa x) (bb x))))))
((a . b)
(<and>
(<values> aa (subst a vars))
(<values> bb (subst b vars))
(<values> (aa) (subst a vars))
(<values> (bb) (subst b vars))
(<cc> (lambda (x) (cons (aa x) (bb x))))))
(a
......@@ -109,7 +109,9 @@
(if r
(let ((r (cdr r)))
(if r
(list-ref x r)
(if (number? r)
(list-ref x r)
r)
a))
a)))))))
......@@ -129,7 +131,7 @@
(#(("op2*" #((f . val)) code))
(<and>
(<pp> val)
(<values> (vars.vals) (get-vars val))
(<values> (vars.vals) (get-vars (<scm> val)))
(let* ((vars (map car vars.vals))
(vals (map cdr vars.vals))
(vvars (let lp ((i 0) (vv vars))
......@@ -140,7 +142,7 @@
(code2 #f)
(lp (<lambda> x
(goal-eval* cut scut (code2 x)))))
(<values> (code3) (subst code (cons (cons f lp) vvars)))
(<values> (code3) (subst code (cons (cons (<scm> f) lp) vvars)))
(<code> (set! code2 code3))
(<apply> lp vals))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment