double negation optimisation added

parent b51e650d
......@@ -803,6 +803,7 @@ constant = #(nlocals nstack constants code)
(REGISTER pre-unify)
(REGISTER post-unify)
(REGISTER post-unify-tail)
(REGISTER post-s)
(REGISTER clear-sp)
(REGISTER false)
......@@ -1571,6 +1572,15 @@ constant = #(nlocals nstack constants code)
(BACKTRACK p instructions inst-pt fp sp))
(NEXT inst-pt))))
(LABEL post-s)
(PRSTACK sp fp)
(<let> ((SCM np (<ref> inst-pt (<c> 0))))
(<=> cut (<ref> inst-pt (<c> 1)))
(<=> inst-pt (<+> inst-pt (<c> 2)))
(RESTORE-STATE-TAIL s p np ctrl-stack)
(UNWIND-TAIL s)
(NEXT inst-pt))
;; We will
(LABEL unwind-tail)
(PRSTACK sp fp)
......
......@@ -55,7 +55,7 @@ compile_disjunction0
get_CES(V,[C|_],E,S),
set_AES(V,Aq,0,S0),
(
((nonvar(X),X=(G1->G2)) -> XX=[G1,softie(A),G2] ; XX=X),
((nonvar(X),X=(G1->G2)) -> XX=(G1,softie(A),G2) ; XX=X),
compile_goal(XX,Tail,V,[LX,LL]),
get_ACES(V,Aq1,[C1|_],E1,S1),
(C == C1 -> true ; throw(bug_c_state_error)),
......@@ -88,7 +88,7 @@ goal(X,Y,First,Lab,Tail,Out,A,Ae,Aq,S0,[U|UU],V,L,LL,LG,LLX) :-
get_CES(V,[C|_],E,S),
set_AES(V,Aq,0,S0),
(First==#t -> true ; set_F(V,scm[(gensym \"tag\")])),
((nonvar(X),X=(G1->G2)) -> XX=[G1,softie(A),G2] ; XX=X),
((nonvar(X),X=(G1->G2)) -> XX=(G1,softie(A),G2) ; XX=X),
compile_goal(XX,Tail,V,[LX,LG]),
get_ACES(V,A1q,[C1|_],E1,S1),
(C == C1 -> true ; throw(bug_c_state_error)),
......
......@@ -229,6 +229,23 @@ compile_goal(once(G),Tail,V,[L,LL]) :- !,
compile_goal((X->Y),Tail,V,L) :- !,
compile_goal((once(X),Y),Tail,V,L).
compile_goal(\\+\\+\\+X,Tail,V,[L,LL]) :- !,
compile_goal(\\+X,Tail,V,[L,LL]).
compile_goal(\\+\\+X,Tail,V,[L,LL]) :- !,
L=[[newframe,Al,0]|LX],
get_ACESB(V,A,C,E,S,B),
C = [C0|_],
CC = [Al|C],
compile_goal(X,#f,V,[LX,LLX]),
set_ACESB(V,A,C,E,S,B),
(Tail=#t -> LG==[[cc]|LL] ; LG=LL),
LLX = [[goto-inst ,Bl ],
[label ,Al ],
['unwind-negation' ,Al,C0],
[label ,Bl ],
['post-s' ,Al,C0]|LG].
compile_goal(\\+X,Tail,V,[L,LL]) :- !,
check_tail(Tail),
label(Br),
......@@ -240,8 +257,11 @@ compile_goal(\\+X,Tail,V,[L,LL]) :- !,
get_ACESB(V,A,C,E,S,B),
C = [C0|_],
CC = [Al|C],
set_CE(V,CC,0),
ifc(compile_goal(X,#f,V,[LX,LLX]),Er,
ifc(
(
set_ACE(V,[[0|_]],CC,0),
compile_goal(X,#f,V,[LX,LLX])
),Er,
(
tfc(Er),
(Er==#t -> throw(#f) ; throw(#t))
......
......@@ -38,7 +38,8 @@ handle((X,[('goto-inst';'store-state';'unwind-tail';softie),N]),
L=[X|LL].
handle((X,[(newframe;'newframe-negation';'post-negation'
;'unwind' ;'unwind-negation'),A,B]),
;'unwind' ;'unwind-negation'
;'post-s' ),A,B]),
I,II,L,LL) :- !,
II is I + 3,
L=[X|LL].
......
......@@ -183,6 +183,7 @@ t(newframe).
t(unwind).
t('unwind-tail').
t(softie).
t('post-s').
t('newframe-negation').
t('unwind-negation').
......
......@@ -153,6 +153,12 @@
(<set> (vector-ref v nc) (<lookup> c))
(<set> (vector-ref v ne) (<lookup> s))))
(<define> (set_ACE v a c e)
(let ((v (<lookup> v)))
(<set> (vector-ref v na) (<lookup> a))
(<set> (vector-ref v ne) (<lookup> e))
(<set> (vector-ref v nc) (<lookup> c))))
(<define> (set_ACESB v a c e s b)
(let ((v (<lookup> v)))
(<set> (vector-ref v na) (<lookup> a))
......@@ -216,7 +222,9 @@ tt(E) :- E==#t -> true ; throw(E).
ff(E) :-
(E == #t -> throw(bug_should_not_throw_true) ; throw(E)).
check_tail(Tail) :- Tail==#t ; Tail==#f.
check_tail(Tail) :-
(Tail=#t ; Tail = #f ; Tail=label(G,0)) -> true ;
throw(a_cc_tail_with_args_not_at_cc_call).
reference([HC,HV],[_,V,_,X,E]) :-
var(V) -> set(V,1) ;
......
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