updated the vm with the cutter logic

parent bc0fc961
......@@ -149,7 +149,7 @@ constant = #(nlocals nstack constants code)
(define-syntax-rule (GPPAIR? x s) (TRUE (<call> gp_pair x s)))
(define-syntax-rule (GPCAR x s) (LOOKUP (<call> gp_car x s) s))
(define-syntax-rule (GPCDR x s) (LOOKUP (<call> gp_gp_cdr x s) s))
(define-syntax-rule (GGPPAIR? x) (<call> consp x))
(define-syntax-rule (GGPAIR? x) (<call> consp x))
(define-syntax-rule (GGPCAR x) (<call> car x))
(define-syntax-rule (GGPCDR x) (<call> cdr x))
(define-syntax-rule (GPCONS x y s) (<call> gp_cons_simple x y s))
......@@ -963,12 +963,12 @@ constant = #(nlocals nstack constants code)
s)
stack s))
(define-syntax-rule (STORE-STATE-NEG tp tag s sut p stack)
(define-syntax-rule (STORE-STATE-NEG tp tag s scut p stack)
(GPCONS (GPCONS tag
(GPCONS p
(<if> tp
(GPCONS
(GPCONS s scut)
(GPCONS s scut s)
(<call> scm_fluid_ref *delayers*) s)
s)
s)
......@@ -1000,7 +1000,7 @@ constant = #(nlocals nstack constants code)
(<if> (EQ (GGPCAR x) tag)
(<let*> ((x1 (GGPCDR x))
(x2 (GGPCDR x1)))
(<if> (GGPPAIR? x2)
(<if> (GGPAIR? x2)
(<begin>
(<call> scm_fluid_set_x *delayers*
(GGPCDR x2))
......@@ -1941,13 +1941,20 @@ constant = #(nlocals nstack constants code)
(<goto> ret))
(LABEL cutter)
(<let*> ((v (scm->ulong (<*> inst-pt)))
(vc (<bit-and> v (<c> #xffff)))
(vcs (q>> v (<c> 16))))
(<=> inst-pt (<+> inst-pt 1))
(<=> cut (SVAR-REF fp nstack v1))
(<=> scut (SVAR-REF fp nstack v2))
(<=> (GET-CUT variables) (SVAR-REF fp nstack v1))
(<let*> ((ulong v (scm->ulong (<*> inst-pt)))
(ulong vc (<bit-and> v (<c> #xffff)))
(ulong vcs (<bit-and> (q>> v (<c> 16)) (<c> #xffff)))
(ulong q (q>> v (<c> 32)))
(SCM xs (<if> (<bit-and> q (<c> 1))
(<ref> variables vc)
(SVAR-REF fp nstack vc)))
(SCM xcs (<if> (<bit-and> q (<c> 2))
(<ref> variables vcs)
(SVAR-REF fp nstack vcs))))
(<=> inst-pt (<+> inst-pt (<c> 1)))
(<=> cut xs)
(<=> scut xcs)
(<=> (GET-CUT variables) xs)
(NEXT inst-pt))
(LABEL call)
......
(use-modules (logic guile-log iso-prolog))
(use-modules (logic guile-log guile-prolog ops))
(use-modules (logic guile-log guile-prolog vm-compiler))
(use-modules (logic guile-log guile-prolog vm-compiler2))
(compile-prolog-string
"
......@@ -9,7 +10,7 @@ the_tr2(X,[X]).
:- add_term_expansion_temp(the_tr2).
")
#;
(define-prolog f1 "
f1(N,I,J,S) :-
I < N ->
......@@ -47,83 +48,6 @@ the_tr2(X,[X]).
).
")
(compile-prolog-string "
f3(N,I,J,S) :-
I < N ->
(
II is I + 1,
JJ is J + I,
f3(N,II,JJ,S)
) ;
S=J.
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
f([[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1],
[1,1,1,1,1,1,1,1,1]]).
")
#;
(define-prolog memb "
memb(X,L) :-
......
This diff is collapsed.
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