<state-ref> etc. now works

parent 61cb6f1b
......@@ -125,7 +125,9 @@ library defined in C, this api are,
There are mainly two stack sets that can be used. bank a and bank b.
you switch to a bank and then issue commands on them. The commands to use
for switching banks are,
for switching banks are. use of these constructs can break the setup of the
system for example guile-log's @code{<state-ref>} and @code{<state-set!>} can
break if we'll use these constructs. It is advicable to alwase be in bank a and only use bank b as a temporary tool.
@code{(gp-swap-to-a)}, swap to bank a.
......@@ -267,6 +269,7 @@ recurrence check e.g. loop detection. @code{#f} if they do not unify (note that
@findex gp-print
@findex gp-printer
@findex gp-copy
@findex gp-get-stack
@code{(gp-print x)} debug tool, prints out information of the internal representation of @code{x}.
......@@ -274,7 +277,9 @@ recurrence check e.g. loop detection. @code{#f} if they do not unify (note that
@code{(gp-copy x)} Makes a copy of @code{x}, but copy the references to variables and not the variables them self
@code{(gp-get-stack)}, a debug tool. Yields the control stack containing undo information.
@section the u- functions
These functions does the same as the gp version of it or is void operations. These functions stems from a similar set of operation that was hard coded in the VM, doing this can increase the speed but this modded VM is not available and was just an experiment.
......@@ -543,6 +548,8 @@ G.L. (if S X Y)
@findex <stall>
@findex <continue>
@findex <take>
@findex <state-ref>
@findex <state-set!>
@code{Scm (<with-guile-log> (p cc) code ...)}, this will start a guile-log session using failure think p and continuation @code{cc} and use @code{p} as a cut as well.
......@@ -556,11 +563,15 @@ G.L. (if S X Y)
@code{G.L. (<stall>)}, this will stall a computation and allow it to continue at the users will and also be able to store the state.
@code{G.L. (<continue>)}, this will make it possible to continue a stalled run, but if the run opted out after n successes then must ask for the number of more successes as well by using:
@code{Scm (<continue>)}, this will make it possible to continue a stalled run, but if the run opted out after n successes then must ask for the number of more successes as well by using:
@code{Scm (<continue> n)}, with @code{n} the number of more successes to returnif we started with @code{(<run> n () ...)}.
@code{Scm <take>}, this is the same as @code{<continue>}.
@code{G.L. (<continue> n)}, with @code{n} the number of more successes to returnif we started with @code{{<run> n () ...)}.
@code{Scm (<state-ref>)}, this returns a value of the current state for which the system can restore later on.
@code{G.L. <take>}, this is the same as @code{<continue>}.
@code{Scm (<state-set!> s)}, restores the state represented by the datadtructure @code{s} that was produced by @code{<state-ref>}.
@section Guile-log macro definitions
@findex define-guile-log
......
......@@ -8,7 +8,8 @@
<and!> <and!!> <succeeds>
<format> <tail-code> <code> <ret> <return>
<def> <<define>> <with-fail> <dynwind> parse<>
let<> <or!> <stall> <continue> <take>)
let<> <or!> <stall> <continue> <take>
<state-ref> <state-set!>)
(re-export define-guile-log guile-log-macro? log-code-macro log-code-macro?)
......@@ -61,8 +62,10 @@
(<eval> (v ...)
(<and> code ...)
(lambda x
(gp-unwind fr)
(reverse ret))
(let ((r ret))
(set! ret '())
(gp-unwind fr)
(reverse r)))
(lambda (p)
(set! ret (cons (u-scm (list v ...)) ret))
(u-abort p)))))
......@@ -77,8 +80,10 @@
(<eval> (v)
(<and> code ...)
(lambda x
(gp-unwind fr)
(reverse ret))
(let ((r ret))
(set! ret '())
(gp-unwind fr)
(reverse r)))
(lambda (p)
(if (= n 0)
(let ((r (reverse ret)))
......@@ -105,8 +110,10 @@
(<eval> (v ...)
(<and> code ...)
(lambda x
(gp-unwind fr)
(reverse ret))
(let ((r ret))
(set! ret '())
(gp-unwind fr)
(reverse r)))
(lambda (p)
(if (> n 0)
(begin
......@@ -723,3 +730,19 @@
(include-from-path "logic/guile-log/interleave.scm")
;; This is code that allow to store a state
(define (<state-ref>)
(let ((ret (cons (gp-store-state)
(begin
(gp-swap-to-b)
(gp-store-state)))))
(gp-swap-to-a)
ret))
(define (<state-set!> state)
(gp-restore-state (car state))
(gp-swap-to-b)
(gp-restore-state (cdr state))
(gp-swap-to-a)
(if #f #f))
......@@ -149,7 +149,8 @@ static inline void gp_unwind0(SCM *ci, SCM *si)
int state = 0;
DB(printf("unwind>\n");fflush(stdout));
/*
if(ci > gp_ci || si > gp_si)
{
if(ci > gp_ci && si > gp_si)
......@@ -157,6 +158,8 @@ static inline void gp_unwind0(SCM *ci, SCM *si)
printf("ERROR in unwind, ci and si not larger at the same time\n");
return;
}
*/
ci_old = gp_ci;
gp_ci = ci;
gp_si = si;
......@@ -280,6 +283,19 @@ SCM_DEFINE(gp_gp_unwind, "gp-unwind", 1, 0, 0, (SCM fr),
}
#undef FUNC_NAME
SCM_DEFINE(gp_get_stack, "gp-get-stack", 0, 0, 0, (),
"yields the stack as a list")
#define FUNC_NAME s_gp_get_stack
{
SCM* i;
SCM ret = SCM_EOL;
for(i = gp_cstack; i < gp_ci; i++)
{
ret = scm_cons(*i,ret);
}
return ret;
}
#undef FUNC_NAME
static inline SCM gp_store_state()
{
......@@ -303,6 +319,12 @@ static inline SCM gp_store_state()
break;
case gp_redo_tag:
head = SCM_CADR(data);
break;
default:
{
head = scm_cons(SCM_PACK(gp_save_tag),data);
gp_ci[-1] = head;
}
}
}
else
......
......@@ -997,7 +997,7 @@ SCM_DEFINE(gp_clear, "gp-clear", 0, 0, 0, (),
"resets the unifyier stacks")
#define FUNC_NAME s_gp_clear
{
gp_unwind0(gp_cstack,gp_stack);
gp_unwind0(gp_cstack + 1,gp_stack + 1);
return SCM_BOOL_T;
}
#undef FUNC_NAME
......@@ -1403,7 +1403,7 @@ SCM_DEFINE(gp_copy,"gp-copy",1,0,0, (SCM x),
void gp_init()
{
SCM x;
#include "unify.x"
//play nice with GC
......@@ -1443,6 +1443,15 @@ void gp_init()
gp_type = scm_make_smob_type("unify-variable",0);
scm_set_smob_print(gp_type,gp_printer);
scm_set_smob_mark(gp_type,gp_type_mark);
swap_to_b();
x = GP_IT(gp_mk_var());
ggp_set(x,SCM_EOL);
swap_to_a();
x = GP_IT(gp_mk_var());
ggp_set(x,SCM_EOL);
}
......
......@@ -36,7 +36,7 @@
u-prompt u-abort u-set! u-var! u-call u-deref gp-atomic?
u-context u-modded
u-unify! u-scm u-unify-raw! u-cons u-dynwind umatch
gp-copy **um**))
gp-copy **um** gp-get-stack))
;;need to add modded,
......
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