paralell compiles

parent c9503a87
...@@ -8,33 +8,34 @@ ...@@ -8,33 +8,34 @@
(define (recur Goal) (define (recur Goal)
(<lambda> (data) (<lambda> (data)
(<values> (f Next) (goal-eval Goal)) (<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) (<<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 (<pand> n (recur fail) da ee cc
((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1)) ((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1))
(dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2))) (dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2)))
(<=> (da ee cc dd1 pp1 dd2 pp2) (<=> (dd1 pp1 dd2 pp2)
(data e c d1 p1 d2 p2)))) (d1 p1 d2 p2))))
((fail e c (d1 p1 x1) (d2 p2 x2) (d3 p3 x3)) ((fail (d1 p1 x1) (d2 p2 x2) (d3 p3 x3))
(<pand> n (recur fail) ee cc (<pand> n (recur fail) da ee cc
((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1)) ((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1))
(dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2)) (dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2))
(dd3 pp3 (gp-make-engine (+ n 1) 100) (goal-eval x3))) (dd3 pp3 (gp-make-engine (+ n 1) 100) (goal-eval x3)))
(<=> (da ee cc dd1 pp1 dd2 pp2 dd2 pp3) (<=> (dd1 pp1 dd2 pp2 dd2 pp3)
(data e c d1 p1 d2 p2 d3 p3)))) (d1 p1 d2 p2 d3 p3))))
((fail e c (d1 p1 x1) (d2 p2 x2) (d3 p3 x3) (d4 p4 x4)) ((fail (d1 p1 x1) (d2 p2 x2) (d3 p3 x3) (d4 p4 x4))
(<pand> n (recur fail) ee cc (<pand> n (recur fail) da ee cc
((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1)) ((dd1 pp1 (gp-make-engine (+ n 1) 100) (goal-eval x1))
(dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2)) (dd2 pp2 (gp-make-engine (+ n 1) 100) (goal-eval x2))
(dd3 pp3 (gp-make-engine (+ n 1) 100) (goal-eval x3)) (dd3 pp3 (gp-make-engine (+ n 1) 100) (goal-eval x3))
(dd4 pp4 (gp-make-engine (+ n 1) 100) (goal-eval x4))) (dd4 pp4 (gp-make-engine (+ n 1) 100) (goal-eval x4)))
(<=> (da ee cc dd1 pp1 dd2 pp2 dd3 pp3 dd4 pp4) (<=> (dd1 pp1 dd2 pp2 dd3 pp3 dd4 pp4)
(data e c d1 p1 d2 p2 d3 p3 d4 p4)))))) (d1 p1 d2 p2 d3 p3 d4 p4))))))
(define (fail- x) x) (define (fail- x) x)
...@@ -71,7 +72,7 @@ ...@@ -71,7 +72,7 @@
(call-with-values (call-with-values
(lambda () (lambda ()
(apply conjunctioneur (apply conjunctioneur
(map (lambda (x) (gp_lookup s x)) l))) (map (lambda (x) (gp-lookup s x)) l)))
(lambda (x y) (lambda (x y)
(cc s p x y)))) (cc s p x y))))
...@@ -79,17 +80,8 @@ ...@@ -79,17 +80,8 @@
(call-with-values (call-with-values
(lambda () (lambda ()
(apply jack-the-zipper (apply jack-the-zipper
(map (lambda (x) (gp_lookup s x)) l))) (map (lambda (x) (gp-lookup s x)) l)))
(lambda (x y) (lambda (x y)
(cc s p 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 @@ ...@@ -4,7 +4,8 @@
#: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 next-level)) #:export (<pand> <pzip> f test1 test2 test3 test4 next-level
conjunctioneur jack-the-zipper))
(define *cc* (@@ (logic guile-log run) *cc*)) (define *cc* (@@ (logic guile-log run) *cc*))
...@@ -21,21 +22,22 @@ ...@@ -21,21 +22,22 @@
(define level 0) (define level 0)
(define next-level 0) (define next-level 0)
(define-syntax-rule (m x)
(case-lambda
(() x)
((a) (set! x a))))
(define-guile-log <pand> (define-guile-log <pand>
(lambda (x) (lambda (x)
(define-syntax-rule (m x)
(case-lambda
(() x)
((a) (set! x a))))
(syntax-case x () (syntax-case x ()
((_ w n check data exit cc ((d pd engine code ...) ...) body ...) ((_ w n check data exit cc ((d pd engine code ...) ...) body ...)
(with-syntax (((v ...) (generate-temporaries #'(d...))) (with-syntax (((v ...) (gen x "v" #'(d ...)))
((l ...) (generate-temporaries #'(d...))) ((l ...) (gen x "l" #'(d ...)))
((cci ...) (generate-temporaries #'(d...))) ((cci ...) (gen x "cci" #'(d ...)))
((st ...) (generate-temporaries #'(d...))) ((st ...) (gen x "st" #'(d ...)))
((pd ...) (generate-temporaries #'(d...))) ((e ...) (gen x "e" #'(d ...)))
((e ...) (generate-temporaries #'(d...))) ((se ...) (gen x "se" #'(d ...))))
((se ...) (generate-temporaries #'(d...))))
#'(<nvar> w (+ next-level 1) (v ...) #'(<nvar> w (+ next-level 1) (v ...)
(let ((i level) (n next-level) (p P)) (let ((i level) (n next-level) (p P))
(<let-with-lr-guard> (<let-with-lr-guard>
...@@ -58,7 +60,7 @@ ...@@ -58,7 +60,7 @@
(frame (<newframe>)) (frame (<newframe>))
(d (vector (m e) (m cci) (m st))) ... (d (vector (m e) (m cci) (m st))) ...
(exit P) (exit P)
(s frame)) (s frame))
(let ((cc CC)) (let ((cc CC))
(<with-s> s (<with-s> s
(<code> (set! st CC)) (<code> (set! st CC))
...@@ -66,8 +68,7 @@ ...@@ -66,8 +68,7 @@
(if (cci) (if (cci)
(apply (cci) s p l) (apply (cci) s p l)
(apply CC s p l))) (apply CC s p l)))
(<with-fail> (lambda () (<with-fail> (lambda () ((e)))
(<with-s> (gp-push-engine frame engine) (<with-s> (gp-push-engine frame engine)
(<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))
...@@ -89,10 +90,10 @@ ...@@ -89,10 +90,10 @@
(set! l next-level)) (set! l next-level))
(<code> (set! se S)) (<code> (set! se S))
(<code> (set! pd P)) (<code> (set! pd P))
(<code> (gp-pop-engine))))))) (<code> (gp-pop-engine))))))
... ...
(<code> (set! chk check))) (<code> (set! chk check)))
;; The stub below is always executed last at a backtrack ;; The stub below is always executed last at a backtrack
...@@ -119,17 +120,22 @@ ...@@ -119,17 +120,22 @@
(define (recur f) (<lambda> (data) (<cc> f (recur f)))) (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> (define-guile-log <pzip>
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((_ w (code ...) ...) ((_ w (code ...) ...)
(with-syntax (((p ...) (generate-temporaries #'((code ...) ...))) (with-syntax (((p ...) (gen x "p" #'((code ...) ...)))
((d ...) (generate-temporaries #'((code ...) ...))) ((d ...) (gen x "d" #'((code ...) ...)))
((pd ...) (generate-temporaries #'((code ...) ...)))) ((pd ...) (gen x "pd" #'((code ...) ...))))
(with-syntax (((zarg ...) (with-syntax (((zarg ...)
(fold-right (lambda (a b seed) (cons* a b seed)) (fold-right cons* '() #'(d ...) #'(pd ...))))
'() #'(d ...) #'(pd ...)))) #'(<pand> w n (recur (jack-the-zipper zarg ...)) data exit cc
#'(<pand> w 0 (recur (jack-the-zipper zarg ...)) data exit cc
((d pd (gp-make-engine (+ n 1) 100) code ...) ((d pd (gp-make-engine (+ n 1) 100) code ...)
...)))))))) ...))))))))
...@@ -205,16 +211,16 @@ ...@@ -205,16 +211,16 @@
(values d1 p1)) (values d1 p1))
((d1 p1 d2 p2) ((d1 p1 d2 p2)
(let ((exit-1 (vector-ref d1 0)) (let* ((exit-1 (vector-ref d1 0))
(exit-2 (vector-ref d2 0)) (exit-2 (vector-ref d2 0))
(cc-1 (vector-ref d1 1)) (cc-1 (vector-ref d1 1))
(cc-2 (vector-ref d2 1)) (cc-2 (vector-ref d2 1))
(start-1 (vector-ref d1 2)) (start-1 (vector-ref d1 2))
(start-2 (vector-ref d2 2)) (start-2 (vector-ref d2 2))
(start (lambda (s p) (start (lambda (s p)
(vector-set! cc-1 1 start-2) (vector-set! cc-1 1 start-2)
(start-1 s p))) (start-1 s p)))
(d (vector exit-1 cc-2 0 start))) (d (vector exit-1 cc-2 0 start)))
(variable-set! exit-2 (variable-set! exit-2
(lambda () (lambda ()
......
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