paralell compiles

parent c9503a87
......@@ -8,33 +8,34 @@
(define (recur Goal)
(<lambda> (data)
(<values> (f Next) (goal-eval Goal))
(<cc> (<lookup> f) (recur (<copy-term> Next)))))
(<cc> (<lookup> f) (recur (<cp> Next)))))
(define (paralell . l)
(<define> (paralell . l)
(<<match>> (#:mode -) (l)
((fail data e c (d1 p1 x1) (d2 p2 x2))
((fail (d1 p1 x1) (d2 p2 x2))
(<pand> n (recur fail) da ee cc
((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1))
(dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2)))
(<=> (da ee cc dd1 pp1 dd2 pp2)
(data e c d1 p1 d2 p2))))
(<=> (dd1 pp1 dd2 pp2)
(d1 p1 d2 p2))))
((fail e c (d1 p1 x1) (d2 p2 x2) (d3 p3 x3))
(<pand> n (recur fail) ee cc
((fail (d1 p1 x1) (d2 p2 x2) (d3 p3 x3))
(<pand> n (recur fail) da ee cc
((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1))
(dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2))
(dd3 pp3 (gp-make-engine (+ n 1) 100) (goal-eval x3)))
(<=> (da ee cc dd1 pp1 dd2 pp2 dd2 pp3)
(data e c d1 p1 d2 p2 d3 p3))))
(<=> (dd1 pp1 dd2 pp2 dd2 pp3)
(d1 p1 d2 p2 d3 p3))))
((fail e c (d1 p1 x1) (d2 p2 x2) (d3 p3 x3) (d4 p4 x4))
(<pand> n (recur fail) ee cc
((fail (d1 p1 x1) (d2 p2 x2) (d3 p3 x3) (d4 p4 x4))
(<pand> n (recur fail) da ee cc
((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1))
(dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2))
(dd3 pp3 (gp-make-engine (+ n 1) 100) (goal-eval x3))
(dd4 pp4 (gp-make-engine (+ n 1) 100) (goal-eval x4)))
(<=> (da ee cc dd1 pp1 dd2 pp2 dd3 pp3 dd4 pp4)
(data e c d1 p1 d2 p2 d3 p3 d4 p4))))))
(<=> (dd1 pp1 dd2 pp2 dd3 pp3 dd4 pp4)
(d1 p1 d2 p2 d3 p3 d4 p4))))))
(define (fail- x) x)
......@@ -71,7 +72,7 @@
(call-with-values
(lambda ()
(apply conjunctioneur
(map (lambda (x) (gp_lookup s x)) l)))
(map (lambda (x) (gp-lookup s x)) l)))
(lambda (x y)
(cc s p x y))))
......@@ -79,17 +80,8 @@
(call-with-values
(lambda ()
(apply jack-the-zipper
(map (lambda (x) (gp_lookup s x)) l)))
(map (lambda (x) (gp-lookup s x)) l)))
(lambda (x y)
(cc s p x y))))
(compile-prolog-string "
same(F) :-
P <= F,
cc(P,F).
cycle(Data) :- length(Data,N), cycle(Data,0,N).
cycle(Data,I,N) :- ref(Data,I,P), II is (I + 1) % N, cc(P,cycle(II,N)).
")
......@@ -4,7 +4,8 @@
#: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 next-level))
#:export (<pand> <pzip> f test1 test2 test3 test4 next-level
conjunctioneur jack-the-zipper))
(define *cc* (@@ (logic guile-log run) *cc*))
......@@ -21,21 +22,22 @@
(define level 0)
(define next-level 0)
(define-guile-log <pand>
(lambda (x)
(define-syntax-rule (m x)
(define-syntax-rule (m x)
(case-lambda
(() x)
((a) (set! x a))))
(define-guile-log <pand>
(lambda (x)
(syntax-case x ()
((_ w n check data exit cc ((d pd engine code ...) ...) body ...)
(with-syntax (((v ...) (generate-temporaries #'(d...)))
((l ...) (generate-temporaries #'(d...)))
((cci ...) (generate-temporaries #'(d...)))
((st ...) (generate-temporaries #'(d...)))
((pd ...) (generate-temporaries #'(d...)))
((e ...) (generate-temporaries #'(d...)))
((se ...) (generate-temporaries #'(d...))))
(with-syntax (((v ...) (gen x "v" #'(d ...)))
((l ...) (gen x "l" #'(d ...)))
((cci ...) (gen x "cci" #'(d ...)))
((st ...) (gen x "st" #'(d ...)))
((e ...) (gen x "e" #'(d ...)))
((se ...) (gen x "se" #'(d ...))))
#'(<nvar> w (+ next-level 1) (v ...)
(let ((i level) (n next-level) (p P))
(<let-with-lr-guard>
......@@ -66,8 +68,7 @@
(if (cci)
(apply (cci) s p l)
(apply CC s p l)))
(<with-fail> (lambda ()
(<with-fail> (lambda () ((e)))
(<with-s> (gp-push-engine frame engine)
(<code> (gp-combine-push data))
(<code> (gp-var-set v (gp-peek-engine) S))
......@@ -89,7 +90,7 @@
(set! l next-level))
(<code> (set! se S))
(<code> (set! pd P))
(<code> (gp-pop-engine)))))))
(<code> (gp-pop-engine))))))
...
(<code> (set! chk check)))
......@@ -119,17 +120,22 @@
(define (recur f) (<lambda> (data) (<cc> f (recur f))))
(eval-when (eval load compile)
(define (gen w s c)
(map (lambda (x)
(datum->syntax w (gensym s)))
(syntax->datum c))))
(define-guile-log <pzip>
(lambda (x)
(syntax-case x ()
((_ w (code ...) ...)
(with-syntax (((p ...) (generate-temporaries #'((code ...) ...)))
((d ...) (generate-temporaries #'((code ...) ...)))
((pd ...) (generate-temporaries #'((code ...) ...))))
(with-syntax (((p ...) (gen x "p" #'((code ...) ...)))
((d ...) (gen x "d" #'((code ...) ...)))
((pd ...) (gen x "pd" #'((code ...) ...))))
(with-syntax (((zarg ...)
(fold-right (lambda (a b seed) (cons* a b seed))
'() #'(d ...) #'(pd ...))))
#'(<pand> w 0 (recur (jack-the-zipper zarg ...)) data exit cc
(fold-right cons* '() #'(d ...) #'(pd ...))))
#'(<pand> w n (recur (jack-the-zipper zarg ...)) data exit cc
((d pd (gp-make-engine (+ n 1) 100) code ...)
...))))))))
......@@ -205,7 +211,7 @@
(values d1 p1))
((d1 p1 d2 p2)
(let ((exit-1 (vector-ref d1 0))
(let* ((exit-1 (vector-ref d1 0))
(exit-2 (vector-ref d2 0))
(cc-1 (vector-ref d1 1))
(cc-2 (vector-ref d2 1))
......
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