Even better recur

parent 465c6539
......@@ -175,6 +175,39 @@ variables is the most difficult part to maintain
(mk-instructions instructions)
(list->vector constants)
tvar))))))))))
#;
(<define> (compile_to_meta stx code meta)
(<var> (stackSize constants l nvar nsvar tvar narg)
(compile_goal code l stackSize narg constants #f)
(get_varn nvar)
(get_vart tvar)
(max_svarns nsvar)
(<recur> lp ((l (<scm> l)) (o '()))
(<<match>> (#:mode -) (l)
((x . l) (lp l ((@ (guile) append) ((@ (guile) reverse) x) o)))
(()
(let* ((instructions (pp 'instructions: ((@ (guile) reverse) o)))
(nvar (pp 'nvar: (<lookup> nvar)))
(tvar (pp 'tvar: (<lookup> tvar)))
(nsvar (pp 'nsvar: (<lookup> nsvar)))
(narg (pp 'narg: (<lookup> narg)))
(stackSize (pp 'size: (<lookup> stackSize)))
(constants (pp 'constants: (map car (<scm> constants))))
(constants-r (map (lambda (c)
(let ((c (<lookup> c)))
#`(@@
#,(precedure-property c 'mod)
#,(precedure-property c 'name))))
constants)))
<cut>
(<=> meta
#`(make-vm-function
'(#,(+ narg 4) . #,(+ stackSize nsvar))
`#,(pack-start nvar
stackSize
(mk-instructions instructions)
,(vector #,@constants-r)
tvar)))))))))
(define readline_term_str (@@ (logic guile-log guile-prolog interpreter)
readline_term_str))
......
......@@ -141,6 +141,7 @@ constant = #(nlocals nstack constants code)
(define-syntax-rule (PAIR? x) (<call> SCM_CONSP x))
(define-syntax-rule (NUMBER? s) (<call> SCM_I_INUMP s))
(define-syntax-rule (MKVAR s) (<call> gp_mkvar s))
(define-syntax-rule (LOOKUP x s) (<call> gp_gp_lookup x s))
(define-syntax-rule (VARIABLE? x) (<call> SCM_VARIABLEP x))
(define-syntax-rule (MAKE-VARIABLE x)
(<call> scm_make_variable x))
......@@ -710,7 +711,10 @@ constant = #(nlocals nstack constants code)
(SVAR-REF fp nstack i2)
(<ref> variables i2)))
(SCM ss (<if> (<==> m (<scm> #f))
(SCM ss
(<begin>
(FORMAT "~a = ~a~%" x y)
(<if> (<==> m (<scm> #f))
(<call> gp_m_unify x y s)
(<if> (<or>
(<==> m (<scm> #t))
......@@ -719,7 +723,7 @@ constant = #(nlocals nstack constants code)
(<call>
gp_gp_unify_raw x y s)
(<call>
gp_gp_unify x y s)))))
gp_gp_unify x y s))))))
(<if> (<call> scm_is_true ss)
(<begin>
(<=> s ss)
......@@ -1901,14 +1905,17 @@ constant = #(nlocals nstack constants code)
(<=> (SVAR-REF fp nstack i) v)
(<=> (<ref> variables i) v))
v)
(UNPACK-VAR
0 x i pinned? variables
variables-scm nvar
cnst session middle
(LOOKUP
(UNPACK-VAR
0 x i pinned? variables
variables-scm nvar
cnst session middle
(SVAR-REF fp nstack i)
(<ref> variables i)))))
(<ref> variables i))
s))))
(<=> inst-pt (<+> inst-pt (<c> 2)))
(FORMAT "push ~a~%" v)
(<=> (<*> sp) v)
(INCR 1 sp))
(NEXT inst-pt)
......
......@@ -135,7 +135,7 @@ caller(F,Args,Tail,V,[L,LL]) :-
L3=[[Seek,3]|L4],
push_args_args(Args,V,L4,LL2),
touch_A(V),
set_FS(V,F,S),
set_FS(V,scm[(gensym \"F\")],S),
(Tail == #t ->
(
tr('tail-call', Call),
......
......@@ -165,6 +165,8 @@ compile_goal(Op(\"recur\",Args),Tail,V,[L,LL]) :-
mg(recur(|U),XX,Impr,0,N),
add_recur(F,A,N),
push_args_args(Xin,V,L,L1),
touch_A(V),
set_F(V,scm[(gensym \"Rec\")]),
L1=[[label,A]|L2],
compile_goal((begin_att,Impr,end_att),Tail,V,[L2,LL]).
......
(use-modules (logic guile-log iso-prolog))
(use-modules (logic guile-log guile-prolog ops))
(use-modules (logic guile-log guile-prolog vm-compiler))
(define f1 #f)
(define (f1 . l) (apply g l))
(define-prolog g "
f(N,I,J,S) :-
I < N ->
......@@ -12,7 +12,6 @@
) ;
S=J
")
(set! f1 g)
(define-prolog f2 "
f2(N,S) :-
......
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