unify

parent c0dd947e
(define-module (logic guile-log vm unify)
#:use-module (logic guile-log vm utils)
#:use-module (logic guile-log iso-prolog)
#:export (ggset unify unify-2 unify-constant-2
unify-instruction pre-unify post-unify-tail
post-unify
))
(compile-prolog-string
"
ggset(V,I,I,L,LL) :-
scmcall('gp-set',[V,sp(-1),s],I,I1,L,L1),
reset(I,L1,LL).
/*
(UNPACK-VAR 1 n i2 pinned? variables variables-scm nvar
cnst session middle
(<=> (SVAR-REF fp nstack i2) (<call> scm_fluid_ref *delayers*))
(<=> (<ref> variables i2) (<call> scm_fluid_ref *delayers*)))))
*/
'pre-unify'(V,I,L,LL) :-
vset('call?',c(0),I,L,L1),
gset(V,top(delayers),I,L,L1).
/*
(define-syntax-rule (POST-UNIFY inst-pt sp-stack nstack sp fp
pinned? variables variables-scm nvar
cnst session middle)
(<let*> ((SCM n (<*> inst-pt))
(int nsloc (scm->int (<ref> inst-pt (<c> 1))))
(SCM old (UNPACK-VAR 0 n i2 pinned? variables variables-scm nvar
cnst session middle
(SVAR-REF fp nstack i2)
(<ref> variables i2))))
(UNPACK-VAR 1 n i2 pinned? variables variables-scm nvar
cnst session middle
(<=> (SVAR-REF fp nstack i2) (<scm> #f))
(<=> (<ref> variables i2) (<scm> #f)))
(<=> inst-pt (<+> inst-pt (<c> 2)))
(<if> (<not> (EQ (<call> scm_fluid_ref *delayers*) old))
(<begin>
(<=> sp-stack (GET-STACK fp sp))
(<if> (q> nsloc (<c> 0))
(LINK-SVARS fp nstack nsloc sp-stack))
(<=> (FARG 0 fp) *dls*)
(<=> (FARG 4 fp) old)
(<=> sp (PFARG 5 fp))
(<goto> call)))))
*/
'post-unify'(V,Nsloc,I,L,LL) :-
gref(V,I,L,L1),
II is I + 1,
gset(V,c(#f),II,L2,L3),
gref(delayers,II,L3,L4),
generate(eq(I,II),L4,L5),
generate(je(E),L5,L6),
generate('delay-call'(Nsloc),L6,LL),
label(E,LL).
/*
(define-syntax-rule (POST-UNIFY-TAIL inst-pt sp-stack nstack
sp fp pinned? variables variables-scm
nvar cnst session middle)
(<let*> ((SCM n (<*> inst-pt))
(SCM old (UNPACK-VAR 0 n i2 pinned? variables variables-scm nvar
cnst session middle
(SVAR-REF fp nstack i2)
(<ref> variables i2))))
(UNPACK-VAR 1 n i2 pinned? variables variables-scm nvar
cnst session middle
(<=> (SVAR-REF fp nstack i2) (<scm> #f))
(<=> (<ref> variables i2) (<scm> #f)))
(<=> inst-pt (<+> inst-pt (<c> 1)))
(<if> (<not> (EQ (<call> scm_fluid_ref *delayers*) old))
(<begin>
(<=> sp-stack (GET-STACK fp sp))
(<=> (FARG 0 fp) *dls*)
(<=> (FARG 4 fp) old)
(<=> sp (PFARG 5 fp))
(<goto> tail-call))
(<goto> cc))))
*/
'post-unify-tail'(V,Nsloc,I,L,LL) :-
gref(V,I,L,L1),
II is I + 1,
gset(V,c(#f),II,L2,L3),
gref(delayers,II,L3,L4),
generate(eq(I,II),L4,L5),
generate(je(E),L5,L6),
generate('delay-call'(Nsloc),L6,L7),
label(E,LL).
cc(L7,LL)
unify(Code,V,I,II,L,LL) :-
M is Code & 3,
A is Code & 4 >> 2,
K is Code & 24 >> 3,
(
M==2 ->
pltest(gp_m_unify [V,sp(I-1),s],I,_,L,L1);
(M==3 ; K==3) ->
pltest_s(gp_gp_unify_raw [V,sp(I-1),s],I,L,L1);
pltest_s(gp_gp_unify [V,sp(I-1),s],I,L,L1)
),
II is I - 1,
reset(II,L1,LL).
'unify-2'(Code,V1,V2,I,L,LL) :-
M is Code & 3,
Code2 is Code >> 2,
A1 is Code2 & 1,
K1 is Code2 & 6 >> 1,
Code3 is Code2 >> 24,
A2 is Code3 & 1,
K2 is is Code3 & 6 >> 1,
(
K1 == 2 ->
(
(
K2 == 2 ->
(
scmcall('gp-var!',[s],I,I1,L,L1),
gset(V2,sp(I1-1),L1,L2),
reset(I,L2,LL)
);
L2=L
)
);
(
K2 == 2 ->
(
gset(V2,V1,I,L,L1),
reset(I,L1,LL)
);
(
M == 2 ->
(
pltest('gp-m-unify',[V1,V2,s],I,_,L,L1),
reset(I,L1,LL)
);
(
(
(M==3;K1==3;K2==3) ->
pltest_s('gp-unify-raw',[V1,V2,s],I,L,L1);
pltest_S(gp_gp_unify,[V1,V2,s],I,L,L1)
),
reset(I,L1,LL)
)
)
)
).
'unify-constant-2'(Code,V,I,L,LL) :-
M is Code & 3,
A is Code & 4 >> 2,
K is Code & 24 >> 3,
(
K == #f ->
gset(V,c(C),I,L,LL);
(
M == #f
(
pltest(gp_m_unify,[V,c(C),s],I,_,L,L2),
reset(I,L2,LL)
)
(
(
(M=#t;K=#t) ->
pltest_s('gp-unify-raw',[V,c(C),s],I,L,L1);
pltest_s('gp_unify',[V,c(C),s],I,L,L1)
),
reset(I,L1,LL)
)
)
).
'unify-instruction'(C,M,I,II,L,LL) :-
(
M == #f ->
pltest('gp_m_unify',[sp(I-1),c(C),s],I,_,L,L2);
pltest_S('gp-unify-raw',[sp(I-1),c(C),s],I,L,L2)
),
II is I - 1,
reset(II,L2,LL)
")
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