vm-handle

parent c6f1d51a
......@@ -337,7 +337,13 @@ 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-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 (mockalambda source? s pat code)
......@@ -360,7 +366,7 @@ generate_stx(STX,X,F) :-
(car o)
#,(let ((comp
(with-fluids ((*current-stack* s))
(with ____
(with '____
(prolog-run-rewind
1 (meta)
(compile_to_meta source? all meta))))))
......
......@@ -17,7 +17,6 @@ By setting a procedure as 'with-cut we can pass under the radar
(<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,
......@@ -148,7 +147,6 @@ caller(cc,Args,Tail,V,[L,LL]) :- !,
tr('tail-cc', Call),
LL2 = [[Call]|LW].
*/
caller(F,Args,Tail,V,[L,LL]) :-
touch_Q(3,V),
(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]) :-
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),
......@@ -197,7 +195,6 @@ rec(F,A,N,Args,Tail,V,[L,LL]) :-
tr('goto-inst',Goto),
LL2 = [[Goto,A]|LL]
).
*/
")
(compile-prolog-string "
%newvars needs to be variables
newv([]).
newv([[newvar,[[V,S],N,F]]|L]) :- !,
......@@ -225,7 +226,7 @@ handle(['push-2variables',[[S1,V1,Q1],N1,F1|_],
handle(['push-3variables',[[S1,V1,Q1],N1,F1|_],
[[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(V2,Q2,S2),
new_var(V3,Q3,S3),
......@@ -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 ->
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),
).
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(F2),
new_var(V1,Q1,S1),
......@@ -254,7 +255,7 @@ handle([comp,CMP,[[S1,V1,Q1],N1,F1|_],
handle([bin,Op,[[S1,V1,Q1],N1,F1|_],
[[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(F2),
new_var(V1,Q1,S1),
......@@ -295,7 +296,7 @@ handle([bin,Op,[[S1,V1,Q1],N1,F1|_],
handle([(Kind,(ibin;bini)),Op,X,
[[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),
new_var(V2,Q2,S2),
(
......@@ -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) ;
(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) ;
(
......@@ -350,21 +351,17 @@ handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !,pr(6),
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),
pr(12),
code([unify,M,V,#f],K,Unify),
pr(13),
L=[[Unify,K]|LL],
II is I + 2,
pr(20)
II is I + 2
)
);
(pr(d),N==1) ->
(N==1) ->
(
code([unify,M,V,1],K,Unify),
L=[[Unify,K]|LL],
......@@ -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) :- !,pr(7),
handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,
((U='unify-constant-2' ; U='unify-instruction-2') ->
(
regconst(A,XX),
......@@ -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|_],
(
((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) ->
(
M=#f -> (L=[[false]|LL]) ;
M=#f -> (L=[[false]|LL],II is I + 1) ;
(
new_var(V,Q,S),new_var(V2,Q2,S2),
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),
);
(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),
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),
);
(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),
L=[[U,K]|LL],
II is I + 2
......@@ -444,9 +445,10 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
);
(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),
L=[[U,K]|LL],
II is I + 2
......@@ -454,9 +456,10 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
);
F==#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),
(N2 == 1 -> K=1 ; K=0),
code([U,M,V,#f,V2,K],Code),
L=[[U,Code]|LL],
......@@ -465,7 +468,7 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,pr(7),
);
F2==#t ->
(
M=#f -> (L=[[false]|LL]) ;
M=#f -> (L=[[false]|LL], II is I + 1) ;
(
new_var(V2,Q2,S2),
(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),
)).
handle(X,I,II,L,LL) :- !,pr(8),
handle(X,I,II,L,LL) :- !,
(
X=[A] -> (U=[], II is I + 1) ;
X=[A,N] ->
......
......@@ -27,6 +27,7 @@ the_tr2(X,[X]).
:- add_term_expansion_temp(extended_macro).
")
(eval-when (compile)
(set! (@@ (logic guile-log prolog compile) include-meta) #f))
......
......@@ -246,11 +246,11 @@
(<define> (set_F v f)
(let ((v (<lookup> v)))
(<set> (vector-ref v nf) (<lookup> f))))
(<set0> (vector-ref v nf) (<lookup> f))))
(<define> (set_FS v f s)
(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))))
(<define> (set_S v s)
......@@ -358,9 +358,8 @@ add_var(X,S,V,Tag) :-
get_FEBH(V,F,E,B,H),
get_e_tag(X,H,F,Ex,Tag,Etags),
EE is E \\/ Ex,
BB is B \\/ Ex,
BB is B \\/ Ex,
set_EB(V,EE,BB),
reference(H,Tag),
(0 =:= Ex /\\ S -> true ; force_variable(Tag)),
(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