Added zip for prolog

parent 1217f331
......@@ -65,7 +65,8 @@ SOURCES = \
logic/guile-log/guile-prolog/continuations.scm \
logic/guile-log/guile-prolog/hash.scm \
logic/guile-log/guile-prolog/dynamic-features.scm \
logic/guile-log/guile-prolog/interleave.scm
logic/guile-log/guile-prolog/interleave.scm \
logic/guile-log/guile-prolog/zip.scm
AM_MAKEINFOFLAGS=--force
AM_MAKEINFOHTMLFLAGS=--force
......
......@@ -2001,6 +2001,14 @@ pr(F,S) :- next(F,X,FF) -> feed(S,X,SS), pr(FF,SS).
@end verbatim
@node prolog zip
@subsection Zip like constructs
This is a construct that let you execute several goals in paralell. currently this is not the same as executing it on multiple threads or processors, it's more that you want to synch solutions to several goal at the same time. The interface sports two commands, one simpler @code{zip}, for use, when the goal's are synchronized, and another one @code{usr_zip}, for the case when one would like to test the output and in depending on the outcome take the next solution for a subset of the branches.
@subsubsection Api
@code{zip(lane(V,Goal),...)}, will execute @code{Goal ...}, in parallel and output the values of the variables @code{V...}, for the different branches.
@code{usr_zip(lane(tag,V,Goal),...,guard)}, this is the same as @code{zip}, but we will tag the @code{lane} as well. Inside @code{guard}, one can execute a command
@code{update(tag,...)}, where the lanes associated to the tags @code{tag ...} is backtracked and updated with new solutions.
@node prolog hash
@subsection Hash datastructure
......
......@@ -5,24 +5,10 @@
#:use-module (logic guile-log prolog goal-functors)
#:use-module (logic guile-log iso-prolog)
#:export (abort_to_prompt with_prompt generator next yield translate
re_prompt call_k
re_prompt call_k))
run run2 run3 run4))
;; Sielence the compiler
(define eat #f)
(define feed #f)
(define iter #f)
(define pr #f)
(define pr2 #f)
(define pr3 #f)
(define pr4 #f)
(define n #f)
(define y #f)
(define sum #f)
(define iter2 #f)
(define iter3 #f)
(define iter4 #f)
(define eat #f)
(define feed #f)
(define prompt-tag (list 'prolog-prompt))
(<define> (abort_to_prompt tag data feed)
......@@ -58,7 +44,7 @@
(goal-eval handle))
(list data)))))
(define (call_k K D) (((<lookup> K)) D))
(<define> (call_k K D) (((<lookup> K)) D))
(compile-prolog-string "yield(X) :- abort_to_prompt(generator,X,_).")
(compile-prolog-string "eat(X) :- abort_to_prompt(generator,_,X).")
......@@ -77,23 +63,4 @@ translate([K,X],X,Y,F) :- re_prompt(K,[generator,_,K2,XX],F=[K2,XX],Y).
")
;; Example 1 (run)
(compile-prolog-string
"
sum(S) :- write(sum(S)),nl,eat(X),write(y(X)),nl,SS is S + X,sum(SS).
run :- generator(iter(0),F),generator(sum(0),S),pr(F,S).
pr(F,S) :- next(F,X,FF) -> write(n(X)),nl, feed(S,X,SS),pr(FF,SS).
iter(N) :- write(iter(N)),nl,N < 10 -> (yield(N),N2 is N + 1, iter(N2)).
")
;; Example 2 (run2)
(compile-prolog-string
"
iter2(N) :- write(iter2(N)),nl,N < 10 -> (yield(N) ; N2 is N + 1, iter2(N2)).
run2 :- generator(iter2(0),F),pr2(F,_).
pr2(F,_) :- next(F,_,_),fail.
")
\ No newline at end of file
......@@ -4,7 +4,7 @@
#:use-module (logic guile-log prolog names)
#:use-module (logic guile-log prolog goal-functors)
#:use-module (logic guile-log prolog goal-transformers)
#:export (zip #;usr_zip #;update lane update))
#:export (zip usr_zip lane update))
(define-syntax-rule (mk-sym a)
(begin
......@@ -39,16 +39,21 @@
(xl (zip_ xl cl))))))
(<define> (zip . l)
(<match> (#:mode - #:name zip) (l)
((#((,lane x code)) ...)
(zip_ x code))
(_
(type_error zip l))))
#;
(<recur> lp ((l l) (a '()) (b '()))
(<match> (#:mode - #:name zip) (l)
((#((,lane x code)) . u)
(lp u (cons x a) (cons code b)))
(()
(<let> ((a (reverse! a))
(b (reverse! b)))
(zip_ a b)))
(_ (type_error lane l)))))
(<define> (usr_zip_ fs xs cs guard)
(<match> (#:mode - #:name zip_) (fs xs codes)
(() () ()
(goal-eval guard))
<cc>)
((f) (x) (c)
(<//> ((df ((y x)) (goal-eval c)))
......@@ -89,19 +94,23 @@
(usr_zip fl xl cl guard)))))
#;
(<define> (usr_zip . l)
(<match> (#:mode - #:name zip) (l)
((#((,lane f x cs)) ... guard)
(usr_zip_ f x cs guard))
(_
(type_error zip l))))
(<recur> lp ((l l) (a '()) (b '()) (c '()))
(<match> (#:mode - #:name usr_zip) (l)
((#((,lane f x cs)) . u)
(lp u (cons f a) (cons x a) (cons cs c)))
((guard)
(usr_zip_ (reverse! a) (reverse! b) (reverse! c) guard))
(_
(type_error lane l)))))
#;
(define update
(<case-lambda>
((x)
(<update> ((<lookup> x))))
((x . l)
(<update-val> ((<lookup> x)))
(<apply> update l))))
\ No newline at end of file
(define-syntax update
(syntax-rules ()
((_ x)
(<update> ((<lookup> x))))
((_ x . l)
(<and>
(<update-val> ((<lookup> x)))
(<apply> update l)))))
\ No newline at end of file
......@@ -525,7 +525,7 @@ and-interleave
...
(rguard
(</.> (<let> ((ccx CC))
(<fluid-let-syntax> ((CC2 (lambda z #'ccx)))
(<syntax-parameterize> ((CC2 (lambda z #'ccx)))
(<or> <cc>
(<update-val> (fail) ...))
body ...))))))))))))))
......
......@@ -26,7 +26,7 @@
tr S P CC CUT <scm>
<with-generators> <next-generator-value>
<cons> <cons?> <var?> <values> <windlevel>
<fluid-let-syntax>
<syntax-parameterize>
<car> <cdr> <logical++> <logical-->
define-guile-log-parser-tool
<newframe> <unwind>
......
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