fixed INUM -> INUMP in uinfy-undo....c

parent d6212925
......@@ -545,6 +545,7 @@ G.L. (if S X Y)
@findex <ask>
@findex <eval>
@findex <run>
@findex <clear>
@findex <stall>
@findex <continue>
@findex <take>
......@@ -561,6 +562,8 @@ G.L. (if S X Y)
@code{Scm (<run> n (v ...) code ...)}, bind @code{v ...} with variables and execute the code and collect the list of list of bindings of @code{v} at success if @code{(v ...) = (w)} then it will return a list of values. @code{n} is the maximum numbers of success results and skipping @code{n} results in no limit on the number of successes.
@code{Scm (<clear>)}, cleares the stack back to start, use this when finished with @code{<take>,<run>} etc.
@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{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:
......@@ -575,18 +578,25 @@ G.L. (if S X Y)
@section Guile-log macro definitions
@findex define-guile-log
@findex guile-log-macro?
@findex log-code-macro
@findex log-code-macro?
@findex parse<>
@code{(define-guile-log name . l)}, this works like define-syntax, but it will mark the symbol as a guile-log macro currently this is unhygienic so pleas do not mix guile-log entities with other symbols. (TODO fix this)
@code{(guile-log-macro? x)}, returns true if x is a guile-log macro
@code{(log-code-macro x)}, marks x as a log-code macro e.g. it will inline it's code into the continuation in an and sequence hence reduce the number of needed closures.
@code{(log-code-macro? x)}, check to see if @code{x} is a macro.
@code{Scm (parse<> (cut w fail cc) code)}, used to continue guile-log macro
expansion e.g. we could define @code{<and!!>} using
@verbatim
(define-guile-log <and!!>
(syntax-rules ()
((_ meta arg ...)
(parse<> meta (<and> (<and!> arg) ...)))))
@end verbatim
That is a guile-log macro is an ordinary macro but in guile-log expansion it
will add the first argument a meta to that macro that are then used in an ordinary expansion where we indicate a continue in guile-log mode by using @code{parse<>}.
@node postpone
@chapter Postpone, a framework for postponing guile-log evaluations.
This code is available from @code{(logic guile-log postpone)} You may have noticed that guile log is a framework to do tree searches to meet a certain criteria and during the path in the tree create data structures that are able to undo and also redo it's state. Most people when approaching this will sooner or later be bitten by the NP hardness of many interesting problems. The solution might then be to try intelligent guesses in which branch the gold is hiding. What one would like to do is try a set of branches, freeze the different states and at that point create some sort of index that represent the likelihood of the gold lying buried beneath. Then an overall global decision can be taken and only the most promising paths will be further examined. It is for this use case the following system is constructed.
......
......@@ -9,7 +9,7 @@
<format> <tail-code> <code> <ret> <return>
<def> <<define>> <with-fail> <dynwind> parse<>
let<> <or!> <stall> <continue> <take>
<state-ref> <state-set!>)
<state-ref> <state-set!> <lv*> <clear>)
(re-export define-guile-log guile-log-macro? log-code-macro log-code-macro?)
......@@ -42,7 +42,27 @@
(parse<> (fi last fi c)
code))))))
(define (tr x)
(define a '())
(define n 0)
(let loop ((x x))
(match x
((x . l)
(cons (loop x) (loop l)))
((? gp-var? x)
(let* ((m (gp-var-number (gp-lookup x)))
(r (assoc m a)))
(if r
(cdr r)
(let ((k (string->symbol
(format #f "v~a" n))))
(set! a (cons (cons m k) a))
(set! n (+ n 1))
k))))
(else
x))))
(define-syntax <run>
(syntax-rules (*)
((_ (v) code ...)
......@@ -54,7 +74,7 @@
(gp-unwind fr)
(reverse ret))
(lambda (p)
(set! ret (cons (u-scm v) ret))
(set! ret (cons (tr (u-scm v)) ret))
(u-abort p)))))
((_ (v ...) code ...)
......@@ -67,7 +87,7 @@
(gp-unwind fr)
(reverse r)))
(lambda (p)
(set! ret (cons (u-scm (list v ...)) ret))
(set! ret (cons (tr (u-scm (list v ...))) ret))
(u-abort p)))))
......@@ -93,7 +113,7 @@
(u-abort p))))
r)
(begin
(set! ret (cons (u-scm v) ret))
(set! ret (cons (tr (u-scm v)) ret))
(set! n (- n 1))
(if (= n 0)
(let ((r (reverse ret)))
......@@ -117,7 +137,7 @@
(lambda (p)
(if (> n 0)
(begin
(set! ret (cons (u-scm (list v ...)) ret))
(set! ret (cons (tr (u-scm (list v ...))) ret))
(set! n (- n 1))
(if (= n 0)
(let ((r (reverse ret)))
......@@ -191,6 +211,7 @@
(define-guile-log <or>
(syntax-rules ()
((_ meta ) (parse<> meta <fail>))
((_ meta e1) (parse<> meta e1))
((_ meta e1 es ...)
(mk-syms 2 (es ...) () (%semi-turn% meta (e1 es ...) ())))))
......@@ -746,3 +767,18 @@
(gp-restore-state (cdr state))
(gp-swap-to-a)
(if #f #f))
(define-guile-log <lv*>
(syntax-rules ()
((_ meta (((v ...) (f ...)) c ...) code ...)
(parse<> meta
(<and> (f ... v ...)
(<lv*> (c ...) code ...))))
((_ meta () code ...)
(parse<> meta (<and> code ...)))))
(define (<clear>)
(gp-swap-to-b)
(gp-clear)
(gp-swap-to-a)
(gp-clear))
......@@ -3,16 +3,21 @@
#define gp_redo_tag 2
#define gp_save_tag 6
#define gp_unbd SCM_PACK(GP_MK_FRAME_UNBD(gp_type))
//#define DB(X)
//#define DB(X) X
static inline SCM gp_handle(SCM item, int ret)
{
SCM x = SCM_BOOL_F,q,a,b,*id;
gp_debug0("handle\n");
if(SCM_CONSP(item))
{
gp_debug0("CONSP item\n");
if(GP(SCM_CAR(item)))
{
gp_debug0("GP car\n");
id = GP_GETREF(SCM_CAR(item));
q = SCM_CDR(item);
......@@ -26,8 +31,11 @@ static inline SCM gp_handle(SCM item, int ret)
}
id[0] = SCM_PACK(SCM_I_INUM(a));
id[1] = b;
return item;
}
gp_debug0("non GP car\n");
scm_call_0(SCM_CDR(item));
return item;
}
......@@ -48,6 +56,8 @@ static inline int gp_advanced(SCM item, int state, SCM *old)
SCM redo;
scm_t_bits tag = SCM_UNPACK(SCM_CAR(item));
gp_debug1("inum => advanced tag = %x\n", tag);
switch(tag)
{
case gp_save_tag:
......@@ -88,11 +98,15 @@ static inline int gp_do_cons(SCM item, int state, SCM *old)
{
SCM q,a,b,*id,tag = SCM_CAR(item);
gp_debug0("do_cons\n");
if(SCM_I_INUMP(tag))
return gp_advanced(item,state,old);
gp_debug0("not inum tag\n");
if(!GP(tag))
{
gp_debug0("not a GP tag\n");
if(state)
switch(state)
{
......@@ -110,6 +124,7 @@ static inline int gp_do_cons(SCM item, int state, SCM *old)
return state;
}
gp_debug0("a GP tag\n");
id = GP_GETREF(tag);
q = SCM_CDR(item);
a = SCM_CAR(q);
......@@ -310,8 +325,9 @@ static inline SCM gp_store_state()
data = gp_ci[-1];
head = SCM_EOL;
if(SCM_CONSP(data) && SCM_I_INUM(SCM_CAR(data)))
if(SCM_CONSP(data) && SCM_I_INUMP(SCM_CAR(data)))
{
gp_debug1("store state, got tag %x\n",SCM_UNPACK(SCM_CAR(data)));
switch(SCM_UNPACK(SCM_CAR(data)))
{
case gp_save_tag:
......@@ -320,11 +336,6 @@ static inline SCM gp_store_state()
case gp_redo_tag:
head = SCM_CADR(data);
break;
default:
{
head = scm_cons(SCM_PACK(gp_save_tag),data);
gp_ci[-1] = head;
}
}
}
else
......@@ -346,7 +357,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 0, 0, 0, (),
}
#undef FUNC_NAME
//#define DB(X)
//#define DB(X) X
static inline SCM * gp_get_branch(SCM *p, SCM *ci)
{
......@@ -592,4 +603,4 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 1, 0, 0, (SCM cont),
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
#define DB(X)
//#define DB(X)
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