Skip to content

G
Guile Log
Commit b227dfa2 authored by Stefan Israelsson Tampe's avatar Stefan Israelsson Tampe
Browse files
Options

engines work

parent 8fccf112
Hide whitespace changes
Inline Side-by-side
Showing with 222 additions and 101 deletions
Makefile.am
View file @ b227dfa2
......@@ -100,7 +100,6 @@ PSSOURCES = \
logic/guile-log/iso-prolog.scm \
logic/guile-log/prolog/goal-expand.scm \
logic/guile-log/guile-prolog/set.scm \
logic/guile-log/guile-prolog/engine.scm \
logic/guile-log/guile-prolog/delay.scm \
logic/guile-log/guile-prolog/foldarg.scm \
logic/guile-log/guile-prolog/ops.scm \
......@@ -115,6 +114,7 @@ PSSOURCES = \
logic/guile-log/guile-prolog/canon.scm \
logic/guile-log/guile-prolog/project.scm \
logic/guile-log/guile-prolog/interpreter.scm \
logic/guile-log/guile-prolog/engine.scm \
logic/guile-log/guile-prolog/state.scm \
logic/guile-log/guile-prolog/postpone.scm \
logic/guile-log/guile-prolog/gc-call.scm \
......@@ -132,26 +132,26 @@ PSSOURCES = \
logic/guile-log/guile-prolog/vm/vm-unify.scm \
logic/guile-log/guile-prolog/vm/vm-goal.scm \
logic/guile-log/guile-prolog/vm-compiler.scm \
logic/guile-log/guile-prolog/vm/vm-var2.scm \
logic/guile-log/guile-prolog/vm/vm-scm2.scm \
logic/guile-log/guile-prolog/vm/vm-args2.scm \
logic/guile-log/guile-prolog/vm/vm-handle2.scm \
logic/guile-log/guile-prolog/vm/vm-disj2.scm \
logic/guile-log/guile-prolog/vm/vm-conj2.scm \
logic/guile-log/guile-prolog/vm/vm-imprint2.scm \
logic/guile-log/guile-prolog/vm/vm-unify2.scm \
logic/guile-log/guile-prolog/vm/vm-goal2.scm \
logic/guile-log/guile-prolog/vm-compiler2.scm \
logic/guile-log/examples/kanren/type-inference.scm \
logic/guile-log/imatch.scm \
prolog-user.scm \
language/prolog/install.scm \
language/prolog/spec.scm \
language/prolog/modules/user.scm \
language/prolog/modules/sandbox.pl \
language/prolog/modules/boot/expand.pl \
language/prolog/modules/boot/dcg.pl \
language/prolog/modules/boot/if.pl
language/prolog/modules/boot/if.pl \
prolog-user.scm
# logic/guile-log/guile-prolog/vm/vm-var2.scm \
# logic/guile-log/guile-prolog/vm/vm-scm2.scm \
# logic/guile-log/guile-prolog/vm/vm-args2.scm \
# logic/guile-log/guile-prolog/vm/vm-handle2.scm \
# logic/guile-log/guile-prolog/vm/vm-disj2.scm \
# logic/guile-log/guile-prolog/vm/vm-conj2.scm \
# logic/guile-log/guile-prolog/vm/vm-imprint2.scm \
# logic/guile-log/guile-prolog/vm/vm-unify2.scm \
# logic/guile-log/guile-prolog/vm/vm-goal2.scm \
# logic/guile-log/guile-prolog/vm-compiler2.scm \
# language/prolog/modules/swi/term_macro.pl \
# language/prolog/modules/library/error.pl \
# language/prolog/modules/library/vhash.scm \
......
logic/guile-log/dynamic-features.scm
View file @ b227dfa2
......@@ -405,7 +405,7 @@ before. This works very much like a fluid
(rd (mk api e h ref (dotr))))
(let ((wind (gp-windlevel-ref s)))
(gp-undo-safe-variable-lguard
(gp-undo-safe-variable-lguard
rd
(gp-rebased-level-ref wind)
s)
......
logic/guile-log/guile-prolog/dynamic-features.scm
View file @ b227dfa2
......@@ -40,7 +40,7 @@
(<recur> lp ((l l))
(if (pair? l)
(<and>
(add-dynamic-function-dynamics (car l))
(add-dynamic-function-dynamics (<lookup> (car l)))
(lp (cdr l)))
<cc>)))
......@@ -51,7 +51,7 @@
(<recur> lp ((h h))
(if (pair? h)
(<and>
(backtrack-dynamic-object (car h) fail-)
(backtrack-dynamic-object (<lookup> (car h)) fail-)
(lp (cdr h)))
<cc>))))
......@@ -66,9 +66,9 @@
(define a_b
(<case-lambda>
((h code)
(a-b h (<lambda> () (goal-eval code)) fail-))
(a-b (<lookup> h) (<lambda> () (goal-eval code)) fail-))
((h . l)
(a-b h (<lambda> () (<apply> a_b l)) fail-)))))
(a-b (<lookup> h) (<lambda> () (<apply> a_b l)) fail-)))))
(mk-with with_fluid_guard_dynamic_object
with-fluid-guard-dynamic-object)
......
logic/guile-log/guile-prolog/engine.scm
View file @ b227dfa2
(define-module (logic guile-log guile-prolog engine)
#:use-module (ice-9 match)
#:use-module (logic guile-log run)
#:use-module (logic guile-log)
#:use-module (logic guile-log guile-prolog dynamic-features)
#:use-module (logic guile-log guile-prolog interpreter)
#:use-module (logic guile-log dynamic-features)
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log code-load)
......@@ -43,8 +45,27 @@
((#:throw e)
(set! engine #f)
state)
(_
state))))
(x
(if (eq? x 'stalled)
(begin
(set! state
(list #:stalled
(let ((e engine)
(g guards)
(p path))
(lambda ()
(set! engine e)
(set! guards g)
(set! path p)))
(cons
(@@ (logic
guile-log
guile-prolog
interpreter)
lold)
(get-continuation))))
state)
state)))))
(start-f
(lambda (s)
......@@ -53,7 +74,7 @@
(set! start-f next)
(let ((s2 #f)
(pth #f)
(g (gp-store-engine-guards)))
(g #f))
(dynamic-wind
(lambda ()
(set! g (gp-store-engine-guards))
......@@ -104,14 +125,22 @@
((#:throw e)
state)
((#:stalled thunk cc)
(thunk)
(<state-set!> (car cc))
(set! state (continue (cdr cc)))
(on-result))
((#:yield s0 p0 cc x)
(set! state (cc s0 p0))
state)
(on-result))
((#:finish _ p x)
(set! state (p))
state))
(on-result))
(x x))
#:exit))
(lambda ()
......@@ -125,6 +154,10 @@
(#:post (apply variable-set! postbox term))
(#:finish
(set! engine #f))
(#:set-state
(set! state s))
(#:set-engine
(set! engine (cadr state)))
(#:exist
(and engine
(match state
......@@ -143,25 +176,40 @@
(<define> (engine_next engine term)
(let* ((engine (<lookup> engine))
(res (engine #:run S)))
(<<match>> (#:mode -) (res)
(#:exit
<fail>)
(<recur> lp ((res res))
(<<match>> (#:mode - #:name engine_next) (res)
(#:exit
<fail>)
((#:throw e)
(<var> (ee)
(copy_term e ee)
(throw ee)))
((#:throw e)
(<var> (ee)
(copy_term e ee)
(throw ee)))
((#:finish s p x)
(<=> x term))
((#:finish s p x)
(<=> x term))
((#:yield s p cc x)
(<=> x term)))))
((#:yield s p cc x)
(<=> x term))
((#:stalled _ _)
(<and>
(write "stalled engine > ")
(write engine)
(nl)
(let ((state res))
(stall)
(<code> (engine #:set-state state))
(lp (engine #:run S)))))
(x (<ret> x))))))
(<define> (engine_next_reified engine term)
(let* ((engine (<lookup> engine))
(res (engine #:run S)))
(<<match>> (#:mode -) (res)
(<recur> lp ((res res))
(<<match>> (#:mode - #:name engine_next_reified) (res)
(#:exit
(<=> "no" term))
......@@ -173,7 +221,20 @@
(<=> ,(vector (list "the" x)) term))
((#:yield s p cc x)
(<=> ,(vector (list "the" x)) term)))))
(<=> ,(vector (list "the" x)) term))
((#:stalled _ _)
(<and>
(write "stalled engine > ")
(write engine)
(nl)
(let ((state res))
(stall)
(<code> (engine #:set-state state))
(lp (engine #:run S)))))
(x (<ret> x))))))
(define engine_post
(<case-lambda>
......@@ -231,6 +292,8 @@
parse_ops(L,Ops,Defaults).
defaults([\"alias\"(noname),\"global\"(100),\"local\"(100),\"trail\"(100)]).
engine_create(Template, Goal, Engine) :-
engine_create(Template, Goal, Engine, []).
engine_create(Template, Goal, Engine, Ops) :-
defaults(Defaults),
parse_ops(Ops, [\"alias\"(Name),\"local\"(Size)], Defaults),
......
logic/guile-log/guile-prolog/interpreter.scm
View file @ b227dfa2
......@@ -37,6 +37,8 @@
stall thin_stall))
(define-named-object -all- (make-fluid false))
(define *cc* (@@ (logic guile-log run) *cc*))
(<wrap> add-fluid-dynamics *cc*)
(<wrap> add-fluid-dynamics -all-)
(define-named-object *once* (gp-make-var #f))
(define-named-object -nsol- (make-fluid #f))
......@@ -445,11 +447,28 @@ conversation_ :-
conversation1(X,All) :-
backtrack_dynamic_object(scm[*globals-map*]),
fluid_guard_dynamic_object(scm[*var-attributator*],scm[-n-],scm[env],
scm[-nsol-], scm[-all-], scm[-mute?-],scm[*globals-map*]),
state_guard_dynamic_object(scm[*var-attributator*],
scm[-n-], scm[-nsol-], scm[-all-], scm[-mute?-],scm[env],
scm[*user-data*],scm[*globals-map*]),
fluid_guard_dynamic_object(
scm[-n-],
scm[-nsol-],
scm[-all-],
scm[*globals-map*],
scm[*var-attributator*],
scm[env],
scm[*cc*],
scm[*user-data*],
scm[-mute?-]),
state_guard_dynamic_object(
scm[-n-],
scm[-nsol-],
scm[-all-],
scm[*globals-map*],
scm[*var-attributator*],
scm[env],
scm[*cc*],
scm[*user-data*],
scm[-mute?-]),
wrap_frame,
'new-machine',
conversation2(X,All).
......
logic/guile-log/macros.scm
View file @ b227dfa2
......@@ -1164,6 +1164,7 @@ For tabling, negations are tricky. the reason is that when a recursive applicati
#;(log-code-macro '<dynwind>)
;; This is code that allow to store a state
(define (pkk x) (pk (vector-ref (car (cdr x)) 3)) x)
(define (<state-ref>)
(gp-store-state (fluid-ref *current-stack*)))
......
logic/guile-log/parser.scm
View file @ b227dfa2
(define-module (logic guile-log parser)
#:use-module (logic guile-log parsing scanner)
#:use-module (logic guile-log)
#:use-module (logic guile-log vlist)
#:use-module (logic guile-log fstream)
#:use-module (logic guile-log umatch)
#:use-module ((ice-9 match) #:renamer (symbol-prefix-proc 'ice:))
......@@ -63,14 +64,13 @@
(define *freeze-map* #f)
(define head #f)
(define clear-tokens
(let ((fl (make-fluid #f)))
(let ((fl (make-fluid vlist-null)))
(set! *freeze-map* fl)
(lambda ()
(let ((ht (make-hash-table)))
(set! head ht)
(let ((ht vlist-null))
(fluid-set! fl ht)))))
(clear-tokens)
(define make-file-reader
......@@ -440,8 +440,9 @@
(define (p-freeze tok f mk)
(<p-lambda> (c)
(<and!>
(<let> ((val (hash-ref (fluid-ref *freeze-map*)
(cons* N M tok) #f))
(<let> ((val
(vhash-ref (fluid-ref *freeze-map*)
(cons* N M tok) #f))
(op P)
(os S)
(fr (<newframe>)))
......@@ -455,14 +456,21 @@
(<unwind-tail> fr))
(<with-fail> op
(<with-s> os
(<code>
(hash-set! (fluid-ref *freeze-map*)
(cons* n m tok) (list X XL N M XX ... val2)))
(<p-cc> val2)))))
(<code>
(fluid-set!
*freeze-map*
(vhash-cons
(cons* n m tok)
(list X XL N M XX ... val2)
(fluid-ref *freeze-map*))))
(<p-cc> val2)))))
(<let> ((val2 'fail))
(<code>
(hash-set! (fluid-ref *freeze-map*)
(cons* n m tok) val2))
(fluid-set!
*freeze-map*
(vhash-cons
(cons* n m tok) val2
(fluid-ref *freeze-map*))))
<fail>)))
(if (pair? val)
(<and>
......
logic/guile-log/prolog/parser.scm
View file @ b227dfa2
......@@ -710,23 +710,26 @@
(.. (a) (l c2))
(<p-cc> #t))
(<p-cc> #f)))
(<pp> `(c2 ,c2))
(xx (c3)
(<or>
(<and>
(<and>
(.. (u) ((f-or expr (f-and ws (f-out #f))) cl))
(if (match u (((_ _ "|" _) . l) #f) (else #t))
(<p-cc> u)
(.. ((e c1) cl))))
(.. ((e c1) cl))))
(.. ((e c1) cl))
(<p-cc> (pk c2))))
(<pp> `(c3 ,c3))
(.. (c4) (r c3))
(xx (c5) (if cl
(.. (r c4))
(<p-cc> #f)))
(.. (u) (@tag c5))
(<p-cc>
(wrap@ u (if (eq? c2 c3)
(wrap@ u (pk (if (eq? c2 c3)
`(#:lam-term ,c1 () ,cl ,n ,m)
`(#:lam-term ,c1 ,(<scm> c3) ,cl ,n ,m))))))
`(#:lam-term ,c1 ,(<scm> c3) ,cl ,n ,m)))))))
mk-id)))
(define set-tok
......@@ -747,7 +750,7 @@
(.. (c0) (ws c))
(<let> ((n N) (m M))
(.. (c2) (l c0))
(.. (c3) (expr c2))
(xx (c3) (<or> (.. (expr c2)) (<p-cc> '())))
(.. (c4) (r c3))
(<p-cc>
`(#:lam-term #f ,(<scm> c3) #f ,n ,m))))
......
logic/guile-log/run.scm
View file @ b227dfa2
......@@ -8,6 +8,7 @@
#:export (<stall> <continue> <take> <run> <eval> <ask>
<cont-ref> <cont-set!>
*gp-var-tr* *kanren-assq*
get-continuation continue
*init-tr*))
(define put_attr #f)
(define *init-tr* (make-fluid (lambda () #f)))
......@@ -36,29 +37,38 @@
(define bar build_attribut_representation)
(define-named-object *cc* (gp-make-var #f))
(define-named-object *cc* (make-fluid #f))
(define (<stall> s p cc . l)
(gp-var-set *cc* (cons s (cons (cons p l) cc)) s)
(fluid-set! *cc* (cons s (cons (cons p l) cc)))
(fluid-set! *current-stack* s)
'stalled)
(define (<cont-ref>)
(gp-var-ref *cc*))
(fluid-ref *cc*))
(define (<cont-set!> cc)
(let ((s (car cc)))
(gp-var-set *cc* cc s)
(fluid-set! *cc* cc)
(fluid-set! *current-stack* s)))
(define (get-continuation)
(fluid-ref *cc*))
(define (continue *cc*)
(if (and *cc* (car *cc*))
(apply (cddr *cc*) (car *cc*) (cadr *cc*))
'cannot-continue))
(define (<take> n) (<continue> n))
(define <continue>
(case-lambda
(() (let ((*cc* (gp-var-ref *cc*)))
(() (let ((*cc* (fluid-ref *cc*)))
(if (and *cc* (car *cc*))
(apply (cddr *cc*) (car *cc*) (cadr *cc*))
'cannot-continue)))
((n) (let ((*cc* (gp-var-ref *cc*)))
((n) (let ((*cc* (fluid-ref *cc*)))
(if (and *cc* (integer? n) (not (car *cc*)))
((cdr *cc*) n)
'cannot-continue-and-take-n)))))
......@@ -210,20 +220,20 @@
(lambda (s p)
(if (= n 0)
(let ((r (reverse ret)))
(gp-var-set *cc* (cons #f (lambda (mm)
(fluid-set! *cc* (cons #f (lambda (mm)
(set! n mm)
(set! ret '())
(p))) s)
(p))))
r)
(begin
(set! n (- n 1))
(set! ret (cons (tr (gp->scm v s) s #t) ret))
(if (= n 0)
(let ((r (reverse ret)))
(gp-var-set *cc* (cons #f (lambda (mm)
(fluid-set! *cc* (cons #f (lambda (mm)
(set! n mm)
(set! ret '())
(p))) s)
(p))))
r)
(p)))))))))))
......@@ -247,22 +257,20 @@
(lambda (s p)
(if (= n 0)
(let ((r (reverse ret)))
(gp-var-set *cc* (cons #f (lambda (mm)
(fluid-set! *cc* (cons #f (lambda (mm)
(set! n mm)
(set! ret '())
(p)))
s)
(p))))
r)
(begin
(set! n (- n 1))
(set! ret (cons (tr (list (gp->scm v s) ...) s #f) ret))
(if (= n 0)
(let ((r (reverse ret)))
(gp-var-set *cc* (cons #f (lambda (mm)
(fluid-set! *cc* (cons #f (lambda (mm)
(set! n mm)
(set! ret '())
(p)))
s)
(p))))
r)
(p)))))))))))))
......
logic/guile-log/src/Makefile
View file @ b227dfa2
......@@ -204,7 +204,7 @@ AUTOHEADER = ${SHELL} /home/stis/src/guile-log/build-aux/missing autoheader
AUTOMAKE = ${SHELL} /home/stis/src/guile-log/build-aux/missing automake-1.14
AWK = gawk
CC = gcc
CCDEPMODE = depmode=gcc3
CCDEPMODE = depmode=gcc3
CFLAGS = -g -O2
CPP = gcc -E
CPPFLAGS =
......
logic/guile-log/src/dynstack.c
View file @ b227dfa2
......@@ -9,6 +9,7 @@ In a future version we might deside to put in a link between the functional
structure and this tree and unwind/rewind them in a logically more correct way.
*/
//#define DB(X) X
//ID structure
#define D_VARIABLE_GUARD 2
#define D_FLUID 6
......@@ -32,14 +33,26 @@ structure and this tree and unwind/rewind them in a logically more correct way.
//LGUARD
#define D_LGUARD_VAR 1
#define D_LGUARD_K 2
#define D_NLGUARD 3
#define D_OLD_K 3
#define D_NLGUARD 4
//FLUID
#define D_FLUID_VAR 1
#define D_FLUID_VAL 2
//#define D_OLD_K 3
#define D_OLD_K 3
#define D_NFLUID 4
inline SCM make_rguard(SCM var, SCM val, SCM k)
{
SCM vnew_ = scm_c_make_vector(D_NGUARD - 1, SCM_BOOL_F);
SCM *vnew = SCM_I_VECTOR_WELTS(vnew_);
vnew[D_GUARD_K - 1] = k;
vnew[D_GUARD_VAR - 1] = var;
vnew[D_GUARD_VAL - 1] = val;
return vnew_;
}
#define GET_ENV(h) SCM_I_VECTOR_WELTS(SCM_VARIABLE_REF(h));
#define OLD(h) h[4];
#define NEXT(h) h[3];
......@@ -64,7 +77,7 @@ SCM_DEFINE(gp_get_rguards, "gp-rguards-ref", 0, 0, 0,(),"")
SCM_DEFINE(undo_safe_variable_guard, "gp-undo-safe-variable-guard", 3, 0, 0,
(SCM var, SCM kind, SCM s),
"")
#define FUNC_NAME s_safe_variable_guard
#define FUNC_NAME s_undo_safe_variable_guard
{
SCM ggp;
struct gp_stack *gp;
......@@ -120,7 +133,7 @@ SCM get_l_k_part(SCM k, SCM guards)
SCM_DEFINE(undo_safe_variable_rguard, "gp-undo-safe-variable-rguard", 3, 0, 0,
(SCM var, SCM kind, SCM s),
"")
#define FUNC_NAME s_safe_variable_rguard
#define FUNC_NAME s_undo_safe_variable_rguard
{
SCM ggp;
struct gp_stack *gp;
......@@ -184,12 +197,11 @@ SCM get_oldkind(SCM k, SCM guards)
SCM_DEFINE(undo_safe_variable_lguard, "gp-undo-safe-variable-lguard", 3, 0, 0,
(SCM var, SCM kind, SCM s),
"")
#define FUNC_NAME s_safe_variable_lguard
#define FUNC_NAME s_undo_safe_variable_lguard
{
return SCM_BOOL_F;
SCM ggp;
struct gp_stack *gp;
//format2("lguard ~a -> ~a~%",var, SCM_FLUID_P(var)?scm_fluid_ref(var):SCM_BOOL_F);
UNPACK_ALL00(ggp,gp,s,"failed to unpack s in undo_safe_variable_rguard");
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var) || SCM_CONSP(var)
......@@ -197,6 +209,7 @@ SCM_DEFINE(undo_safe_variable_lguard, "gp-undo-safe-variable-lguard", 3, 0, 0,
{
SCM vnew_ = scm_c_make_vector(D_NLGUARD, SCM_BOOL_F);
SCM* vnew = SCM_I_VECTOR_WELTS(vnew_);
vnew[D_ID] = SCM_PACK(D_LGUARD);
vnew[D_LGUARD_K] = kind;
vnew[D_LGUARD_VAR] = var;
......@@ -214,8 +227,8 @@ SCM_DEFINE(undo_safe_variable_lguard, "gp-undo-safe-variable-lguard", 3, 0, 0,
gp->dynstack = scm_cons(vnew_, gp->dynstack);
gp->dynstack_length += 4;
gp->rguards = scm_cons(scm_cons(vnew[D_LGUARD_VAR], vnew[D_LGUARD_K]),
gp->rguards = scm_cons(scm_cons(var, kind),
gp->rguards);
return SCM_UNSPECIFIED;
......@@ -240,6 +253,8 @@ SCM_DEFINE(gp_with_fluid, "gp-fluid-set", 2, 0, 0,
gp = (struct gp_stack *) SCM_SMOB_DATA(a);
//format3("var ~a -> ~a | n = ~a~%",var,SCM_FLUID_P(var)?scm_fluid_ref(var):SCM_BOOL_F,SCM_PACK(gp->dynstack_length));
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var)
|| scm_is_true(scm_procedure_p (var)))
{
......@@ -424,12 +439,13 @@ void eval_rguard(SCM guard, SCM K)
{
SCM* v = SCM_I_VECTOR_WELTS(guard);
SCM k = v[D_GUARD_K - 1];
gp_debug0("A guard\n");
if(dynwind_check(k,K))
{
SCM var = v[D_GUARD_VAR - 1];
SCM val = v[D_GUARD_VAL - 1];
gp_format2("var = val, ~a = ~a~%", var, val);
if(SCM_CONSP(var))
SCM_SETCDR(var, val);
else if(SCM_VARIABLEP(var))
......@@ -597,6 +613,7 @@ SCM wind_dynstack(SCM pt, SCM dynstack, SCM K, SCM *rguard)
SCM unwind_dynstack_it(SCM pp, SCM *rguard)
{
gp_debug0("unwind it\n");
SCM* v = SCM_I_VECTOR_WELTS(pp);
scm_t_bits id = SCM_UNPACK(v[D_ID]);
......@@ -806,6 +823,7 @@ void reinstate_dynstack(struct gp_stack *gp,
//#define DB(X)
SCM make_rguards(SCM rguards)
{
gp_debug0("make_rguards\n");
......@@ -813,22 +831,21 @@ SCM make_rguards(SCM rguards)
while(SCM_CONSP(rguards))
{
SCM guard = SCM_CAR(rguards);
SCM vnew_ = scm_c_make_vector(D_NGUARD - 1, SCM_BOOL_F);
SCM *vnew = SCM_I_VECTOR_WELTS(vnew_);
vnew[D_GUARD_K - 1] = SCM_CDR(guard);
SCM k = SCM_CDR(guard);
SCM var = SCM_CAR(guard);
vnew[D_GUARD_VAR - 1] = var;
SCM val;
if(SCM_CONSP(var))
vnew[D_GUARD_VAL - 1] = SCM_CDR(var);
val = SCM_CDR(var);
else if(SCM_VARIABLEP(var))
vnew[D_GUARD_VAL - 1] = SCM_VARIABLE_REF(var);
val = SCM_VARIABLE_REF(var);
else if(SCM_FLUID_P(var))
vnew[D_GUARD_VAL - 1] = scm_fluid_ref(var);
val = scm_fluid_ref(var);
else
vnew[D_GUARD_VAL - 1] = scm_call_0(var);
val = scm_call_0(var);
out = scm_cons(make_rguard(var,val,k), out);
out = scm_cons(vnew_, out);
rguards = SCM_CDR(rguards);
}
......@@ -886,3 +903,4 @@ void gp_unwind_dynstack(struct gp_stack *gp, scm_t_bits dyn_n)
SCM_EOL););
*/
}
//#define DB(X)
logic/guile-log/src/state.c
View file @ b227dfa2
......@@ -333,7 +333,7 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, i
gp->dynstack = SCM_EOL;
gp->dynstack_length = 2;
gp->dynstack_length = 2; //2 = SCM_UNPACK(scm_from_int(0));
gp->rguards = SCM_EOL;
gp->handlers = SCM_EOL;
......@@ -1632,16 +1632,15 @@ SCM_DEFINE(gp_new_engine, "gp-new-engine", 1, 0, 0, (SCM e),
scm_fluid_set_x(gp_current_stack,e);
{
struct gp_stack *gp = get_gp();
gp_clear(SCM_BOOL_F);
SCM ss = scm_fluid_ref(current_stack); //Sooo confusing TODO: FIXME
SCM carss = gp_car(ss,ss);
SCM cdr = scm_cons(SCM_EOL,SCM_EOL);
SCM cdr = scm_cons(SCM_EOL, gp_engine_path);
ss = scm_cons(carss , scm_cons(SCM_EOL, gp_engine_path));
ss = scm_cons(carss , cdr);
return scm_cons(ss, path);
}
......