model of vm-args

parent 4edb3194
......@@ -129,7 +129,9 @@ PSSOURCES = \
logic/guile-log/guile-prolog/vm/vm-unify.scm \
logic/guile-log/guile-prolog/vm/vm-goal.scm \
logic/guile-log/guile-prolog/vm-compiler.scm \
logic/guile-log/guile-prolog/vm/vm-args2.scm \
logic/guile-log/guile-prolog/vm/vm-disj2.scm \
logic/guile-log/guile-prolog/vm/vm-imprint2.scm \
logic/guile-log/examples/kanren/type-inference.scm \
logic/guile-log/imatch.scm \
prolog-user.scm \
......
......@@ -22,4 +22,4 @@ EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
SUFFIXES = .scm .go
.scm.go:
$(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile -O0 $(GUILE_WARNINGS) -o "$@" "$<"
$(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
......@@ -13,7 +13,7 @@
#:use-module (logic guile-log prolog compile)
#:use-module ((logic guile-log umatch) #:select (gp-var! *current-stack*))
#:use-module (system vm assembler)
#:re-export (compile_goal begin_att end_att cc)
#:re-export (compile_goal begin_att end_att cc pr)
#:export (compilable_scm
collect_data define-prolog-fkn
make-vm-function
......@@ -325,12 +325,14 @@ generate_stx(STX,X,F) :-
(lambda (s p cc cut scut x)
(apply f s p cc cut scut x))))
(define-syntax-rule (with a code) code)
(define (mockalambda source? s pat code)
(let* ((Cut (gp-var! s))
(SCut (gp-var! s))
(rhs (vector (list #{,}# (vector (list with_cut Cut SCut)) code)))
(lhs (vector (cons* mockalambda Cut SCut pat)))
(oth (compile-prolog s pat code source? (list #t #t)))
(oth (with 'cccc (compile-prolog s pat code source? (list #t #t))))
(all (vector (list :- lhs rhs))))
;(<pp> (s (lambda () #f) (lambda () #f) (lambda x x)) all)
(if source?
......@@ -339,9 +341,10 @@ generate_stx(STX,X,F) :-
(car o)
#,(let ((comp
(with-fluids ((*current-stack* s))
(prolog-run-rewind
1 (meta)
(compile_to_meta source? all meta)))))
(with ____
(prolog-run-rewind
1 (meta)
(compile_to_meta source? all meta))))))
((@ (guile) catch) #t
(lambda ()
(if (pair? comp)
......
(compile-prolog-string "'with-cut'. 'without-cut'.")
#|
By setting a procedure as 'with-cut we can pass under the radar
|#
(<define> (argkind f k)
(let ((f (<lookup> f)))
(if (procedure? f)
(case (procedure-property (<lookup> f) 'argkind)
((with-cut)
(<=> k with_cut))
((without-cut)
(<=> k without_cut))
(else
(<=> k #f)))
(<=> k #f))))
(<define> (gen_f x) (<=> x ,(gensym "F")))
(compile-prolog-string "
/*
narg(X,N,N) :- var_p(X),!.
narg([X|L],I,N) :-
II is I + 1,
narg(L,II,N).
narg(_,I,I).
push_code_with_cut(X,Label,V,L,LL) :-
L=[[label,Label],[clean-sp]|LX],
compile_goal(X,#t,V,[LX,LL]).
push_code_without_cut(X,Label,V,L,LL) :-
L=[[label,Label],[clean-sp]|LX],
compile_goal(call(X),#t,V,[LX,LL]).
push_args_args(K,X,V,L,LL,_,_) :- var_p(X),!,K==#f,
push_args(X,V,L,LL).
push_args_args(#f,[X|Y],V,L,LL,U,U) :- !,
push_args(X,V,L,L1),
push_args_args(#f,Y,V,L1,LL,U,U).
push_args_args(with_cut,[X|Y],V,L,LL,LW,LLW) :- !,
L=[['push-closure',Label]|L1],
push_code_with_cut(X,Label,V,LW,LLW),
push_args_args(with_cut,Y,V,L1,LL).
push_args_args(without_cut,[X|Y],V,L,LL,LW,LLW) :- !,
L=[['push-closure',Label]|L1],
push_code_without_cut(X,Label,V,L,L1),
push_args_args(without_cut,Y,V,L1,LL).
push_args_args(_,[],V,L,L,LW,LW) :- !.
push_args_args2(X,V,L,LL) :- var_p(X),!,
push_args(X,V,L,LL).
push_args_args2([X|Y],V,L,LL) :- !,
push_args(X,V,L,L1),
push_args_args2(Y,V,L1,LL).
push_args_args2([],V,L,LL) :-
push_args([],V,L,LL).
push_args(X,V,L,LL) :- var_p(X),!,
add_var(X,V,Tag),
push_v(1,V),
tr('push-variable',Push),
L=[[Push,Tag]|LL].
push_args([X|Y],V,L,LL) :- !,
tr('mk-cons',Cons),
push_args(X,V,L,L1),
push_args(Y,V,L1,L2),
push_v(-1,V),
L2=[[Cons]|LL].
push_args(X(|Y),V,L,LL) :- !,
tr('mk-fkn',Fkn),
narg(Y,0,NN),N is NN + 1,
push_args_args2([X|Y],V,L,L1),
M is -N, push_v(M,V),
L1=[[Fkn,N]|LL].
push_args({X},V,L,LL) :- !,
tr('mk-curly',MK),
push_args(X,V,L,L1),
L1=[[MK]|LL].
push_args(X,V,L,LL) :-
push_v(1,V),
(
constant(X) ->
(tr('push-constant',Push),regconst(X,XX),L=[[Push,XX]|LL]) ;
(tr('push-instruction',Push),L=[[Push,X]|LL])
).
get_post(S,C,Cplx,Tail,X,XX) :-
Tail==#t -> X=XX ;
(
(S==0,C==0) ->
(
Cplx==#f ->
(
X=[[pop,3]|XX]
) ;
X=XX
);
Cplx==#f ->
(
tr('post-call',Post),
X=[[Post,C,#t]|XX]
);
(
tr('post-call',Post),
X=[[Post,C,#f]|XX]
)
).
caller(cc,Args,label(G,N),V,[L,LL]) :- !,
touch_Q(V),
narg(Args,0,MM),
M is MM + 3,
(M==N -> true ; throw(cc_does_not_match_caller)),
tr('clear-sp' , Clear),
L=[[Clear]|L2],
get_S(V,S),
set_S(V,0),
push_v(2,V),
L2=[[seek,3]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_),
tr('goto-inst', Goto),
LL2 = [[Goto,G]|LL].
caller(cc,Args,Tail,V,[L,LL]) :- !,
touch_Q(V),
(Tail=#f -> throw(cc_not_in_tail_context) ; true),
tr('clear-sp' , Clear),
L=[[Clear]|L2],
get_S(V,S),
set_S(V,0),
push_args(F,V,L2,L3),
push_v(2,V),
L3=[[seek,2]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_),
set_FS(V,F,S),
tr('tail-cc', Call),
LL2 = [[Call]|LW].
*/
caller(F,Args,Tail,V,[L,LL]) :-
touch_Q(V),
(get_recur(F,A,N) -> rec(F,A,N,Args,Tail,V,[L,LL]) ;
(
tr('clear-sp' , Clear),
L=[[Clear]|L2],
get_CS(V,[C|_],S),
set_S(V,0),
push_args(F,V,L2,L3),
push_v(3,V),
L3=[[seek,3]|L4],
argkind(F,K),
push_args_args(K,Args,V,L4,LL2,LW,LL),
touch_A(V),
gen_f(Fsym),
set_FS(V,Fsym,S),
(Tail == #t ->
(
tr('tail-call', Call),
LL2 = [[Call]|LW]
);
Tail = label(G,N) ->
(
tr(goto-inst,Goto),
tr('call-n',Call),
LL2 = [[Call,N],[Goto,G]|LW]
);
(
tr('call', Call),
LL2=[[Call]|LLL],
get_post(S,C,#f,Tail,LLL,LW)
)
))).
/*
rec(F,A,N,Args,Tail,V,[L,LL]) :-
(narg(Args,0,N) -> true ; throw(recur_call_wrong_number_of_arguments(F))),
tr('clear-sp' , Clear),
L=[[Clear]|L2],
get_CS(V,[C|_],S),
set_S(V,0),
push_args_args(#f,Args,V,L2,LL2,_,_),
touch_A(V),
%set_FS(V,F,S),
set_S(V,S),
(
tr('goto-inst',Goto),
LL2 = [[Goto,A]|LL]
).
*/
")
......@@ -8,202 +8,6 @@
#:use-module (logic guile-log guile-prolog vm vm-var)
#:use-module (compat racket misc)
#:use-module (system vm assembler)
#:export (caller push_args_args2 push_args_args push_args
))
(compile-prolog-string "'with-cut'. 'without-cut'.")
#|
By setting a procedure as 'with-cut we can pass under the radar
|#
(<define> (argkind f k)
(let ((f (<lookup> f)))
(if (procedure? f)
(case (procedure-property (<lookup> f) 'argkind)
((with-cut)
(<=> k with_cut))
((without-cut)
(<=> k without_cut))
(else
(<=> k #f)))
(<=> k #f))))
(compile-prolog-string "
narg(X,N,N) :- var_p(X),!.
narg([X|L],I,N) :-
II is I + 1,
narg(L,II,N).
narg(_,I,I).
push_code_with_cut(X,Label,V,L,LL) :-
L=[[label,Label],[clean-sp]|LX],
compile_goal(X,#t,V,[LX,LL]).
push_code_without_cut(X,Label,V,L,LL) :-
L=[[label,Label],[clean-sp]|LX],
compile_goal(call(X),#t,V,[LX,LL]).
push_args_args(K,X,V,L,LL,_,_) :- var_p(X),!,K==#f,
push_args(X,V,L,LL).
push_args_args(#f,[X|Y],V,L,LL,U,U) :- !,
push_args(X,V,L,L1),
push_args_args(#f,Y,V,L1,LL,U,U).
push_args_args(with_cut,[X|Y],V,L,LL,LW,LLW) :- !,
L=[['push-closure',Label]|L1],
push_code_with_cut(X,Label,V,LW,LLW),
push_args_args(with_cut,Y,V,L1,LL).
push_args_args(without_cut,[X|Y],V,L,LL,LW,LLW) :- !,
L=[['push-closure',Label]|L1],
push_code_without_cut(X,Label,V,L,L1),
push_args_args(without_cut,Y,V,L1,LL).
push_args_args(_,[],V,L,L,LW,LW) :- !.
push_args_args2(X,V,L,LL) :- var_p(X),!,
push_args(X,V,L,LL).
push_args_args2([X|Y],V,L,LL) :- !,
push_args(X,V,L,L1),
push_args_args2(Y,V,L1,LL).
push_args_args2([],V,L,LL) :-
push_args([],V,L,LL).
push_args(X,V,L,LL) :- var_p(X),!,
add_var(X,V,Tag),
push_v(1,V),
tr('push-variable',Push),
L=[[Push,Tag]|LL].
push_args([X|Y],V,L,LL) :- !,
tr('mk-cons',Cons),
push_args(X,V,L,L1),
push_args(Y,V,L1,L2),
push_v(-1,V),
L2=[[Cons]|LL].
push_args(X(|Y),V,L,LL) :- !,
tr('mk-fkn',Fkn),
narg(Y,0,NN),N is NN + 1,
push_args_args2([X|Y],V,L,L1),
M is -N, push_v(M,V),
L1=[[Fkn,N]|LL].
push_args({X},V,L,LL) :- !,
tr('mk-curly',MK),
push_args(X,V,L,L1),
L1=[[MK]|LL].
push_args(X,V,L,LL) :-
push_v(1,V),
(
constant(X) ->
(tr('push-constant',Push),regconst(X,XX),L=[[Push,XX]|LL]) ;
(tr('push-instruction',Push),L=[[Push,X]|LL])
).
get_post(S,C,Cplx,Tail,X,XX) :-
Tail==#t -> X=XX ;
(
(S==0,C==0) ->
(
Cplx==#f ->
(
X=[[pop,3]|XX]
) ;
X=XX
);
Cplx==#f ->
(
tr('post-call',Post),
X=[[Post,C,#t]|XX]
);
(
tr('post-call',Post),
X=[[Post,C,#f]|XX]
)
).
caller(cc,Args,label(G,N),V,[L,LL]) :- !,
touch_Q(V),
narg(Args,0,MM),
M is MM + 3,
(M==N -> true ; throw(cc_does_not_match_caller)),
tr('clear-sp' , Clear),
L=[[Clear]|L2],
get_S(V,S),
set_S(V,0),
push_v(2,V),
L2=[[seek,3]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_),
tr('goto-inst', Goto),
LL2 = [[Goto,G]|LL].
caller(cc,Args,Tail,V,[L,LL]) :- !,
touch_Q(V),
(Tail=#f -> throw(cc_not_in_tail_context) ; true),
tr('clear-sp' , Clear),
L=[[Clear]|L2],
get_S(V,S),
set_S(V,0),
push_args(F,V,L2,L3),
push_v(2,V),
L3=[[seek,2]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_),
set_FS(V,F,S),
tr('tail-cc', Call),
LL2 = [[Call]|LW].
caller(F,Args,Tail,V,[L,LL]) :-
touch_Q(V),
get_recur(F,A,N) -> rec(F,A,N,Args,Tail,V,[L,LL]) ;
(
tr('clear-sp' , Clear),
L=[[Clear]|L2],
get_CS(V,[C|_],S),
set_S(V,0),
push_args(F,V,L2,L3),
push_v(3,V),
L3=[[seek,3]|L4],
argkind(F,K),
push_args_args(K,Args,V,L4,LL2,LW,LL),
touch_A(V),
set_FS(V,scm[(gensym \"F\")],S),
(Tail == #t ->
(
tr('tail-call', Call),
LL2 = [[Call]|LW]
);
Tail = label(G,N) ->
(
tr(goto-inst,Goto),
tr('call-n',Call),
LL2 = [[Call,N],[Goto,G]|LW]
);
(
tr('call', Call),
LL2=[[Call]|LLL],
get_post(S,C,#f,Tail,LLL,LW)
)
)).
rec(F,A,N,Args,Tail,V,[L,LL]) :-
(narg(Args,0,N) -> true ; throw(recur_call_wrong_number_of_arguments(F))),
tr('clear-sp' , Clear),
L=[[Clear]|L2],
get_CS(V,[C|_],S),
set_S(V,0),
push_args_args(#f,Args,V,L2,LL2,_,_),
touch_A(V),
%set_FS(V,F,S),
set_S(V,S),
(
tr('goto-inst',Goto),
LL2 = [[Goto,A]|LL]
).
")
#:export (caller push_args_args2 push_args_args push_args))
(include-from-path "logic/guile-log/guile-prolog/vm/vm-args-model.scm")
(define-module (logic guile-log guile-prolog vm vm-args2)
#: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 (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var)
#:use-module (compat racket misc)
#:use-module (system vm assembler)
#:use-module (logic guile-log guile-prolog vm-compiler)
#:export (caller push_args_args2 push_args_args push_args))
(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).
")
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #f))
(include-from-path "logic/guile-log/guile-prolog/vm/vm-args-model.scm")
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #t))
......@@ -32,14 +32,15 @@ collect_disjunction(X,[X|UU],UU).
%head_at_true(First,Last,A,C,Lab,Lab2,L1,LLX)
head_at_true(Q,#t,_,A,C,Lab,Lab2,L1,LLX) :- L1=LLX, Lab2=Lab.
head_at_true(Q,#t,_,A,C,Lab,Lab2,L1,LLX) :- L1=LLX, Lab2=Lab.
head_at_true(Q,#f,#f,A,C,Lab,Lab2,L1,LLX) :-
(var(Q) -> tr('unwind-light',Unwind) ; tr(unwind,Unwind)),
(var(Lab) -> true ; throw(error_head)),
L1=[[label,Lab,U],[Unwind,A,Lab2]|LLX].
head_at_true(Q,#f,#t,A,C,Lab,Lab2,L1,LLX) :-
(var(Q) -> tr('unwind-light-tail',Unwind) ; tr('unwind-tail',Unwind)),
(var(Lab) -> true ; throw(error_head)),
L1=[[label,Lab,U],[Unwind,A]|LLX].
compile_disjunction0
......@@ -72,11 +73,16 @@ compile_disjunction0
(
First==#t ->
throw(#t) ;
head_at_true(Qit,#f,#t,A,C,Lab,Lab2,L,LL)
(
head_at_true(Qit,#f,#t,A,C,Lab,Lab2,L,LL),
U=[0,_]
)
);
Er == c ->
throw(c) ;
throw(#f)
(
Er == c ->
throw(c) ;
throw(#f)
)
)
))).
......@@ -115,6 +121,7 @@ goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,LLX) :-
(
pop_Q(V,_),
head_at_true(Qit,First,#f,A,C,Lab,Lab2,L,LX),
UU=[[0,_]],
Err==c ->
LLX=[[cut],[fail]|LL];
LLX=LL
......@@ -137,7 +144,7 @@ compile_disjunction0([X|Y],First,Aq,Ae,Out, Lab,A,Tail,S0,U,V,[L,LL]) :- !,
throw(c) ;
Er==#t ->
(
U = [E1,_],
U = [[0,_]|UU],
ifc(compile_disjunction0
(Y,#f,Aq,Aq,Out,Lab2,A,Tail,S0,UU,V,[LLX,LL]),Er2,
(
......@@ -147,7 +154,8 @@ compile_disjunction0([X|Y],First,Aq,Ae,Out, Lab,A,Tail,S0,U,V,[L,LL]) :- !,
(
First = #t ->
throw(#t);
(
(
UU=[[0,_]],
head_at_true(Qit,#f,#t,A,C,Lab,Lab2,L,LLG),
LLX=LL
)
......
......@@ -15,7 +15,7 @@
#:use-module (logic guile-log guile-prolog vm vm-conj)
#:use-module (logic guile-log guile-prolog vm vm-handle)
#:use-module (system vm assembler)
#:export (begin_att end_att recur verbatim_call with_cut))
#:export (begin_att end_att recur verbatim_call with_cut pr))
(compile-prolog-string "
reverse_op(<,>).
......@@ -59,17 +59,20 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
b_setval(pretty,#t),
make_state(0,[[0,_,_]],[0],0,0,0,0,[HC,HV],[],V),
wrap(compile_goal(Code,#t,V,[L,[]]),[L,[]]),!,
% write(L),nl,!,
%write(L),nl,!,
get_M(V,StackSize),
handle_all(L,LL),
(var(Constants)->Constants=scm[(get-consts)];true),
% write(LL),nl,!,
%write(LL),nl,!,
(Pretty==#t -> Iout=LL ; (b_setval(pretty,#f),mmtr(LL,Iout))).
compile_goal(X,Tail,V,L) :- var_p(X),!,
compile_goal(call(X),Tail,V,L).
compile_goal(pr(X),Tail,V,[L,L]) :- !,
write(pr(X)),nl.
compile_goal(!,Tail,V,[L,LL]) :- !,
check_tail(Tail),
(Tail==#t -> L=[[cut],[cc]|LL] ; L=[[cut]|LL]).
......@@ -216,7 +219,7 @@ compile_goal(';'(|X),Tail,V,[L,LL]) :- !,
)
),
LM = [LX, [[label,Out] | LL]],
get_EBH(V,Ed,B,H),
get_EBH(V,Ed,B,H),
add_missing_variables(H,U,Ed,Ed,EEd),!,
EE is E \\/ EEd,
set_E(V,EE)
......
......@@ -599,6 +599,18 @@ code([bini,OP,V2,V3,K3],Code,Action) :-
)
).
code([bini,OP,V1,V2,K],Code,Action) :-
(V1=[V1C|_] -> A1=1 ; (V1=V1C, A1=0)),
(V2=[V2C|_] -> A2=1 ; (V2=V2C, A2=0)),
(
K = #f -> KC=2;
K = #t -> K=3 ;
KC = K
),
A is A1 + A2 << 1 + KC << 2,
Code is V1C + V2C << 16 + A << 32,
binxi2(OP,Action).
code([ibin,OP,V2,V3,K3],Code,Action) :-
(
V2=[V2C|_] ->
......
......@@ -10,99 +10,4 @@
#:use-module (logic guile-log guile-prolog vm vm-var)
#:export (compile_imprint))
(compile-prolog-string "
compile_imprint(Y,V,L,LL,M) :-
var_p(Y) ->
(!,
add_var(Y,V,Tag),
push_v(-1,V),
tr(unify,Unify),
(isFirst(Tag) -> true ; touch_A(V)),
L=[[Unify,Tag,M]|LL],!
).
compile_imprint({Y},V, L, LL, M) :- !,
touch_A(V),
(M=#f -> tr('icurly',Curly) ; tr('icurly!',Curly)),
L=[[Curly]|L1],
compile_imprint(Y,V,L1,LL,M).
compile_imprint([Y|LY],V, L,LL,M) :- !,
touch_A(V),
(M=#f -> tr('icons',Icons) ; tr('icons!',Icons)),
L=[[Icons]|L1],
push_v(1,V),
compile_imprint(Y ,V,L1,L2,M),
compile_imprint(LY,V,L2,LL,M).
compile_imprint(Y(|LY),V,L,LL,M) :- !,
Ops = scm[unify_operators],
constant(Y) ->
(
member(['+',Y],Ops) ->
(LY=[X],compile_imprint(X,V,L,LL,#t));
member(['*',Y],Ops) ->
(LY=[X],compile_imprint(X,V,L,LL,0));
member(['-',Y],Ops) ->
(LY=[X],compile_imprint(X,V,L,LL,#f));
member([',',Y],Ops) ->
perform_and(LY,V,L,LL,M);
member([';',Y],Ops) ->
perform_or(LY,V,L,LL,M);
member(['\\+',Y],Ops) ->
perform_not(LY,V,L,LL,M) ;
compile_imprint_fkn(Y(|LY),V, L,LL,M)
) ;
compile_imprint_fkn(Y(|LY),V,L,LL,M).
compile_imprint(Y,V,L,LL,M) :-
push_v(-1,V),
(
constant(Y) ->
tr('unify-constant',Unify);
tr('unify-instruction',Unify)
),
L=[[Unify,Y,M]|LL].
compile_imprint_fkn(Y(|LY),V,L,LL,M) :-
touch_A(V),
(M=#f -> tr(ifkn,Ifkn); tr('ifkn!',Ifkn)),
L=[[Ifkn]|L1],
compile_imprint([Y|LY],V,L1,LL,M).
perform_or([],V,L,LL,M) :- !,
tr(false,False),
L=[[False]|LL].
perform_or([Y],V,L,LL,M) :- !,
compile_imprint(Y,Branch, HC, HV, L, LL).
perform_or([Y|LY1],V,L,LL,M) :-
compile_imprint(Y,[0|Branch],HC,HV,LX,LLX),
perform_or(LY1,[1|Branch],HC,HV,LY,LLY),
label(Labelor),label(Labelcc),
tr(gor,Or),tr(goto,Goto),tr(label,Label),
L = [[Or ,Labelor] | LX],
LLX = [[Goto ,Labelc],[Label,Labelor] | LY],
LLY = [[Label,Labelcc]|LL].
perform_and([],V,L,L,M).
perform_and([Y],V,L,LL,M) :- !,
compile_imprint(Y,V,L,LL,M).
perform_and([Y|LY],V,L,LL,M) :-
tr(dup,Dup),
L=[[Dup],L1],
compile_imprint(Y,V,L1,L2,M),
perform_and(LY,V,L2,LL,M).
perform_not(LY,V,L,LL,M) :-
label(Br),
tr(notend,NotEnd),
tr(not,Not),
perform_and(LY,[[not,Br]|Branch], HC, HV, LX, [[NotEnd,Br]|LL],M),
L=[[Not,Br]|LX].
")
(include-from-path "logic/guile-log/guile-prolog/vm/vm-imprint-model.scm")
......@@ -402,6 +402,9 @@ binxxu2_(**,'xx-upow-x').
binsi2_(+,'is-addi-s').
binis2_(+,'is-addi-s').
binxi2_(+,'is-addi-x').
binix2_(+,'is-addi-x').
")
......
......@@ -53,7 +53,7 @@ compile_scm((Op,(max ; min ; + ; - ; * ; / ; << ; >> ; \\/ ; /\\ ; mod))
LY=[[Op]|LL]
))).
compile_scm((Op,(+ ; -))(X),V,L,LL,E) :- !,
compile_scm((Op,(+ ; -))(X),V,L,LL) :- !,