vm-handle-model vm-conj-model

parent 33953145
......@@ -132,7 +132,9 @@ PSSOURCES = \
logic/guile-log/guile-prolog/vm-compiler.scm \
logic/guile-log/guile-prolog/vm/vm-scm2.scm \
logic/guile-log/guile-prolog/vm/vm-args2.scm \
logic/guile-log/guile-prolog/vm/vm-handle2.scm \
logic/guile-log/guile-prolog/vm/vm-disj2.scm \
logic/guile-log/guile-prolog/vm/vm-conj2.scm \
logic/guile-log/guile-prolog/vm/vm-imprint2.scm \
logic/guile-log/guile-prolog/vm/vm-unify2.scm \
logic/guile-log/examples/kanren/type-inference.scm \
......
#|
In guile prolog we take an interesting short-cut in
a,b,c,fail
We could deside it is all a fail, but a may print out info and there is a
side effect. But still it would be a dramatic simplification to kill the whole
expression. We actually do that the case
a,b,c,1=2.
would simplify totally the idea is that typically this situation is what
you get after compiling a macro and there the default should be simplify
as much as possible. We don't loose anything because you can always insert
a direct fail. But the gain can be dramatic and it's nice to have the compiler
do the heavy lifting.
|#
(compile-prolog-string
"
collect_conj(X,[X|LL],LL) :- var(X),!.
collect_conj((X,Y),L,LL) :- !,
collect_conj(X,L ,L1),
collect_conj(Y,L1,LL).
collect_conj(X,[X|LL],LL).
-extended.
compile_conj0([],Tail,V,L) :- throw(#t).
compile_conj0([X],Tail,V,L) :- !,
compile_goal(X,Tail,V,L).
compile_conj0([X|Gs],Tail,V,L) :- var(X),!,
compile_conj0([call(X)|Gs],Tail,V,L).
compile_conj0([!|Gs],Tail,V,[L,LL]) :- !,
ifc(compile_conj0(Gs,Tail,V,[L1,LL]),E,
(
tfc(E),
(
E==#t ->
(Tail==#t -> L=[[cut],[cc]|LL] ; L=[[cut]|LL]);
throw(c)
)
),
(
L=[[cut]|L1]
)).
compile_conj0([softie(A)|Gs],Tail,V,[L,LL]) :- !,
pop_Q(3,V,Q),
ifc(compile_conj0(Gs,Tail,V,[L1,LL]),E,
(
tfc(E),
(
E==#t ->
(
push_Q(3,V,Q),
(
Tail==#t ->
L=[[softie,A],[cc]|LL] ;
L=[[softie,A]|LL]
)
);
E==c ->
throw(c);
throw(softie(A))
)
),
(
L=[[softie,A]|L1],
push_Q(3.2,V,Q)
)).
compile_conj0([(fail;false)|Gs],Tail,V,[L,LL]) :- !,
L=[[fail]|LL].
compile_conj0([G|Gs],Tail,V,L) :- !,
link_l(L,L1,L2),
ifc(compile_goal(G,#f,V,L1),E,
(
tfc(E),
(
E==#t ->
compile_conj0(Gs,Tail,V,L) ;
throw(E)
)
),
(
catch(compile_conj0(Gs,Tail,V,L2),E2,
(
tfc(E2),
(
E2==#t ->
(Tail==#t -> L2=[[[cc]|U],U] ; L2=[U,U]);
E2==c ->
L2=[[[cut],[fail]|U],U] ;
E2=softie(A) ->
L2=[[[softie,A],[fail]|U],U] ;
throw(E2)
)
))
)).
compile_conj(Gs,Tail,V,L) :-
compile_conj0(Gs,Tail,V,L).
")
......@@ -10,107 +10,4 @@
#:use-module (logic guile-log guile-prolog vm vm-var)
#:export (compile_conj collect_conj))
#|
In guile prolog we take an interesting short-cut in
a,b,c,fail
We could deside it is all a fail, but a may print out info and there is a
side effect. But still it would be a dramatic simplification to kill the whole
expression. We actually do that the case
a,b,c,1=2.
would simplify totally the idea is that typically this situation is what
you get after compiling a macro and there the default should be simplify
as much as possible. We don't loose anything because you can always insert
a direct fail. But the gain can be dramatic and it's nice to have the compiler
do the heavy lifting.
|#
(compile-prolog-string
"
collect_conj(X,[X|LL],LL) :- var(X),!.
collect_conj((X,Y),L,LL) :- !,
collect_conj(X,L ,L1),
collect_conj(Y,L1,LL).
collect_conj(X,[X|LL],LL).
-extended.
compile_conj0([],Tail,V,L) :- throw(#t).
compile_conj0([X],Tail,V,L) :- !,
compile_goal(X,Tail,V,L).
compile_conj0([X|Gs],Tail,V,L) :- var(X),!,
compile_conj0([call(X)|Gs],Tail,V,L).
compile_conj0([!|Gs],Tail,V,[L,LL]) :- !,
ifc(compile_conj0(Gs,Tail,V,[L1,LL]),E,
(
tfc(E),
(
E==#t ->
(Tail==#t -> L=[[cut],[cc]|LL] ; L=[[cut]|LL]);
throw(c)
)
),
(
L=[[cut]|L1]
)).
compile_conj0([softie(A)|Gs],Tail,V,[L,LL]) :- !,
pop_Q(3,V,Q),
ifc(compile_conj0(Gs,Tail,V,[L1,LL]),E,
(
tfc(E),
(
E==#t ->
(
push_Q(3,V,Q),
(
Tail==#t ->
L=[[softie,A],[cc]|LL] ;
L=[[softie,A]|LL]
)
);
E==c ->
throw(c);
throw(softie(A))
)
),
(
L=[[softie,A]|L1],
push_Q(3.2,V,Q)
)).
compile_conj0([(fail;false)|Gs],Tail,V,[L,LL]) :- !,
L=[[fail]|LL].
compile_conj0([G|Gs],Tail,V,L) :- !,
link_l(L,L1,L2),
ifc(compile_goal(G,#f,V,L1),E,
(
tfc(E),
(
E==#t ->
compile_conj0(Gs,Tail,V,L) ;
throw(E)
)
),
(
catch(compile_conj0(Gs,Tail,V,L2),E2,
(
tfc(E2),
(
E2==#t ->
(Tail==#t -> L2=[[[cc]|U],U] ; L2=[U,U]);
E2==c ->
L2=[[[cut],[fail]|U],U] ;
E2=softie(A) ->
L2=[[[softie,A],[fail]|U],U] ;
throw(E2)
)
))
)).
compile_conj(Gs,Tail,V,L) :-
compile_conj0(Gs,Tail,V,L).
")
(include-from-path "logic/guile-log/guile-prolog/vm/vm-conj-model.scm")
(define-module (logic guile-log guile-prolog vm vm-conj2)
#:use-module (logic guile-log)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi)
#:use-module (compat racket misc)
#:use-module (system vm assembler)
#:use-module (logic guile-log guile-prolog macros)
#:use-module (logic guile-log guile-prolog vm-compiler)
#:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var)
#:export (compile_conj collect_conj))
#;
(eval-when (compile)
(prolog-run-rewind 1 (x)
(dyntrace (@@ (logic guile-log guile-prolog vm vm-goal)
compile_goal))))
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #f))
(compile-prolog-string
"
- eval_when(compile).
the_tr2(X,[X]).
:- add_term_expansion_temp(the_tr2).
:- add_term_expansion_temp(extended_macro).
")
(include-from-path "logic/guile-log/guile-prolog/vm/vm-conj-model.scm")
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #t))
......@@ -70,7 +70,7 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
get_M(V,StackSize),
handle_all(L,LL),
(var(Constants)->Constants=scm[(get-consts)];true),
print(LL),nl,!,
%print(LL),nl,!,
(Pretty==#t -> Iout=LL ; (b_setval(pretty,#f),mmtr(LL,Iout))).
compile_goal(X,Tail,V,L) :- var_p(X),!,
......
This diff is collapsed.
(define-module (logic guile-log guile-prolog vm vm-handle2)
#:use-module (logic guile-log)
#:use-module (logic guile-log iso-prolog)
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog ops)
#:use-module (logic guile-log prolog swi)
#:use-module (compat racket misc)
#:use-module (logic guile-log guile-prolog vm-compiler)
#:use-module (logic guile-log guile-prolog macros)
#:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var)
#:use-module (system vm assembler)
#:export (handle_all))
#;
(eval-when (compile)
(pk (prolog-run-rewind 1 (x)
(dyntrace (@@ (logic guile-log guile-prolog vm vm-handle)
handle)))))
(compile-prolog-string
"
- eval_when(compile).
the_tr2(X,[X]).
:- add_term_expansion_temp(the_tr2).
:- add_term_expansion_temp(extended_macro).
")
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #f))
(include-from-path "logic/guile-log/guile-prolog/vm/vm-handle-model.scm")
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #t))
......@@ -30,3 +30,6 @@ the_tr2(X,[X]).
(set! (@@ (logic guile-log prolog compile) include-meta) #f))
(include-from-path "logic/guile-log/guile-prolog/vm/vm-scm-model.scm")
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #t))
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