improvements

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