improvements

parent a6a52e8f
......@@ -12,53 +12,57 @@
((x) (goal-eval x))
((fail x y)
(<pand> (</.> (goal-eval fail))
(p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y))))
(p1 l1 s1 (gp-make-engine (+ next-level 1) 100) (goal-eval x))
(p2 l2 s2 (gp-make-engine (+ next-level 1) 100) (goal-eval y))))
((fail x y u)
(<pand> (</.> (goal-eval fail))
(p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y))
(p3 s3 (gp-make-engine 100) (goal-eval u))))
(p1 l1 s1 (gp-make-engine (+ next-level 1) 100) (goal-eval x))
(p2 l2 s2 (gp-make-engine (+ next-level 1) 100) (goal-eval y))
(p3 l3 s3 (gp-make-engine (+ next-level 1) 100) (goal-eval u))))
((fail x y u v)
(<pand> (</.> (goal-eval fail))
(p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y))
(p3 s3 (gp-make-engine 100) (goal-eval u))
(p4 s4 (gp-make-engine 100) (goal-eval v))))
(p1 l1 s1 (gp-make-engine (+ next-level 1) 100) (goal-eval x))
(p2 l2 s2 (gp-make-engine (+ next-level 1) 100) (goal-eval y))
(p3 l3 s3 (gp-make-engine (+ next-level 1) 100) (goal-eval u))
(p4 l4 s4 (gp-make-engine (+ next-level 1) 100) (goal-eval v))))
((fail . l)
(let ((l-u (let lp ((l l) (u '()) (n (/ (length l) 2)))
(if (= n 0)
(cons l u)
(lp (cdr l) (cons (car l) u) (- n 1))))))
(<pand> (</.> (goal-eval fail))
(p1 s1 (gp-make-engine 100) (<apply> paralell fail (car l-u)))
(p3 s3 (gp-make-engine 100) (<apply> paralell fail (cdr l-u))))))))
(p1 l1 s1 (gp-make-engine (+ next-level 1) 100)
(<apply> paralell fail (car l-u)))
(p3 l3 s3 (gp-make-engine (+ next-level 1) 100)
(<apply> paralell fail (cdr l-u))))))))
(define (fail x) x)
(define pzip
(<case-lambda>
(() <fail>)
((x) (goal-eval x))
((x y)
(<pzip>
(p1 s1 q1 (goal-eval x))
(p2 s2 q2 (goal-eval y))))
(<pzip> fail
(p1 l1 s1 q1 (goal-eval x))
(p2 l2 s2 q2 (goal-eval y))))
((x y u)
(<pzip>
(p1 s1 q1 (goal-eval x))
(p2 s2 q2 (goal-eval y))
(p3 s3 q3 (goal-eval u))))
(<pzip> fail
(p1 l1 s1 q1 (goal-eval x))
(p2 l2 s2 q2 (goal-eval y))
(p3 l3 s3 q3 (goal-eval u))))
((x y u v)
(<pzip>
(p1 s1 q1 (goal-eval x))
(p2 s2 q2 (goal-eval y))
(p3 s3 q3 (goal-eval u))
(p4 s4 q4 (goal-eval v))))
(<pzip> fail
(p1 l1 s1 q1 (goal-eval x))
(p2 l2 s2 q2 (goal-eval y))
(p3 l3 s3 q3 (goal-eval u))
(p4 l4 s4 q4 (goal-eval v))))
(l
(let ((l-u (let lp ((l l) (u '()) (n (/ (length l) 2)))
(if (= n 0)
(cons l u)
(lp (cdr l) (cons (car l) u) (- n 1))))))
(<pzip>
(p2 s2 q2 (<apply> pzip (car l-u)))
(p3 s3 q3 (<apply> pzip (cdr l-u))))))))
(<pzip> fail
(p2 l2 s2 q2 (<apply> pzip (car l-u)))
(p3 l3 s3 q3 (<apply> pzip (cdr l-u))))))))
......@@ -3,7 +3,7 @@
#:use-module (logic guile-log code-load)
#:use-module (logic guile-log dynamic-features)
#:use-module (logic guile-log umatch)
#:export (<pand> <pzip> f test1 test2 test3 test4))
#:export (<pand> <pzip> f test1 test2 test3 test4 next-level))
(<define-guile-log-rule> (<pit> s p cc code ...)
......@@ -33,16 +33,16 @@
(<var> (v ...)
(let ((i level) (n next-level) (l level) ...)
(<dynwind>
(</.> (<cc>))
(</.>
(<code> (set! level i))
(<code> (set! next-level n))))
(<let> ((data (list v ...))
(lambda x #f)
(lambda x
(set! level i)
(set! next-level n)))
(let ((data (list v ...))
(frame (<newframe>))
(se #f) ...
(p P)
(cc CC))
(<let*> ((s frame)
(let* ((s frame)
(ccc (lambda (ss pp)
(gp-combine-engines data)
(cc (gp-combine-state
......@@ -55,25 +55,32 @@
(<code> (gp-combine-push data))
(<code> (gp-var-set v (gp-peek-engine) S))
(<dynwind>
(</.>
(<code> (set! level (+ 1 n)))
(<code> (set! next-level (+ 1 n))))
(</.> <cc>))
(lambda x
(set! level (+ 1 n))
(set! next-level (+ 1 n)))
(lambda x #f))
(<code>
(set! level (+ 1 n))
(set! next-level (+ 1 n)))
code ...
(<dynwind>
(</.> (<code> (set! l next-level)))
(</.> (<code> (set! next-level l))))
(lambda x (set! l next-level))
(lambda x (set! next-level l)))
(<code>
(set! l next-level))
(<code> (set! se S))
(<code> (gp-pop-engine))))))
...
(<dynwind>
(</.>
(<code> (set! next-level (max l ...)))
(<code> (set! level i)))
(</.> <cc>))
(lambda x
(set! next-level (max l ...))
(set! level i))
(lambda x #f))
(<code>
(set! next-level (max l ...))
(set! level i))
(<code> (gp-combine-engines data))
(let ((s.bindings (gp-combine-state s (list se ...))))
(check-bindings check (cdr s.bindings))
......@@ -119,7 +126,7 @@
(if (< i n)
(<or> (<=> x i) (lp (+ i 1))))))
(<define> (idfail fail-all) (fail-all))
(define (idfail fail-all) fail-all)
(<define> (test1 x y)
(<pzip> idfail (v1 l1 s1 p1 (f x 3)) (v2 l2 s2 p2 (f y 3))))
......
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