major refactoring and introducing a drastic simplifier

parent 78425701
......@@ -122,6 +122,7 @@ PSSOURCES = \
logic/guile-log/guile-prolog/vm/vm-args.scm \
logic/guile-log/guile-prolog/vm/vm-handle.scm \
logic/guile-log/guile-prolog/vm/vm-disj.scm \
logic/guile-log/guile-prolog/vm/vm-conj.scm \
logic/guile-log/guile-prolog/vm/vm-imprint.scm \
logic/guile-log/guile-prolog/vm/vm-unify.scm \
logic/guile-log/guile-prolog/vm/vm-goal.scm \
......
......@@ -14,14 +14,12 @@
cat(F,G) :-
catch(F,Er,
(
tf(Er),
(Er==#t -> throw(bug_should_not_throw_true ; G)
).
caf(F) :-
catch(F,Er,
(
ff(Er)
tfc(Er),
(
Er==#t -> throw(bug_should_not_throw_true ;
Er==#f -> throw(bug_should_not_throw_cut ;
G
)
).
collect_disj([],U,U).
......@@ -35,70 +33,120 @@ collect_disjunction(';'(|L),U,UU) :- !,
collect_disjunction(X,[X|UU],UU).
%head_at_true(First,Last,A,C,Lab,Lab2,L1,LLX)
head_at_true(#t,_,A,C,Lab,Lab2,L1,LLX) :- L1=LLX, Lab2=Lab.
head_at_true(#t,_,A,C,Lab,Lab2,L1,LLX) :- L1=LLX, Lab2=Lab.
head_at_true(#f,#f,A,C,Lab,Lab2,L1,LLX) :-
tr(unwind,Unwind),
label(Lab2),
L1=[[label,Lab,U],[Unwind,A,Lab2,0,C]|LLX].
head_at_true(#f,#t,A,C,Lab,Lab2,L1,LLX) :-
label(Lab2),
tr('unwind-tail',UnwindTail),
L1=[[label,Lab,U],[UnwindTail,A,C]|LLX].
compile_disjunction
([X],First,Out,Lab,A,Tail,S0,[U],V,[L,LL]) :- !,
First=#t -> compile_goal(X,Tail,V,[L,LL]) ;
caf(
get_ACES(V,Aq,C,E,S),
set_ES(V,0,S0),
([X],First,Aq,Ae,Out,Lab,A,Tail,S0,[U],V,[L,LL]) :- !,
First=#t -> compile_goal(X,First,V,[L,LL]) ;
catch((
get_CES(V,C,E,S),
set_AES(V,Aq,0,S0),
(
compile_goal(X,Tail,V,[LX,LL]),
get_ACES(Aq1,C1,E1,S1),
(C == C1 -> true ; throw(bug_c_state_error)),
(
Aq == Aq1 -> AAq=Aq ;
eql_a(Ae,Aq1) -> true ;
throw(all_disjuction_goals_needs_the_same_begin_level)
),
SS is max(S,S1),
EE is E \\/ E1,
set_AES(Aq,EE,SS),
U = [E1,_],
tr('unwind-tail',UnwindTail),
L=[[label,Lab,U],[UnwindTail,A,C] | LX]
head_at_true(First,#t,A,C,Lab,Lab2,L,LX)
),Er,
(
tfc(Er),
(
Er == #t ->
(
First==#t ->
throw(#t) ;
head_at_true(#f,#t,A,C,Lab,Lab2,L,LL)
);
Er == #f -> throw(#f);
Er == c -> throw(#f)
)
)).
compile_disjunction([X|Y],First,Out, Lab,A,Tail,S0,[U|UU],V,[L,LL]) :- !,
tr('goto-inst',Goto),
get_ACES(Aq,C,V,E,S),
(Tail==#t -> LG=LLX ; LG = [[Goto,Out]|LLX]),
set_ES(V,0,S0),
catch(
(
goal(X,Y,Lab,Tail,Out,A,Ae,Aq,C,S,S0,E,U,UU,V,L,LL,LG,LLX) :-
compile_goal(X,Tail,V,[LX,LG]),
get_ACES(V,A1q,C1,E1,S1),
(C == C1 -> true ; throw(bug_c_state_error)),
S2 is max(S,S1),
E2 is E \\/ E1,
U = [E1,_],
set_AES(V,A2q,E2,S2),
LQ =[LLX,LL],
(First == #t ->
set_ES(V,E2,S2),
(
First == #t ->
(
A2q=A1q,
L = [[label,_,U]|LX],
cat(compile_disjunction(Y,#f,Out,Lab,A,Tail,S0,UU,V,[LLX,LL]),
LLX=LL)
) ;
A1q=Ae,
);
(
(
Aq == A1q -> A1q=A2q ;
Ae == A1q -> true ;
throw(all_disjuction_goals_needs_the_same_begin_level)
),
label(Lab2),tr(unwind,Unwind),
L = [[label,Lab,U],[unwind,A,Lab2,0,C]|LX],
cat(compile_disjunction(Y,#f,Out,Lab2,A,Tail,S0,UU,V,[LLX,LL]),
) LLX=LL)
)
)
ifc(compile_disjunction(Y,#f,Aq,Ae,Out,Lab2,A,Tail,S0,UU,V,[LLX,LL]),Err
(
Err=#t ->
throw(bug_true_not_be_send_in_non_first_disjunction);
head_at_true(First,#t,A,C,Lab,Lab2,L,LL);
),
head_at_true(First,#f,A,C,Lab,Lab2,L,LX)
)
compile_disjunction([X|Y],First,Aq,Ae,Out, Lab,A,Tail,S0,[U|UU],V,[L,LL]) :- !,
tr('goto-inst',Goto),
get_CES(V,C,E,S),
(Tail==#t -> LG=LLX ; LG = [[Goto,Out]|LLX]),
set_AES(V,Aq,0,S0),
catch(goal(X,Y,Lab,Tail,Out,A,Ae,Aq,C,S,S0,E,U,UU,V,L,LL,LG,LLX), Er
(
tfc(Er),
(Tail==#t -> LLG = [[cc]|LG] ; LLG=LG),
(
Er==c -> throw(#f) ;
Er==#t ->
(
U = [E1,_],
ifc(compile_disjunction
(Y,#f,Aq,Aq,Out,Lab2,A,Tail,S0,UU,V,[LLX,LL]), Er2,
(
tfc(Er2),
(
Er2==#f ->
(
First = #t ->
throw(#t);
(
head_at_true(#f,#t,A,C,Lab,Lab2,L,LLG),
LLX=LL
)
);
throw(bug_should_not_throw_true_or_cut)
)
),
(
(First==#t -> true
(Aq==Ae -> true
throw(syntax_error_begin_en_missmatch))),
head_at_true(First,#f,A,C,Lab,Lab2,L,LG)
)));
compile_disjunction(Y,First,Aq,Eq,Out,Lab,A,Tail,S0,[U|UU],V,[L,LL])
)
),Er,
(
tf(Er),
Er==#t ->
(
label(Lab2),tr(unwind,Unwind),
L = [[label,Lab,U],[unwind,A,Lab2,0,C]|LG],
cat(compile_disjunction(Y,#f,Out,Lab2,A,Tail,S0,UU,V,[LLX,LL]),
LLX=LL)
);
caf(compile_disjunction(Y,First,Out,Lab,A,Tail,S0,[U|UU],V,[L,LL]))
)).
)).
")
......@@ -12,6 +12,7 @@
#:use-module (logic guile-log guile-prolog vm vm-imprint)
#:use-module (logic guile-log guile-prolog vm vm-scm)
#:use-module (logic guile-log guile-prolog vm vm-disj)
#: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))
......@@ -113,15 +114,12 @@ compile_goal((F :- Goal),Tail,V,L) :- !,
compile_goal((pop(4),Goal),Tail,V,L).
compile_goal((X,Y),Tail,V,L) :- !,
link_l(L,L1,L2),
ifc(
compile_goal(X,#f,V,L1),
#t,
compile_goal(Y,Tail,V,L),
compile_goal(Y,Tail,V,L2)
).
collect_conj((X,Y),Gs,[]).
compile_conj(Gs,Tail,V,L).
compile_goal((fail,false),#t,V,[[[fail],[cc] |L], L])
compile_goal((fail,false),#f,V,[[[fail] |L], L])
compile_goal(true,_,_,_) :- throw(#t)
compile_goal(';'(|X),Tail,V,[L,LL]) :- !,
collect_disj(X,XX,[]),
(
......@@ -132,9 +130,9 @@ compile_goal(';'(|X),Tail,V,[L,LL]) :- !,
get_E(V,E),
set_E(V,0),
label(Lab),label(Out),tr(newframe,Newframe),
compile_disjunction(XX,#t,Out,Lab,Lab,Tail,S2,U,V,LM,Er).
L = [[Newframe,Lab,0] | LX],
LM = [LX, [[label,Out] | LL]],
compile_disjunction(XX,#t,Out,Lab,Lab,Tail,S2,U,V,LM,Er),
get_E(B,Ed),
add_missing_variables(H,U,Ed,Ed,EEd),
EE is E \\/ EEd
......
......@@ -144,7 +144,12 @@
(compile-prolog-string
"
ifc(G,E,X,Y) :-
catch(G,E,X),
(var(E) -> X ; true).
tf(E) :- (E==#t;E==#f) -> true ; throw(E).
tfc(E) :- (E==#t;E==#f,E==c) -> true ; throw(E).
tt(E) :- E==#t -> true ; throw(E).
ff(E) :-
(E == #t -> throw(bug_should_not_throw_true) ; throw(E)).
......@@ -159,6 +164,8 @@ reference([HC,HV],[_,V,_,X,E]) :-
set(Etags,Enew)
).
eql_a(X,X).
first ([_,_,#t|_]).
isFirst([_,_,X |_]) :- X==#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