build systems and better usr_zip

parent 8a8fee45
This diff is collapsed. Click to expand it.
......@@ -20,7 +20,8 @@ AC_SUBST(WARN_CFLAGS)
PKG_CHECK_MODULES(GUILE, [guile-2.0 >= 2.0.0])
GUILE_PROGS([2.0])
GUILE_PKG([2.2 2.0])
GUILE_PROGS
AC_CONFIG_FILES([Makefile])
AC_CONFIG_FILES([env], [chmod +x env])
......
......@@ -2019,6 +2019,27 @@ This is a construct that let you execute several goals in paralell. currently th
@code{update(tag,...)}, where the lanes associated to the tags @code{tag ...} is backtracked and updated with new solutions.
@subsubsection Examples
@verbatim
c(X,A) :- c(X,A,0).
c(X,A,N) :- N < 10,
(X = A ; (B is A + 1, M is N + 1, c(X,B,M))).
f(X,Y) :- zip(lane(X, c(X,0) ),
lane(Y, c(Y,100) )).
(prolog-run * (X Y) (f X Y))
$1 = ((0 100) (1 101) (2 102) (3 103) (4 104)
(5 105) (6 106) (7 107) (8 108) (9 109))
g(X,Y) :- usr_zip(lane(Tag_a,X,c(X,0)),
lane(Tag_b,Y,c(Y,0)),
(((X mod 2) == 0 -> update(Tag_a)),
((Y mod 1) == 0 -> update(Tag_b)))).
@end verbatim
@node prolog hash
@subsection Hash datastructure
The main hash datastructure is a vhash datastructure which is a assoc like hash with good lookup properties.
......
......@@ -16,101 +16,121 @@
(<define> (zip_ xs codes)
(<match> (#:mode - #:name zip_) (xs codes)
(() ()
<cc>)
(<cut> <cc>))
((x) (c)
(goal-eval c))
(<cut> (goal-eval c)))
((x1 x2) (c1 c2)
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))))
(<cut>
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2)))))
((x1 x2 x3) (c1 c2 c3)
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3))))
(<cut>
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3)))))
((x1 x2 x3 x4) (c1 c2 c3 c4)
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3))
(x4 (goal-eval c4))))
(<cut>
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3))
(x4 (goal-eval c4)))))
((x1 x2 x3 x4 . xl) (c1 c2 c3 c4 . cl)
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3))
(x4 (goal-eval c4))
(xl (zip_ xl cl))))))
(<cut>
(<zip> (x1 (goal-eval c1))
(x2 (goal-eval c2))
(x3 (goal-eval c3))
(x4 (goal-eval c4))
(xl (zip_ xl cl)))))))
(<define> (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)))
(<cut> (lp u (cons x a) (cons code b))))
(()
(<let> ((a (reverse! a))
(b (reverse! b)))
(zip_ a b)))
(<cut>
(zip_ a b))))
(_ (type_error lane l)))))
(define-syntax-rule (mk f)
(<lambda> (n)
(case n
((1) (<update> (f)))
((2) (<update-val> (f))))))
(<define> (usr_zip_ fs xs cs guard)
(<match> (#:mode - #:name zip_) (fs xs codes)
(() () ()
<cc>)
((f) (x) (c)
(<//> ((df ((y x)) (goal-eval c)))
(<=> x y) (<=> f df)
(goal-eval guard)))
((f1 f2) (x1 x2) (c1 c2)
(<//> ((df1 ((y1 x1)) (goal-eval c1))
(df2 ((y2 x2)) (goal-eval c2)))
(<=> (x1 x2) (y1 y2))
(<=> (f1 f2) (df1 df2))
(goal-eval guard)))
((f1 f2 f3) (x1 x2 x3) (c1 c2 c3)
(<//> ((df1 ((y1 x1)) (goal-eval c1))
(df2 ((y2 x2)) (goal-eval c2))
(df3 ((y3 x3)) (goal-eval c3)))
(<=> (x1 x2 x3) (y1 y2 y3))
(<=> (f1 f2 f3) (df1 df2 df3))
(goal-eval guard)))
((f1 f2 f3 f4) (x1 x2 x3 x4) (c1 c2 c3 c4)
(<//> ((df1 ((y1 x1)) (goal-eval c1))
(df2 ((y2 x2)) (goal-eval c2))
(df3 ((y3 x3)) (goal-eval c3))
(df4 ((y4 x4)) (goal-eval c4)))
(<=> (x1 x2 x3 x4) (y1 y2 y3 y4))
(<=> (f1 f2 f3 f4) (df1 df2 df3 df4))
(goal-eval guard)))
((f1 f2 f3 f4 . fl) (x1 x2 x3 x4 . xl) (c1 c2 c3 c4 . cl)
(<//> ((df1 ((y1 x1)) (goal-eval c1))
(df2 ((y2 x2)) (goal-eval c2))
(df3 ((y3 x3)) (goal-eval c3))
(df4 ((y4 x4)) (goal-eval c4)))
(<=> (x1 x2 x3 x4) (y1 y2 y3 y4))
(<=> (f1 f2 f3 f4) (df1 df2 df3 df4))
(usr_zip fl xl cl guard)))))
(<let> ((n (length fs)))
(case n
((0) <cc>)
((1)
(<match> (#:mode - #:name usr_zip_1) (fs xs cs)
((f) (x) (c)
(<cut>
(<//> ((df ((y x)) (goal-eval c)))
(<=> x y) (<=> f ,(mk df))
(goal-eval guard))))))
((2)
(<match> (#:mode - #:name usr_zip_2) (fs xs cs)
((f1 f2) (x1 x2) (c1 c2)
(<cut>
(<//> ((df1 ((y1 x1)) (goal-eval c1))
(df2 ((y2 x2)) (goal-eval c2)))
(<=> (x1 x2) (y1 y2))
(<=> (f1 f2) (,(mk df1) ,(mk df2)))
(goal-eval guard))))))
((3)
(<match> (#:mode - #:name usr_zip_3) (fs xs cs)
((f1 f2 f3) (x1 x2 x3) (c1 c2 c3)
(<cut>
(<//> ((df1 ((y1 x1)) (goal-eval c1))
(df2 ((y2 x2)) (goal-eval c2))
(df3 ((y3 x3)) (goal-eval c3)))
(<=> (x1 x2 x3) (y1 y2 y3))
(<=> (f1 f2 f3) (,(mk df1) ,(mk df2) ,(mk df3)))
(goal-eval guard))))))
((4)
(<match> (#:mode - #:name usr_zip_4) (fs xs cs)
((f1 f2 f3 f4) (x1 x2 x3 x4) (c1 c2 c3 c4)
(<cut>
(<//> ((df1 ((y1 x1)) (goal-eval c1))
(df2 ((y2 x2)) (goal-eval c2))
(df3 ((y3 x3)) (goal-eval c3))
(df4 ((y4 x4)) (goal-eval c4)))
(<=> (x1 x2 x3 x4) (y1 y2 y3 y4))
(<=> (f1 f2 f3 f4) (,(mk df1) ,(mk df2) ,(mk df3) ,(mk df4)))
(goal-eval guard))))))
(else
(syntax_error "unsuported usr_zip number of lanes")))))
(<define> (usr_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)))
(<cut>
(lp u (cons f a) (cons x b) (cons cs c))))
((guard)
(usr_zip_ (reverse! a) (reverse! b) (reverse! c) guard))
(<cut>
(usr_zip_ (reverse! a) (reverse! b) (reverse! c) guard)))
(_
(type_error lane l)))))
(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
(define update
(<case-lambda>
((x)
(<let> ((y (<lookup> x)))
(y 1)))
((x . l)
(<let> ((y (<lookup> x)))
(y 2)
(<apply> update l)))))
......@@ -20,7 +20,7 @@
(vector `(,f ,(fkn-it x) ...)))
((_ x) x)))
(define *debug* #f)
(define *debug* #t)
(define (call-with-eh th . l)
(if *debug*
(call-with-error-handling th)
......
......@@ -58,7 +58,7 @@ ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/libtool.m4 \
$(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \
$(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \
$(top_srcdir)/configure.ac
$(top_srcdir)/acinclude.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
......@@ -194,11 +194,13 @@ EGREP = /bin/grep -E
EXEEXT =
FGREP = /bin/grep -F
GREP = /bin/grep
GUILD = /usr/bin/guild
GUILE = /usr/bin/guile
GUILE_CFLAGS = -pthread -I/usr/include/guile/2.0
GUILE_CONFIG = /usr/bin/guile-config
GUILE_EFFECTIVE_VERSION = 2.0
GUILE_LIBS = -lguile-2.0 -lgc
GUILE_TOOLS = /usr/bin/guile-tools
GUILE_TOOLS = /usr/bin/guild
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
......
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