variable meta data bugfix, did not decide first correctly

parent 3c172ca9
......@@ -44,13 +44,13 @@ head_at_true(Q,#f,#t,A,C,Lab,Lab2,L1,LLX) :-
L1=[[label,Lab,U],[Unwind,A]|LLX].
compile_disjunction0
([X],First,Aq,Ae,Out,Lab,A,Tail,S0,[U],V,[L,LL]) :- !,
([X],First,Aq,Ae,Out,Lab,A,Tail,S0,[U],B2,V,[L,LL]) :- !,
(First=#t -> compile_goal(X,First,V,[L,LL]) ;
catch((
read_Q(0,V,Qit),
pop_Q(0,V,_),
get_CES(V,[C|_],E,S),
set_AES(V,Aq,0,S0),
set_AB2ES(V,Aq,B2,0,S0),
(
((nonvar(X),X=(G1->G2)) -> XX=(once(G1),G2) ; XX=X),
compile_goal(XX,Tail,V,[LX,LL]),
......@@ -86,10 +86,10 @@ compile_disjunction0
)
))).
goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,LLX) :-
goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,B2,LLX) :-
read_Q(1,V,Qit),
get_CES(V,[C|_],E,S),
set_AES(V,Aq,0,S0),
set_AB2ES(V,Aq,B2,0,S0),
((nonvar(X),X=(G1->G2)) ->
XX=(G1,softie(A),collect_F(FF),G2) ;
(XX=(X,newtag_F(FF)))),
......@@ -113,7 +113,8 @@ goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,LLX) :-
throw(all_disjuction_goals_needs_the_same_begin_level))
)
),
ifc(compile_disjunction0(Y,#f,Aq,Ae,Out,Lab2,A,Tail,S0,UU,V,[LLX,LL]),Err,
ifc(compile_disjunction0(Y,#f,Aq,Ae,Out,Lab2,A,Tail,S0,UU,B2,
V,[LLX,LL]),Err,
(
(
Err==#t ->
......@@ -131,11 +132,11 @@ goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,LLX) :-
head_at_true(Qit,First,#f,A,C,Lab,Lab2,L,LX)
).
compile_disjunction0([X|Y],First,Aq,Ae,Out, Lab,A,Tail,S0,U,V,[L,LL]) :- !,
compile_disjunction0([X|Y],First,Aq,Ae,Out, Lab,A,Tail,S0,U,B2,V,[L,LL]) :- !,
tr('goto-inst',Goto),
read_Q(2,V,Qit),
(Tail==#t -> LG=LLX ; LG = [[Goto,Out]|LLX]),
catch(goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,U,V,L,LL,LG,LLX), Er,
catch(goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,U,V,L,LL,LG,B2,LLX), Er,
(
tfc(Er),
(Tail==#t -> LLG = [[cc]|LG] ; LLG=LG),
......@@ -146,7 +147,7 @@ compile_disjunction0([X|Y],First,Aq,Ae,Out, Lab,A,Tail,S0,U,V,[L,LL]) :- !,
(
U = [[0,_]|UU],
ifc(compile_disjunction0
(Y,#f,Aq,Aq,Out,Lab2,A,Tail,S0,UU,V,[LLX,LL]),Er2,
(Y,#f,Aq,Aq,Out,Lab2,A,Tail,S0,UU,B2,V,[LLX,LL]),Er2,
(
tfc(Er2),
(
......@@ -169,12 +170,12 @@ compile_disjunction0([X|Y],First,Aq,Ae,Out, Lab,A,Tail,S0,U,V,[L,LL]) :- !,
throw(syntax_error_begin_en_missmatch))),
head_at_true(Qit,First,#f,A,C,Lab,Lab2,L,LG)
)));
compile_disjunction0(Y,First,Aq,Ae,Out,Lab,A,Tail,S0,U,V,[L,LL])
compile_disjunction0(Y,First,Aq,Ae,Out,Lab,A,Tail,S0,U,B2,V,[L,LL])
)
)).
compile_disjunction(Y,First,Aq,Ae,Out,Lab,A,Tail,S0,U,V,[L,LL]) :-
catch(compile_disjunction0(Y,First,Aq,Ae,Out,Lab,A,Tail,S0,U,V,[L,LL]),Er,
compile_disjunction(Y,First,Aq,Ae,Out,Lab,A,Tail,S0,U,B2,V,[L,LL]) :-
catch(compile_disjunction0(Y,First,Aq,Ae,Out,Lab,A,Tail,S0,U,B2,V,[L,LL]),Er,
(
tfc(Er),
(
......
......@@ -52,7 +52,7 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
init_vars,init_e,
(var(Constants) -> init_const ; true),
b_setval(pretty,#t),
make_state(0,[[0,_,_]],[0],0,0,0,0,[HC,HV],[],V),
make_state(0,[[0,_,_]],[0],0,0,0,0,0,[HC,HV],[],V),
wrap(compile_goal(Code,#t,V,[L,[]]),[L,[]]),!,
%print(L),nl,!,
get_M(V,StackSize),
......@@ -172,7 +172,6 @@ compile_goal(extended_on(|L),Tail,V,[L,L]) :- !,
compile_goal(extended_on,Tail,V,[L,L]) :- !,
set_extended([]).
compile_goal(collect_F(F),Tail,V,[L,L]) :-
get_F(V,F).
......@@ -206,11 +205,11 @@ compile_goal(';'(|X),Tail,V,[L,LL]) :- !,
XX=[] -> L=[[false]|LL] ;
XX=[Z] -> compile_goal(Z,Tail,V,[L,LL]) ;
(
get_AESM(V,Aq,E,S,M),
get_AB2ESM(V,Aq,B2,E,S,M),
get_F(V,F),
label(Lab),label(Out),
push_Q(0,V,Q),
compile_disjunction(XX,#t,Aq,Ae,Out,Lab,LabA,Tail,S,U,V,LM),!,
compile_disjunction(XX,#t,Aq,Ae,Out,Lab,LabA,Tail,S,U,B2,V,LM),!,
(zero(V) -> Tp is 0 ; Tp is 1),
(
var(Q) ->
......@@ -227,8 +226,9 @@ compile_goal(';'(|X),Tail,V,[L,LL]) :- !,
LM = [LX, [[label,Out] | LL]],
get_EBH(V,Ed,B,H),
add_missing_variables(H,U,Ed,Ed,EEd),!,
EE is E \\/ EEd,
set_E(V,EE)
BB2 is B2 \\/ EEd,
EE is E \\/ EEd,
set_B2E(V,BB2,EE)
)
).
......
......@@ -19,4 +19,3 @@
extended_off extended_on))
(include-from-path "logic/guile-log/guile-prolog/vm/vm-goal-model.scm")
......@@ -15,23 +15,6 @@ handle_all(L,Lout) :-
handle_all(L,0,II,Lout,[]).
handle_all([],I,I,L,L).
handle_all([['push-variable',A],
['push-variable',B],
['push-variable',C]|Y], I,II,L,LL) :-
not_first(A),
not_first(B),
not_first(C),
!,
handle(['push-3variables',A,B,C],I,I1,L,L1),
handle_all(Y,I1,II,L1,LL).
handle_all([['push-variable',A],
['push-variable',B]|Y], I,II,L,LL) :-
not_first(A),
not_first(B),
!,
handle(['push-2variables',A,B],I,I1,L,L1),
handle_all(Y,I1,II,L1,LL).
handle_all([['push-variable-scm',A],
['push-variable-scm',B],
......@@ -70,6 +53,24 @@ handle_all([['push-variable-scm',B],
handle([bini,Op,A,B,C],I,I1,L,L1),
handle_all(Y,I1,II,L1,LL).
handle_all([['push-variable',A],
['push-variable',B],
['push-variable',C]|Y], I,II,L,LL) :-
not_first(A),
not_first(B),
not_first(C),
!,
handle(['push-3variables',A,B,C],I,I1,L,L1),
handle_all(Y,I1,II,L1,LL).
handle_all([['push-variable',A],
['push-variable',B]|Y], I,II,L,LL) :-
not_first(A),
not_first(B),
!,
handle(['push-2variables',A,B],I,I1,L,L1),
handle_all(Y,I1,II,L1,LL).
handle_all([X|Y],I,II,L,LL) :- !,
handle(X,I,I1,L,L1),!,
handle_all(Y,I1,II,L1,LL).
......@@ -266,27 +267,27 @@ handle([bin,Op,[[S1,V1,Q1],N1,F1|_],
(F3==#t,S3==#t) ->
(
new_var(V3,Q3,S3),
code([bin,Op,V1,V2,V3,#t],K,Add),
code([bin,Op,V1,V2,V3,3],K,Add),
L=[[Add,K]|LL],
II is I + 2
);
F3==#t ->
(
new_var(V3,Q3,S3),
code([bin,Op,V1,V2,V3,#f],K,Add),
code([bin,Op,V1,V2,V3,0],K,Add),
L=[[Add,K]|LL],
II is I + 2
);
N3==1 ->
(
new_var(V3,Q3,S3),
code([bin,Op,V1,V2,V3,1],K,Add),
code([bin,Op,V1,V2,V3,1],5,Add),
L=[[Add,K]|LL],
II is I + 2
) ;
(
new_var(V3,Q3,S3),
code([bin,Op,V1,V2,V3,0],K,Unify),
code([bin,Op,V1,V2,V3,1],K,Unify),
L=[[Unify,K]|LL],
II is I + 2
)
......@@ -575,14 +576,10 @@ code([bin,Op,V1,V2,V3,K3],Code,Action) :-
(V1=[V1C|_] -> A1=1 ; (V1=V1C, A1=0)),
(V2=[V2C|_] -> A2=1 ; (V2=V2C, A2=0)),
(V3=[V3C|_] -> A3=1 ; (V3=V3C, A3=0)),
(
K1 = #f -> K1C=2;
K1 = #t -> K1C=3 ;
K1C = K1
),
A is A1 + A2 << 1 + A3 << 2 + K1C << 3,
KC = K3,
A is A1 + A2 << 1 + A3 << 2 + KC << 3,
Code is V1C + V2C << 16 + V3C << 32 + A << 48,
K1==#f -> binxx2(Op,Action) ; binxxu2(Op,Action).
binxx2(Op,Action).
code([bini,OP,V2,V3,K3],Code,Action) :-
(
......
......@@ -180,6 +180,10 @@
the_tr(t(X) , [tr(X,N)]) :- inc(N).
the_tr((t(X,Y):-L),[tr(X,Y) :- L]).
binsi2.
binis2.
binss2.
the_tr(binss2_(X,Y) ,[tr(Y,N),binss2(X,Y)]) :- inc(N).
the_tr(binxx2_(X,Y) ,[tr(Y,N),binxx2(X,Y)]) :- inc(N).
the_tr(binxxu2_(X,Y),[tr(Y,N),binxxu2(X,Y)]) :- inc(N).
......@@ -356,7 +360,7 @@ un('op1_-').
un('op1_+').
un(\\).
un(ᶜ).
/*
binss(> ,'ss-gt').
binss(< ,'ss-lt').
binss(>= ,'ss-ge').
......@@ -403,28 +407,12 @@ binxx2_(xor,'xx-xor-x').
binxx2_(^,'xx-pow-x').
binxx2_(**,'xx-pow-x').
binxxu2_(min,'xx-umin-x').
binxxu2_(max,'xx-umax-x').
binxxu2_(+,'xx-uadd-x').
binxxu2_(-,'xx-usub-x').
binxxu2_(*,'xx-umul-x').
binxxu2_(/,'xx-udiv-x').
binxxu2_(mod,'xx-umod-x').
binxxu2_(rem,'xx-urem-x').
binxxu2_(<<,'xx-ulshift-x').
binxxu2_(>>,'xx-urshift-x').
binxxu2_(/\\,'xx-uand-x').
binxxu2_(\\/,'xx-uor-x').
binxxu2_(xor,'xx-uxor-x').
binxxu2_(^,'xx-upow-x').
binxxu2_(**,'xx-upow-x').
binsi2_(+,'is-addi-s').
binis2_(+,'is-addi-s').
binxi2_(+,'is-addi-x').
binix2_(+,'is-addi-x').
*/
")
......
(<define> (make_state f a c e m s b h q x)
(<var> (F A C E M S B H Q)
(<=> (F A C E M S B H Q)
(f a c e m s b h q))
(<=> x ,(vector F A C E M S B H Q))))
(define nf 0)
(define na 1)
(define nc 2)
(define ne 3)
(define nm 4)
(define ns 5)
(define nb 6)
(define nh 7)
(define nq 8)
(<define> (make_state f a c e m s b b2 h q x)
(<var> (F A C E M S B B2 H Q)
(<=> (F A C E M S B B2 H Q)
(f a c e m s b b2 h q))
(<=> x ,(vector F A C E M S B B2 H Q))))
(define nf 0)
(define na 1)
(define nc 2)
(define ne 3)
(define nm 4)
(define ns 5)
(define nb 6)
(define nb2 7)
(define nh 8)
(define nq 9)
(<define> (push_Q e v u)
;(<pp> `(push ,e))
......@@ -74,6 +75,14 @@
(<=> s ,(<lookup> (vector-ref v ns)))
(<=> m ,(<lookup> (vector-ref v nm)))))
(<define> (get_AB2ESM v a b2 e s m)
(<let> ((v (<lookup> v)))
(<=> a ,(<lookup> (vector-ref v na)))
(<=> b2 ,(<lookup> (vector-ref v nb2)))
(<=> e ,(<lookup> (vector-ref v ne)))
(<=> s ,(<lookup> (vector-ref v ns)))
(<=> m ,(<lookup> (vector-ref v nm)))))
(<define> (get_AES v a e s)
(<let> ((v (<lookup> v)))
(<=> s ,(<lookup> (vector-ref v ns)))
......@@ -100,6 +109,14 @@
(<=> b ,(<lookup> (vector-ref v nb)))
(<=> h ,(<lookup> (vector-ref v nh)))))
(<define> (get_FEBB2H v f e b b2 h)
(<let> ((v (<lookup> v)))
(<=> f ,(<lookup> (vector-ref v nf)))
(<=> e ,(<lookup> (vector-ref v ne)))
(<=> b ,(<lookup> (vector-ref v nb)))
(<=> b2 ,(<lookup> (vector-ref v nb2)))
(<=> h ,(<lookup> (vector-ref v nh)))))
(<define> (get_ACESB v a c e s b)
(<let> ((v (<lookup> v)))
(<=> s ,(<lookup> (vector-ref v ns)))
......@@ -156,6 +173,12 @@
(<set> (vector-ref v ne) (<lookup> e))
(<set> (vector-ref v nb) (<lookup> b))))
(<define> (set_EBB2 v e b b2)
(let ((v (<lookup> v)))
(<set> (vector-ref v ne ) (<lookup> e))
(<set> (vector-ref v nb ) (<lookup> b))
(<set> (vector-ref v nb2) (<lookup> b2))))
(<define> (set_SM v s m)
(let ((v (<lookup> v)))
(<set> (vector-ref v ns) (<lookup> s))
......@@ -167,6 +190,13 @@
(<set> (vector-ref v ne) (<lookup> e))
(<set> (vector-ref v ns) (<lookup> s))))
(<define> (set_AB2ES v a b2 e s)
(let ((v (<lookup> v)))
(<set> (vector-ref v na) (<lookup> a))
(<set> (vector-ref v nb2) (<lookup> b2))
(<set> (vector-ref v ne) (<lookup> e))
(<set> (vector-ref v ns) (<lookup> s))))
(<define> (set_ESM v e s m)
(let ((v (<lookup> v)))
(<set> (vector-ref v nm) (<lookup> m))
......@@ -232,6 +262,11 @@
(let ((v (<lookup> v)))
(<set> (vector-ref v ne) (<lookup> e))))
(<define> (set_B2E v b2 e)
(let ((v (<lookup> v)))
(<set> (vector-ref v nb2) (<lookup> b2))
(<set> (vector-ref v ne) (<lookup> e))))
(<define> (set_F v f)
(let ((v (<lookup> v)))
(<set0> (vector-ref v nf) (<lookup> f))))
......@@ -326,15 +361,16 @@ add_var_f(X,V,F,Tag) :-
add_var_f(X,0,V,F,Tag).
add_var_f(X,S,V,FF,Tag) :-
get_FEBH(V,F,E,B,H),
get_FEBB2H(V,F,E,B,B2,H),
get_e_tag(X,H,FF,Ex,Tag,Etags),
EE is E \\/ Ex,
BB is B \\/ Ex,
set_EB(V,EE,BB),
EE is E \\/ Ex,
BB is B \\/ Ex,
BB2 is B2 \\/ Ex,
set_EBB2(V,EE,BB,BB2),
reference(H,Tag),
(0 =:= Ex /\\ S -> true ; force_variable(Tag)),
(0 =:= Ex /\\ B -> first(Tag) ; true),
(0 =:= Ex /\\ S -> true ; force_variable(Tag)),
(0 =:= Ex /\\ B2 -> first(Tag) ; true),
Edeps is Etags /\\ B,
get_tags_from_bits(H,Edeps,Deps),
m(reference(H),Deps).
......@@ -343,14 +379,15 @@ add_var(X,V,Tag) :-
add_var(X,0,V,Tag).
add_var(X,S,V,Tag) :-
get_FEBH(V,F,E,B,H),
get_FEBB2H(V,F,E,B,B2,H),
get_e_tag(X,H,F,Ex,Tag,Etags),
EE is E \\/ Ex,
BB is B \\/ Ex,
set_EB(V,EE,BB),
EE is E \\/ Ex,
BB is B \\/ Ex,
BB2 is B2 \\/ Ex,
set_EBB2(V,EE,BB,BB2),
reference(H,Tag),
(0 =:= Ex /\\ S -> true ; force_variable(Tag)),
(0 =:= Ex /\\ B -> first(Tag) ; true),
(0 =:= Ex /\\ S -> true ; force_variable(Tag)),
(0 =:= Ex /\\ B2 -> first(Tag) ; true),
Edeps is Etags /\\ B,
get_tags_from_bits(H,Edeps,Deps),
m(reference(H),Deps).
......
......@@ -2,7 +2,12 @@
(use-modules (logic guile-log guile-prolog ops))
(use-modules (logic guile-log guile-prolog vm-compiler))
#;
(eval-when (compile)
(pk (prolog-run-rewind 1 (x)
(dyntrace (@@ (logic guile-log guile-prolog vm vm-goal2)
compile_goal)))))
#;
(compile-prolog-string
"
- eval_when(compile).
......@@ -10,6 +15,21 @@ the_tr2(X,[X]).
:- add_term_expansion_temp(the_tr2).
")
(compile-prolog-string
"
compiles_only_clauses.
")
(define-prolog q "
q(Code,Narg) :-
(
Code = (F(|A) :- Goal) -> length(A,Narg) ;
Code = (F :- Goal) -> Narg = 0 ;
throw(compiles_only_clauses(Code))
).
")
(define-prolog b "
b(X,Y) :- Y is X + 1.
")
......
......@@ -817,7 +817,7 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
}
//#define DB(X)
static inline void gp_unwind_(SCM s, int ncons, int nvar, int nfr)
static inline void gp_unwind_(SCM s, int ncons, int nvar, int nci)
{
struct gp_stack *gp = get_gp();
SCM *fr, *ci,*si,*cs,lt;
......@@ -864,7 +864,7 @@ static inline void gp_unwind_(SCM s, int ncons, int nvar, int nfr)
v));
}
ci += 1 - nfr;
ci += 1 - nci;
si = gp->gp_stack + GP_GET_VAR(fr) - nvar;
cs = gp->gp_cons_stack + GP_GET_CONS(fr) - ncons;
......@@ -874,7 +874,7 @@ static inline void gp_unwind_(SCM s, int ncons, int nvar, int nfr)
gp->handlers = ha;
gp_unwind0(fr - GP_FRAMESIZE*nfr,ci, si, cs, gp);
gp_unwind0(fr - GP_FRAMESIZE*nci,ci, si, cs, gp);
gp_unwind_dynstack(gp, dyn_n);
......@@ -992,7 +992,7 @@ static inline void gp_unwind_soft(int ncons)
static inline void gp_unwind_ncons(SCM fr, int ncons)
{
gp_unwind_(fr,ncons,0,0);
gp_unwind_(fr,-ncons,0,0);
}
static inline void gp_unwind_tail(SCM fr)
......
This source diff could not be displayed because it is too large. You can view the blob instead.
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