diff --git a/doc/guile-log.texi b/doc/guile-log.texi index d9416cb7845817d8091157cebe2a53d03c9fc6a1..8df3ed7fef171be405aa0bdbc31693a98e609abd 100644 --- a/doc/guile-log.texi +++ b/doc/guile-log.texi @@ -2573,6 +2573,7 @@ Guile log also sports an iso-prolog interface as a logic programming interface b * scheme:: Hooking in scheme expressions * functors:: map funcitons to functions * closures:: Using closures in prolog +* continuations:: Advanced management af what to continue with * extended matching:: Matching extensions deviating from normal prolog * prolog-dynamic-functions:: A discussion of guile log's version of this * dynamic-features:: Special construct to manage dynamic objects @@ -2981,6 +2982,91 @@ To reflect the closure we have from @code{[use-modules (logic guile-log guile-pr @code{prolog closure_code_ref(Cl,F)}, will expose the code of the closure @code{Cl} into @code{F}. +@node continuations +@section continuation expressions +Prolog passes all in,out,in/out values as arguments to the predicate. This has the drawback, for out variables, that the variables need to be allocated from the heap and adds complexity and overhead to the predicate. If in stead the out variables could be passed over without making a box for it first we get possible much less complexity of the predicate and hence better performance. So let's see the semantics that I plan to add to guile-log and already works today in a experimental compiler of an experimental prolog VM that is included in the guile-log sources. Also vy managing the continuation return values we increase the expressability of our program. The extension uses the binary @code{<=} operator and for annonymous continuation forms @code{cc}. So the basic form is + +@findex <= +@findex cc + +@verbatim + % Executing a goal with out variables + [V1, ..., Vn] <= goal. + + % Executing a goal with named out variables placed where out may be + % referenced by executing the goal 'F(...)' + + F(V1, ..., Vn) <= goal.` + % lets make a predicate that outputs a pure out variable, cc(X,...) + % exits to the prevoius `<=` and return X,... to it. + + sum(X,Y) :- + Z is X + Y, + cc(Z). + + % and let's use it + printsum(X,Y) :- + [Z1] <= sum(X,Y), + write(output(Z1)),nl. + + % we can also just inline code + printsum(X,Y) :- + [Z1] <= (X < Y -> (Q is X + Y, cc(Q)) ; cc(X)), + write(output(Z1)),nl. +@end verbatim + +Now, it it is possible to compile ordinary old versions of prolog code to take advantage of this system. But I tend to like the clarity of the code where out variables are explicit. + +A possible extention for this would be a @code{Tag(V1,...)} version, e.g. + +@verbatim + % we can also just inline code + printsum(X,Y) :- + A(Z1) <= (X < Y -> (Q is X + Y, cc(Q)) ; A(X)), + write(output(Z1)),nl. +@end verbatim + +Then if we have multiple exit points then one can sellect the outer one with the correct tag. Note that this is very similar to @code{catch/throw} in prolog. The taged one only works in explicit code, if tags needs to be catched from inside an evaluation of a predicate, then use @code{catch/throw}. This system has it's value because the @code{catch/throw} is pinned down to assume a predicate can indeed make a throw, but with the @code{cc(...)} and @code{F(...)} the predicates at tail position in the goal clause is the only one that allow a @code{cc/F}-throw. Also a difference is that @code{cc} is a continuation, hence the name, e.g. it is not a throw or return in which the bindings are undone as with throw catch. + +So to summarize, this extension is only to enable more effective code and enable more opertunity for uses of the stack, @code{catach/throw} is more generall and don't enable this oppertunity due to this. + +Some examples: + +@verbatim + ?- [X] <= cc(1). + + X = 1. + + ?- [X] <= cc(1,2). + + no + + ?- [X,Y] <= cc(1,2). + + X = 1, + Y = 2. + + ?- X <= cc(1,2). + + X = [1, 2]. + + ?- F(X) <= ((Y <= F(1)),(write(y(Y)),nl)) + + X = 1, + F = lam. + + ?- F(|X) <= ((Y <= F(1)),(write(y(Y)),nl)) + + X = [1], + F = lam. + + ?- F(A|X) <= ((Y <= F(1,2,3)),(write(y(Y)),nl)) + + A = 1, + X = [2, 3], + F = lam. +@end verbatim + @node extended matching @section Extended Matching. Good indexing of prolog clauses means mainly that fewer misstakes of leaving @@ -3034,7 +3120,6 @@ In the future we will allow som basic tests like @code{var,integer,...} etc that - @node prolog-dynamic-functions @section Explaing the guile-log dynamic functions Dynamic functions in guile-log prolog follows the iso prolog interface. But they are more powerful. They belong to a class of object that we can call dynamic objects for which dynamic features can be added how to backtrack store and restore state. The driving feature is that the state infromation is updated in a funcitonal manner and that its encapsulated with a thread safe handle. But the datastructure are not only functional, in order to have decent properties in prolog program and let them for example back track with the logic program we allow a mark and reset feature. To understand this scope please read about dynamic features. The dynamic functions are optimized for fast lookup and guile log prolog is fully indexed and can yield the matching items faster than it takes to actually perform any common match consequent. The target is for systems that update seldom and do lookup often. The dynamic functions @code{assert*} compainion will compile the program to bytecode/native for faster execution. Do not use dynamic functions as a hash table that updates often, for that use the hash table library. Also currently at most 10000 elements can be stored for a dynamic function. (The algorithm scales badly after that and we do not support larger than that). diff --git a/doc/guile-log/Index.html b/doc/guile-log/Index.html index 59d56c175c4dca2c4a2040a497b5b3104fe30a87..8b33d5413f36354d38ec4239bbca0b19575ef531 100644 --- a/doc/guile-log/Index.html +++ b/doc/guile-log/Index.html @@ -2,7 +2,7 @@ - + Preliminary Manual: Index @@ -19,16 +19,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -48,7 +47,7 @@ ul.no-bullet {list-style: none} - +

@@ -128,6 +127,7 @@ Previous: <<define->>guile-log <<define>>guile-log <<lambda>>guile-log +<=continuations <==>guile-log <=>guile-log <abort>dynamics @@ -324,6 +324,7 @@ Previous: canonizeprolog canonical caseguile-log CCguile-log +cccontinuations close_error_falseclosures close_error_trueclosures closure_code_refclosures diff --git a/doc/guile-log/acumulators_002fgenerators.html b/doc/guile-log/acumulators_002fgenerators.html index 52e3f610a5fa898430350bcd7222fde617d52509..61d5804ef5f778e76ccec6532e4d41de1242bbc6 100644 --- a/doc/guile-log/acumulators_002fgenerators.html +++ b/doc/guile-log/acumulators_002fgenerators.html @@ -2,7 +2,7 @@ - + Preliminary Manual: acumulators/generators @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/dynamic_002dfunctions.html b/doc/guile-log/dynamic_002dfunctions.html index e076ed55ea2e70fe0a754954ac6d778209588aac..d7e2e67933ff242bb6e5f3ec1b069b60f00d865a 100644 --- a/doc/guile-log/dynamic_002dfunctions.html +++ b/doc/guile-log/dynamic_002dfunctions.html @@ -2,7 +2,7 @@ - + Preliminary Manual: dynamic-functions @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/dynamics.html b/doc/guile-log/dynamics.html index 01ac6a52a33bbf14c68df1cff8da16f96ea03819..9df3b2d2b7c5c28d9558dfcb67106ca8704cff46 100644 --- a/doc/guile-log/dynamics.html +++ b/doc/guile-log/dynamics.html @@ -2,7 +2,7 @@ - + Preliminary Manual: dynamics @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/expressions.html b/doc/guile-log/expressions.html index b3a08421c65fedea323ff9ae314861d741160ce1..e364c6e98a12fa267752d0bae0bc6d87db363fa3 100644 --- a/doc/guile-log/expressions.html +++ b/doc/guile-log/expressions.html @@ -2,7 +2,7 @@ - + Preliminary Manual: expressions @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/garbage_002dcollect.html b/doc/guile-log/garbage_002dcollect.html index 3d3652490a14e64e2a8c5dc504fd3331b70a60c3..15b02ca6fb73a27049971a8420082aa11d0a7b91 100644 --- a/doc/guile-log/garbage_002dcollect.html +++ b/doc/guile-log/garbage_002dcollect.html @@ -2,7 +2,7 @@ - + Preliminary Manual: garbage-collect @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/guile_002dlog.html b/doc/guile-log/guile_002dlog.html index 9719d3e62b0aed2a9e2660782b558af23e56ed0f..32b439551465d1eb7637fdad05bce5d5aaf86aa2 100644 --- a/doc/guile-log/guile_002dlog.html +++ b/doc/guile-log/guile_002dlog.html @@ -2,7 +2,7 @@ - + Preliminary Manual: guile-log @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/index.html b/doc/guile-log/index.html index e96b04604654315520f2de4ecee49f745bb016cc..8cf22c8b5ac40e1af66715ba19d0a86404107974 100644 --- a/doc/guile-log/index.html +++ b/doc/guile-log/index.html @@ -2,7 +2,7 @@ - + Preliminary Manual: Top @@ -19,16 +19,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -48,7 +47,7 @@ ul.no-bullet {list-style: none} - +

Preliminary Manual

diff --git a/doc/guile-log/kanren.html b/doc/guile-log/kanren.html index 3a878e067854b4f8240cbf082fed890d1622c733..fc8a8bd81b2c3e27860684b274ee482748792b42 100644 --- a/doc/guile-log/kanren.html +++ b/doc/guile-log/kanren.html @@ -2,7 +2,7 @@ - + Preliminary Manual: kanren @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/parser-combinators.html b/doc/guile-log/parser-combinators.html index 8b58125cc871e776103a08fe55eadc6d1702b72c..b5d1d9029ba8a2fe540696f7833dc13627a63cac 100644 --- a/doc/guile-log/parser-combinators.html +++ b/doc/guile-log/parser-combinators.html @@ -2,7 +2,7 @@ - + Preliminary Manual: parser combinators @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/parsing.html b/doc/guile-log/parsing.html index 9c885aaaa445ebad3bf51aaf8de728d35b8cc60b..75869320cf702af40cbe0aec62664fd7ddb888ef 100644 --- a/doc/guile-log/parsing.html +++ b/doc/guile-log/parsing.html @@ -2,7 +2,7 @@ - + Preliminary Manual: parsing @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/postpone.html b/doc/guile-log/postpone.html index 168abead2ca7a5c40295b2674d7541a487e77d40..1d7cfa1d86d76cf08c6e6c7721592c4a49ca82c6 100644 --- a/doc/guile-log/postpone.html +++ b/doc/guile-log/postpone.html @@ -2,7 +2,7 @@ - + Preliminary Manual: postpone @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/prolog.html b/doc/guile-log/prolog.html index 3bf08ebaf19a625537f18164e2a6fac5401adb03..e905c1b1f3c6b69e23ae098e3938ba646035f07f 100644 --- a/doc/guile-log/prolog.html +++ b/doc/guile-log/prolog.html @@ -2,7 +2,7 @@ - + Preliminary Manual: prolog @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

@@ -75,9 +74,11 @@ Next: closures:  Using closures in prolog -• extended matching:  Matching extensions deviating from normal prolog +• continuations:  Advanced management af what to continue with -• prolog-dynamic-functions:  A discussion of guile log’s version of this +• extended matching:  Matching extensions deviating from normal prolog + +• prolog-dynamic-functions:  A discussion of guile log’s version of this • dynamic-features:  Special construct to manage dynamic objects diff --git a/doc/guile-log/sed_002fgrep.html b/doc/guile-log/sed_002fgrep.html index c7667a90f680e05c3ec030733a3094b67ab9ab07..60bb774d3cce337dec13cb7500ed3a6ba0b34a44 100644 --- a/doc/guile-log/sed_002fgrep.html +++ b/doc/guile-log/sed_002fgrep.html @@ -2,7 +2,7 @@ - + Preliminary Manual: sed/grep @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/stream-ideom.html b/doc/guile-log/stream-ideom.html index 607e5ba9999e98b6ef7085584312500c78613636..f15af86455f10df0be3eec03ef867d94dafb1a46 100644 --- a/doc/guile-log/stream-ideom.html +++ b/doc/guile-log/stream-ideom.html @@ -2,7 +2,7 @@ - + Preliminary Manual: stream ideom @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/doc/guile-log/umatch.html b/doc/guile-log/umatch.html index ba28b1f2cad9271d0733c034835dd1bf609b3db1..7f8949e89b4ef635ea6754fbe5761b085cac3a6e 100644 --- a/doc/guile-log/umatch.html +++ b/doc/guile-log/umatch.html @@ -2,7 +2,7 @@ - + Preliminary Manual: umatch @@ -20,16 +20,16 @@ Copyright (C) 2012 Stefan Israelsson Tampe --> @@ -49,7 +48,7 @@ ul.no-bullet {list-style: none} - +

diff --git a/logic/guile-log/iso-prolog.scm b/logic/guile-log/iso-prolog.scm index 32c4e8501fe7338756e37a62d829b4614e2f75d4..8f11622a0c64db84dcea19f4c5b8e7293c44df98 100644 --- a/logic/guile-log/iso-prolog.scm +++ b/logic/guile-log/iso-prolog.scm @@ -40,7 +40,7 @@ #:use-module ((logic guile-log functional-database) #:select (extended interleaved extended_interleaved)) #:use-module (logic guile-log guile-prolog copy-term) - #:export (reset-flags reset-prolog set) + #:export (reset-flags reset-prolog set cc) #:replace (sort load) #:re-export (;;guile stuff @@ -253,7 +253,7 @@ ;; Standard operator functors, these symbols need to be in the ;; current module and those are maped en evaluation. - ^ :- | #{,}# #{,,}# -> #{\\+}# op2= == =.. -i> *-> + ^ :- | #{,}# #{,,}# -> #{\\+}# op2= op2<= == =.. -i> *-> #{\\=}# #{\\==}# @< @> @>= @=< is op2: op2+ op2- op1+ op1- #{\\}# op2* op2/ // rem mod div ** << >> #{/\\}# #{\\/}# op2< op2> op2>= op2=< =:= #{=\\=}# @@ -406,3 +406,5 @@ sort(X,L) :- msort(X,LL),unique(LL,L). (set! (@@ (logic guile-log prompts) cp) (@@ (logic guile-log guile-prolog copy-term) cp)) + +(define (cc s p c . l) (apply c s p l)) diff --git a/logic/guile-log/prolog/base.scm b/logic/guile-log/prolog/base.scm index e6702d2a6e270fce7b1606a05a1fc1ed3c60cf3d..909f2d973ccec02d042b8c23ca2a1c9f8be12422 100644 --- a/logic/guile-log/prolog/base.scm +++ b/logic/guile-log/prolog/base.scm @@ -599,7 +599,7 @@ (#,(G list) #,@vstx) #,closed?))))) parent)))) - (pp 'res #`(let () #,@ini (#,nm #,@vstx)))) + (ppp 'res #`(let () #,@ini (#,nm #,@vstx)))) (with-syntax (((lam-def ...) (let lp ((l (fluid-ref lambdas))) (match l @@ -614,7 +614,7 @@ (let* ((syms (get-syms)) (syms (union syms syms))) - (pp 'res #`(begin + (ppp 'res #`(begin #,@mod (eval-when (compile load eval) (add-non-defined diff --git a/logic/guile-log/prolog/goal-transformers.scm b/logic/guile-log/prolog/goal-transformers.scm index 85e3e750891321f33030bc6d537be6c58a2f82bb..7ddf7ea3fb87865c7f131acae2f87e9f62fdd35f 100644 --- a/logic/guile-log/prolog/goal-transformers.scm +++ b/logic/guile-log/prolog/goal-transformers.scm @@ -47,11 +47,11 @@ once once_i *once* once-f -var -atom halt - + uniq yield_at_change ^ :- #{,}# #{,,}# -> #{\\+}# op2= == =@= | -i> *-> - #{\\=}# #{\\==}# #{\\=@=}# @< @> @>= @=< is + #{\\=}# #{\\==}# #{\\=@=}# @< @> @>= @=< is op2<= op2+ op2- op1- op1+ #{\\}# op2* op2/ // rem mod div ** << >> #{/\\}# #{\\/}# op2< op2> op2>= op2=< =:= #{=\\=}# =.. --> ? $ ?- @@ -517,6 +517,27 @@ We could make all variable references through a stack frame e.g. ((x y) (cons x y)) ((x) x))) +(define (mk-lam cc) + (define (lam s p c* . x) + (apply cc s p x)) + lam) + +( (<<=> data goal) + (<> (#:mode -) (data) + (#((f . l)) + ( + ( x (let ((cc CC)) + ( + (<=> f ,(mk-lam cc)) + (goal-eval goal)))) + (<=> x l))) + (_ + ( + ( x (goal-eval goal)) + (<=> x data))))) + +(mk-prolog-biop 'xfx "<=" <=-tr op2<= <<=> a a) + (define-syntax-rule (shr x y) (ash x (- y))) (mk-scheme-dual 'yfx "|" tr-| | consx s s) (mk-scheme-dual 'yfx "+" tr-+ op2+ .+ s s) diff --git a/logic/guile-log/prolog/goal.scm b/logic/guile-log/prolog/goal.scm index b33bfcb15dc73d5ef1a67eea9cfe9318e2cc0d41..5d8f69ef47b773690385a4d4fe43d23a660674eb 100644 --- a/logic/guile-log/prolog/goal.scm +++ b/logic/guile-log/prolog/goal.scm @@ -71,11 +71,33 @@ (goal-eval (vector (cons x l))) (type_error "callable" x)))))) +(define bindings (@@ (logic guile-log prolog operators) bindings)) + (define (goal stx z) (define (garg stx x) #``#,(arg stx x)) (match (pp 'goal z) (() - #') + #') + + ;;This does not work on the meta level + (((kind _ "*" _) + (#:term (#:atom f _ _ n m) l . _) + code . _) + + (let* ((l (map (lambda (x) (get.. "," (cadr x))) (get.. "," l)))) + #`( #,(datum->syntax stx f) + #,(map (lambda (x) + (let ((var (car x)) + (val (cadr x))) + (match var + ((#:variable v . _) + #`(#,(datum->syntax stx v) + `#,(arg stx var)))))) + l) + #,(with-fluids ((bindings (cons f (fluid-ref bindings)))) + (goal stx code))))) + + (((kind _ op _) x y n m) (f->stxfkn #f #f op #f #f garg #:goal stx 2 n m (list x y))) @@ -122,11 +144,16 @@ #`(goal-eval CUT #,(garg stx z))) ((#:term (and atom (#:atom f . _)) () #f n m) - (f->stxfkn #f #f f #f atom garg #:goal stx #f n m '())) + (if (member f (fluid-ref bindings)) + #`(#,(datum->syntax stx f)) + (f->stxfkn #f #f f #f atom garg #:goal stx #f n m '()))) - ((#:term (and atom (#:atom f amp _ _ _)) l #f n m) + ((#:term (and atom (#:atom f amp _ _ _)) l #f n m) (let ((l (get.. "," l))) - (f->stxfkn #f #f f #f atom garg #:goal stx #f n m l))) + (if (member f (fluid-ref bindings)) + #`(#,(datum->syntax stx f) #,@(map (lambda (x) #``#,(arg stx x)) + l)) + (f->stxfkn #f #f f #f atom garg #:goal stx #f n m l)))) ((#:termvar v id l . _) #`(goal-eval `#,(arg stx z))) diff --git a/logic/guile-log/prolog/operators.scm b/logic/guile-log/prolog/operators.scm index f8cffef0793768ce36f046d6fd9c5b18d38b38fa..12d5ff7d7e54533fb63067a841ecc22468f8e802 100644 --- a/logic/guile-log/prolog/operators.scm +++ b/logic/guile-log/prolog/operators.scm @@ -151,6 +151,7 @@ (list (datum->syntax stx l))) #,(datum->syntax stx f)))))) +(define bindings (make-fluid '())) (define f->stxfkn (wrap-ns-sym diff --git a/logic/guile-log/src/unify-undo-redo.c b/logic/guile-log/src/unify-undo-redo.c index 177c7f99882c5b279c8d421e9d578fd3016e3628..580ec588b898def958ad18fc19e1e314fa07db4c 100644 --- a/logic/guile-log/src/unify-undo-redo.c +++ b/logic/guile-log/src/unify-undo-redo.c @@ -904,7 +904,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci, lt = gp_gp_cdr(s,s); if(SCM_CONSP(lt)) { - paths = SCM_CADR(lt); + paths = SCM_CDR(lt); path = SCM_CAR(paths); spath = SCM_CDR(paths); } diff --git a/logic/guile-log/src/unify.c b/logic/guile-log/src/unify.c index 37e3b83c5740dcbb0a05f4a5dc40478fc6f79d6e..bd16402a545bd93bf1e456acb554aa7630a03b98 100644 --- a/logic/guile-log/src/unify.c +++ b/logic/guile-log/src/unify.c @@ -2820,7 +2820,7 @@ SCM_DEFINE(gp_clear, "gp-clear", 1, 0, 0, (SCM s), scm_cons(scm_cons(GP_GET_SELF(gp->gp_fr), GP_GET_VAL (gp->gp_fr)), - scm_cons(SCM_EOL, gp_engine_path))); + scm_cons(SCM_EOL, gp_paths))); return SCM_BOOL_T; }