dynamic API ready implemented, prolog part is working

parent 09fb757d
......@@ -49,8 +49,9 @@
;vlist-unfold vlist-unfold-right vlist-append
vlist-reverse vlist-filter vlist-delete vlist->list
vlist-for-each
vlist-truncate! vhash-truncate!
vlist-thread-inc vlist-new-thread
vlist-refcount-- vlist-refcount++
vhash? vhash-cons vhash-consq vhash-consv
vhash-assoc vhash-assq vhash-assv
......
This diff is collapsed.
......@@ -67,7 +67,8 @@ SCM_DEFINE(undo_safe_variable_guard, "gp-undo-safe-variable-guard", 3, 0, 0,
struct gp_stack *gp;
UNPACK_ALL(ci,l,ggp,gp,s,"failed to unpack s in undo_safe_variable_guard");
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var) || SCM_CONSP(var))
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var) || SCM_CONSP(var)
|| scm_is_true(scm_procedure_p (var)))
{
SCM vnew_ = scm_c_make_vector(D_NGUARD, SCM_BOOL_F);
SCM *vnew = SCM_I_VECTOR_WELTS(vnew_);
......@@ -79,8 +80,11 @@ SCM_DEFINE(undo_safe_variable_guard, "gp-undo-safe-variable-guard", 3, 0, 0,
val = SCM_CDR(var);
else if(SCM_VARIABLEP(var))
val = SCM_VARIABLE_REF(var);
else
else if(SCM_FLUID_P(var))
val = scm_fluid_ref(var);
else
val = scm_call_0(var);
vnew[D_GUARD_VAL] = val;
gp->dynstack = scm_cons(vnew_, gp->dynstack);
......@@ -107,7 +111,7 @@ SCM_DEFINE(undo_safe_variable_rguard, "gp-undo-safe-variable-rguard", 3, 0, 0,
struct gp_stack *gp;
UNPACK_ALL(ci,l,ggp,gp,s,"failed to unpack s in undo_safe_variable_rguard");
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var) || SCM_CONSP(var))
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var) || SCM_CONSP(var) || scm_is_true(scm_procedure_p (var)))
{
SCM vnew_ = scm_c_make_vector(D_NRGUARD, SCM_BOOL_F);
SCM* vnew = SCM_I_VECTOR_WELTS(vnew_);
......@@ -139,7 +143,8 @@ SCM_DEFINE(undo_safe_variable_lguard, "gp-undo-safe-variable-lguard", 3, 0, 0,
struct gp_stack *gp;
UNPACK_ALL(ci,l,ggp,gp,s,"failed to unpack s in undo_safe_variable_rguard");
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var) || SCM_CONSP(var))
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var) || SCM_CONSP(var)
|| scm_is_true(scm_procedure_p (var)))
{
SCM vnew_ = scm_c_make_vector(D_NLGUARD, SCM_BOOL_F);
SCM* vnew = SCM_I_VECTOR_WELTS(vnew_);
......@@ -176,7 +181,8 @@ SCM_DEFINE(gp_with_fluid, "gp-fluid-set", 2, 0, 0,
gp = (struct gp_stack *) SCM_SMOB_DATA(a);
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var))
if(SCM_VARIABLEP(var) || SCM_FLUID_P(var)
|| scm_is_true(scm_procedure_p (var)))
{
SCM vnew_ = scm_c_make_vector(D_NFLUID, SCM_BOOL_F);
SCM* vnew = SCM_I_VECTOR_WELTS(vnew_);
......@@ -189,11 +195,17 @@ SCM_DEFINE(gp_with_fluid, "gp-fluid-set", 2, 0, 0,
temp = SCM_VARIABLE_REF(var);
SCM_VARIABEL_SET(val);
}
else
else if(SCM_FLUID_P(var))
{
temp = scm_fluid_ref(var);
scm_fluid_set_x(var, val);
}
else
{
temp = scm_call_0(var);
scm_call_1(var, val);
}
vnew[D_FLUID_VAL] = temp;
gp->dynstack = scm_cons(vnew_, gp->dynstack);
......@@ -363,10 +375,14 @@ void eval_rguard(SCM guard, SCM K)
{
SCM_VARIABLE_SET(var, val);
}
else
else if(SCM_FLUID_P(var))
{
scm_fluid_set_x(var, val);
}
else
{
scm_call_1(var, val);
}
}
}
......@@ -397,10 +413,14 @@ SCM manage_dyn_wind(SCM obj, SCM K, SCM *rguard) {
{
SCM_VARIABLE_SET(var, val);
}
else
else if(SCM_FLUID_P(var))
{
scm_fluid_set_x(var, val);
}
else
{
scm_call_1(var, val);
}
}
{
......@@ -413,8 +433,10 @@ SCM manage_dyn_wind(SCM obj, SCM K, SCM *rguard) {
vnew[D_GUARD_VAL] = SCM_CDR(var);
else if(SCM_VARIABLEP(var))
vnew[D_GUARD_VAL] = SCM_VARIABLE_REF(var);
else
else if(SCM_FLUID_P(var))
vnew[D_GUARD_VAL] = scm_fluid_ref(var);
else
vnew[D_GUARD_VAL] = scm_call_0(var);
return vnew_;
}
}
......@@ -446,11 +468,15 @@ SCM manage_dyn_wind(SCM obj, SCM K, SCM *rguard) {
temp = SCM_VARIABLE_REF(var);
SCM_VARIABLE_SET(var, val);
}
else
else if(SCM_FLUID_P(var))
{
temp = scm_fluid_ref(var);
scm_fluid_set_x(var, val);
}
else
{
scm_call_1(var, val);
}
vnew[D_FLUID_VAL] = temp;
return vnew_;
}
......@@ -531,11 +557,14 @@ SCM unwind_dynstack_it(SCM pp, SCM *rguard)
{
v[D_GUARD_VAL] = SCM_VARIABLE_REF(var);
}
else
else if(SCM_FLUID_P(var))
{
v[D_GUARD_VAL] = scm_fluid_ref(var);
}
else
{
v[D_GUARD_VAL] = scm_call_0(var);
}
return pp;
}
......@@ -549,11 +578,16 @@ SCM unwind_dynstack_it(SCM pp, SCM *rguard)
v[D_FLUID_VAL] = SCM_VARIABLE_REF(var);
SCM_VARIABLE_SET(var, temp);
}
else
else if(SCM_FLUID_P(var))
{
v[D_FLUID_VAL] = scm_fluid_ref(var);
scm_fluid_set_x(var, temp);
}
else
{
v[D_FLUID_VAL] = scm_call_0(var);
scm_call_1(var, temp);
}
return pp;
}
}
......@@ -699,9 +733,11 @@ SCM make_rguards(SCM rguards)
vnew[D_GUARD_VAL - 1] = SCM_CDR(var);
else if(SCM_VARIABLEP(var))
vnew[D_GUARD_VAL - 1] = SCM_VARIABLE_REF(var);
else
else if(SCM_FLUID_P(var))
vnew[D_GUARD_VAL - 1] = scm_fluid_ref(var);
else
vnew[D_GUARD_VAL - 1] = scm_call_0(var);
out = scm_cons(vnew_, out);
rguards = SCM_CDR(rguards);
}
......
......@@ -101,10 +101,12 @@ inline int block_append_s(SCM* block, SCM value, int offset, int hashp)
ulong seq = my_scm_to_ulong(scm_fluid_ref(thread_seq_number));
ulong thr = my_scm_to_ulong(scm_fluid_ref(thread_id));
/*
printf("offset %d block_size %d nextfree %d\n"
, offset , (int) block_size(block), NEXTFREE(nextfree));
*/
if ((offset < block_size(block))
&& (!hashp || (THR(st) == thr && SEQ(os) == seq)) &&
(offset == NEXTFREE(nextfree)))
......
......@@ -73,6 +73,7 @@
gp-windlevel-ref
gp-fluid-set!
*gp*
*windlevel*
gp-var-set!
gp-new-postpone-level
gp-get-fixed-free
......
......@@ -11,7 +11,9 @@
vlist-reverse vlist-filter vlist-delete vlist->list
vlist-for-each
vlist-truncate! vhash-truncate!
vlist-thread-inc vlist-new-thread
vlist-refcount-- vlist-refcount++
vhash? vhash-cons vhash-consq vhash-consv
vhash-assoc vhash-assq vhash-assv
......
......@@ -2,6 +2,30 @@
(use-modules (logic guile-log indexer))
(use-modules (logic guile-log umatch))
(use-modules (logic guile-log))
(define (try f n)
(define (g n)
(if (= n 0)
(<run> 10 () (f 1 'a))
(begin
(<run> 10 () (f 1 'a))
(g (- n 1)))))
(let loop ((i 1000))
(if (= i 0)
(g 1)
(begin
(<clear>)
(g n)
(loop (- i 1))))))
(define (add x)
(dynamic-push *current-stack* f x #f #f))
(define (get)
(dynamic-env-ref f))
(define (comp)
(dynamic-compile-index *current-stack* f))
(define-dynamic f)
(<define> (add-rules a)
......@@ -10,20 +34,30 @@
(<append-dynamic> f (<lambda-dyn> (,a 'd)))
(<append-dynamic> f (<lambda-dyn> (,a 'e))))
(pk (<run> 10 (x y)
(add-rules 1)
(add-rules 2)
(add-rules 3)
#;(f x y)))
(<run> 10 (x y)
(add-rules 1))
(define (add x)
(dynamic-push *current-stack* f x #f #f))
(define (get)
(dynamic-env-ref f))
(comp)
(pk
(<run> 100 (x y)
(add-rules 2)
(add-rules 3)
(<=> x 1)
(f x y)))
(pk
(<run> 100 (x y)
(<remove-dynamic> (f _ 'c))
(<remove-dynamic> (f _ 'e))
(<remove-dynamic> (f 2 'b))
(add-rules 7)
(f x y)))
(define (comp)
(dynamic-compile-index *current-stack* f))
#|
(define n 33)
......
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