vm-handle

parent c6f1d51a
...@@ -337,7 +337,13 @@ generate_stx(STX,X,F) :- ...@@ -337,7 +337,13 @@ generate_stx(STX,X,F) :-
(lambda (s p cc cut scut x) (lambda (s p cc cut scut x)
(apply f s p cc cut scut x)))) (apply f s p cc cut scut x))))
(define-syntax-rule (with a code) code) (define-syntax-rule (with a code)
code
#;
(let ((n (vector-ref (times) 0)))
(let ((res code))
(pk `(,a ,(/ (- (vector-ref (times) 0) n) 1e9)))
res)))
(define (comma x y) (vector (list #{,}# x y))) (define (comma x y) (vector (list #{,}# x y)))
(define (mockalambda source? s pat code) (define (mockalambda source? s pat code)
...@@ -360,7 +366,7 @@ generate_stx(STX,X,F) :- ...@@ -360,7 +366,7 @@ generate_stx(STX,X,F) :-
(car o) (car o)
#,(let ((comp #,(let ((comp
(with-fluids ((*current-stack* s)) (with-fluids ((*current-stack* s))
(with ____ (with '____
(prolog-run-rewind (prolog-run-rewind
1 (meta) 1 (meta)
(compile_to_meta source? all meta)))))) (compile_to_meta source? all meta))))))
......
...@@ -17,7 +17,6 @@ By setting a procedure as 'with-cut we can pass under the radar ...@@ -17,7 +17,6 @@ By setting a procedure as 'with-cut we can pass under the radar
(<define> (gen_f x) (<=> x ,(gensym "F"))) (<define> (gen_f x) (<=> x ,(gensym "F")))
(compile-prolog-string " (compile-prolog-string "
/*
narg(X,N,N) :- var_p(X),!. narg(X,N,N) :- var_p(X),!.
narg([X|L],I,N) :- narg([X|L],I,N) :-
II is I + 1, II is I + 1,
...@@ -148,7 +147,6 @@ caller(cc,Args,Tail,V,[L,LL]) :- !, ...@@ -148,7 +147,6 @@ caller(cc,Args,Tail,V,[L,LL]) :- !,
tr('tail-cc', Call), tr('tail-cc', Call),
LL2 = [[Call]|LW]. LL2 = [[Call]|LW].
*/
caller(F,Args,Tail,V,[L,LL]) :- caller(F,Args,Tail,V,[L,LL]) :-
touch_Q(3,V), touch_Q(3,V),
(get_recur(F,A,N) -> rec(F,A,N,Args,Tail,V,[L,LL]) ; (get_recur(F,A,N) -> rec(F,A,N,Args,Tail,V,[L,LL]) ;
...@@ -182,7 +180,7 @@ caller(F,Args,Tail,V,[L,LL]) :- ...@@ -182,7 +180,7 @@ caller(F,Args,Tail,V,[L,LL]) :-
get_post(S,C,#f,Tail,LLL,LW) get_post(S,C,#f,Tail,LLL,LW)
) )
))). ))).
/*
rec(F,A,N,Args,Tail,V,[L,LL]) :- rec(F,A,N,Args,Tail,V,[L,LL]) :-
(narg(Args,0,N) -> true ; throw(recur_call_wrong_number_of_arguments(F))), (narg(Args,0,N) -> true ; throw(recur_call_wrong_number_of_arguments(F))),
tr('clear-sp' , Clear), tr('clear-sp' , Clear),
...@@ -197,7 +195,6 @@ rec(F,A,N,Args,Tail,V,[L,LL]) :- ...@@ -197,7 +195,6 @@ rec(F,A,N,Args,Tail,V,[L,LL]) :-
tr('goto-inst',Goto), tr('goto-inst',Goto),
LL2 = [[Goto,A]|LL] LL2 = [[Goto,A]|LL]
). ).
*/
") ")
(compile-prolog-string " (compile-prolog-string "
%newvars needs to be variables %newvars needs to be variables
newv([]). newv([]).
newv([[newvar,[[V,S],N,F]]|L]) :- !, newv([[newvar,[[V,S],N,F]]|L]) :- !,
...@@ -225,7 +226,7 @@ handle(['push-2variables',[[S1,V1,Q1],N1,F1|_], ...@@ -225,7 +226,7 @@ handle(['push-2variables',[[S1,V1,Q1],N1,F1|_],
handle(['push-3variables',[[S1,V1,Q1],N1,F1|_], handle(['push-3variables',[[S1,V1,Q1],N1,F1|_],
[[S2,V2,Q2],N2,F2|_], [[S2,V2,Q2],N2,F2|_],
[[S3,V3,Q3],N3,F3|_]],I,II,L,LL) :- !,pr(1), [[S3,V3,Q3],N3,F3|_]],I,II,L,LL) :- !,
new_var(V1,Q1,S1), new_var(V1,Q1,S1),
new_var(V2,Q2,S2), new_var(V2,Q2,S2),
new_var(V3,Q3,S3), new_var(V3,Q3,S3),
...@@ -235,7 +236,7 @@ handle(['push-3variables',[[S1,V1,Q1],N1,F1|_], ...@@ -235,7 +236,7 @@ handle(['push-3variables',[[S1,V1,Q1],N1,F1|_],
handle(['push-variable-scm',[[S,V,Q],N,F|_]],I,II,L,LL) :- !,pr(2), handle(['push-variable-scm',[[S,V,Q],N,F|_]],I,II,L,LL) :- !,
( (
F==#t -> F==#t ->
throw(first_variable_in_scheme_context); throw(first_variable_in_scheme_context);
...@@ -243,7 +244,7 @@ handle(['push-variable-scm',[[S,V,Q],N,F|_]],I,II,L,LL) :- !,pr(2), ...@@ -243,7 +244,7 @@ handle(['push-variable-scm',[[S,V,Q],N,F|_]],I,II,L,LL) :- !,pr(2),
). ).
handle([comp,CMP,[[S1,V1,Q1],N1,F1|_], handle([comp,CMP,[[S1,V1,Q1],N1,F1|_],
[[S2,V2,Q2],N2,F2|_]],I,II,L,LL) :- !,pr(3), [[S2,V2,Q2],N2,F2|_]],I,II,L,LL) :- !,
chech_push(F1), chech_push(F1),
chech_push(F2), chech_push(F2),
new_var(V1,Q1,S1), new_var(V1,Q1,S1),
...@@ -254,7 +255,7 @@ handle([comp,CMP,[[S1,V1,Q1],N1,F1|_], ...@@ -254,7 +255,7 @@ handle([comp,CMP,[[S1,V1,Q1],N1,F1|_],
handle([bin,Op,[[S1,V1,Q1],N1,F1|_], handle([bin,Op,[[S1,V1,Q1],N1,F1|_],
[[S2,V2,Q2],N2,F2|_], [[S2,V2,Q2],N2,F2|_],
[[S3,V3,Q3],N3,F3|_]],I,II,L,LL) :- !,pr(4), [[S3,V3,Q3],N3,F3|_]],I,II,L,LL) :- !,
chech_push(F1), chech_push(F1),
chech_push(F2), chech_push(F2),
new_var(V1,Q1,S1), new_var(V1,Q1,S1),
...@@ -295,7 +296,7 @@ handle([bin,Op,[[S1,V1,Q1],N1,F1|_], ...@@ -295,7 +296,7 @@ handle([bin,Op,[[S1,V1,Q1],N1,F1|_],
handle([(Kind,(ibin;bini)),Op,X, handle([(Kind,(ibin;bini)),Op,X,
[[S2,V2,Q2],N2,F2|_], [[S2,V2,Q2],N2,F2|_],
[[S3,V3,Q3],N3,F3|_]],I,II,L,LL) :- !,pr(5), [[S3,V3,Q3],N3,F3|_]],I,II,L,LL) :- !,
chech_push(F2), chech_push(F2),
new_var(V2,Q2,S2), new_var(V2,Q2,S2),
( (
...@@ -333,14 +334,14 @@ handle([(Kind,(ibin;bini)),Op,X, ...@@ -333,14 +334,14 @@ handle([(Kind,(ibin;bini)),Op,X,
). ).
handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !,pr(6), handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !,
( (
(pr(a),F==#t,N==1) -> (F==#t,N==1) ->
( (
(M==#t ; M==0) -> (L=[[pop,1]|LL],II is I + 2) ; (M==#t ; M==0) -> (L=[[pop,1]|LL],II is I + 2) ;
(L=[[false]|LL] , II is I + 1) (L=[[false]|LL] , II is I + 1)
); );
(pr(b),F==#t,S==#t) -> (F==#t,S==#t) ->
( (
M=#f -> (L=[[false]|LL], II is I + 1) ; M=#f -> (L=[[false]|LL], II is I + 1) ;
( (
...@@ -350,21 +351,17 @@ handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !,pr(6), ...@@ -350,21 +351,17 @@ handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !,pr(6),
II is I + 2 II is I + 2
) )
); );
(pr(c),F==#t) -> (F==#t) ->
( (
M=#f -> (pr(10),L=[[false]|LL], II is I + 1) ; M=#f -> (L=[[false]|LL], II is I + 1) ;
( (
pr(11),
new_var(V,Q,S), new_var(V,Q,S),
pr(12),
code([unify,M,V,#f],K,Unify), code([unify,M,V,#f],K,Unify),
pr(13),
L=[[Unify,K]|LL], L=[[Unify,K]|LL],
II is I + 2, II is I + 2
pr(20)
) )
); );
(pr(d),N==1) -> (N==1) ->
( (
code([unify,M,V,1],K,Unify), code([unify,M,V,1],K,Unify),
L=[[Unify,K]|LL], L=[[Unify,K]|LL],
...@@ -377,8 +374,7 @@ handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !,pr(6), ...@@ -377,8 +374,7 @@ handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !,pr(6),
) )
). ).
handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,
handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
((U='unify-constant-2' ; U='unify-instruction-2') -> ((U='unify-constant-2' ; U='unify-instruction-2') ->
( (
regconst(A,XX), regconst(A,XX),
...@@ -411,10 +407,14 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7), ...@@ -411,10 +407,14 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
( (
A=[[S2,V2,Q2],N2,F2|_], A=[[S2,V2,Q2],N2,F2|_],
( (
((F==#t,N==1) ; (F2==#t,N2==1)) -> (LL=L, S1=S) ; ((F==#t,N==1) ; (F2==#t,N2==1)) ->
(
LL=L,
II=I
) ;
(F==#t,S==#t,F2==#t,S2==#t) -> (F==#t,S==#t,F2==#t,S2==#t) ->
( (
M=#f -> (L=[[false]|LL]) ; M=#f -> (L=[[false]|LL],II is I + 1) ;
( (
new_var(V,Q,S),new_var(V2,Q2,S2), new_var(V,Q,S),new_var(V2,Q2,S2),
code([U,M,V,#t,V2,#t],K), code([U,M,V,#t,V2,#t],K),
...@@ -424,7 +424,7 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7), ...@@ -424,7 +424,7 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
); );
(F==#t,S==#t,F2==#t) -> (F==#t,S==#t,F2==#t) ->
( (
M=#f -> (L=[[false]|LL]) ; M=#f -> (L=[[false]|LL], II is I + 1) ;
( (
new_var(V,Q,S), new_var(V2,Q2,S2), new_var(V,Q,S), new_var(V2,Q2,S2),
code([U,M,V,#t,V2,#f],K), code([U,M,V,#t,V2,#f],K),
...@@ -434,9 +434,10 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7), ...@@ -434,9 +434,10 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
); );
(F==#t,F2==#t,S2==#t) -> (F==#t,F2==#t,S2==#t) ->
( (
M=#f -> (L=[[false]|LL]) ; M=#f -> (L=[[false]|LL], II is I + 1) ;
( (
new_var(V,Q,S), new_var(V2,Q2,S2), new_var(V,Q,S),
new_var(V2,Q2,S2),
code([U,M,V,#f,V2,#t],K), code([U,M,V,#f,V2,#t],K),
L=[[U,K]|LL], L=[[U,K]|LL],
II is I + 2 II is I + 2
...@@ -444,9 +445,10 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7), ...@@ -444,9 +445,10 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
); );
(F==#t,F2==#t) -> (F==#t,F2==#t) ->
( (
M=#f -> (L=[[false]|LL]) ; M=#f -> (L=[[false]|LL], II is I + 1) ;
( (
new_var(V,Q,S), new_var(V2,Q2,S2), new_var(V,Q,S),
new_var(V2,Q2,S2),
code([U,M,V,#f,V2,#t],K), code([U,M,V,#f,V2,#t],K),
L=[[U,K]|LL], L=[[U,K]|LL],
II is I + 2 II is I + 2
...@@ -454,9 +456,10 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7), ...@@ -454,9 +456,10 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
); );
F==#t -> F==#t ->
( (
M=#f -> (L=[[false]|LL]) ; M=#f -> (L=[[false]|LL], II is I + 1) ;
( (
new_var(V,Q,S), new_var(V,Q,S),
new_var(V2,Q2,S2),
(N2 == 1 -> K=1 ; K=0), (N2 == 1 -> K=1 ; K=0),
code([U,M,V,#f,V2,K],Code), code([U,M,V,#f,V2,K],Code),
L=[[U,Code]|LL], L=[[U,Code]|LL],
...@@ -465,7 +468,7 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7), ...@@ -465,7 +468,7 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
); );
F2==#t -> F2==#t ->
( (
M=#f -> (L=[[false]|LL]) ; M=#f -> (L=[[false]|LL], II is I + 1) ;
( (
new_var(V2,Q2,S2), new_var(V2,Q2,S2),
(N == 1 -> K=1 ; K=0), (N == 1 -> K=1 ; K=0),
...@@ -485,7 +488,7 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7), ...@@ -485,7 +488,7 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
)). )).
handle(X,I,II,L,LL) :- !,pr(8), handle(X,I,II,L,LL) :- !,
( (
X=[A] -> (U=[], II is I + 1) ; X=[A] -> (U=[], II is I + 1) ;
X=[A,N] -> X=[A,N] ->
......
...@@ -27,6 +27,7 @@ the_tr2(X,[X]). ...@@ -27,6 +27,7 @@ the_tr2(X,[X]).
:- add_term_expansion_temp(extended_macro). :- add_term_expansion_temp(extended_macro).
") ")
(eval-when (compile) (eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #f)) (set! (@@ (logic guile-log prolog compile) include-meta) #f))
......
...@@ -246,11 +246,11 @@ ...@@ -246,11 +246,11 @@
(<define> (set_F v f) (<define> (set_F v f)
(let ((v (<lookup> v))) (let ((v (<lookup> v)))
(<set> (vector-ref v nf) (<lookup> f)))) (<set0> (vector-ref v nf) (<lookup> f))))
(<define> (set_FS v f s) (<define> (set_FS v f s)
(let ((v (<lookup> v))) (let ((v (<lookup> v)))
(<set> (vector-ref v nf) (<lookup> f)) (<set0> (vector-ref v nf) (<lookup> f))
(<set> (vector-ref v ns) (<lookup> s)))) (<set> (vector-ref v ns) (<lookup> s))))
(<define> (set_S v s) (<define> (set_S v s)
...@@ -358,9 +358,8 @@ add_var(X,S,V,Tag) :- ...@@ -358,9 +358,8 @@ add_var(X,S,V,Tag) :-
get_FEBH(V,F,E,B,H), get_FEBH(V,F,E,B,H),
get_e_tag(X,H,F,Ex,Tag,Etags), get_e_tag(X,H,F,Ex,Tag,Etags),
EE is E \\/ Ex, EE is E \\/ Ex,
BB is B \\/ Ex, BB is B \\/ Ex,
set_EB(V,EE,BB), set_EB(V,EE,BB),
reference(H,Tag), reference(H,Tag),
(0 =:= Ex /\\ S -> true ; force_variable(Tag)), (0 =:= Ex /\\ S -> true ; force_variable(Tag)),
(0 =:= Ex /\\ B -> first(Tag) ; true), (0 =:= Ex /\\ B -> first(Tag) ; true),
......
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