swi engines now store and restore state even better

parent dd97a5b0
......@@ -16,13 +16,11 @@
engine_fetch
is_engine
engine_self
current_engine))
current_engine
stub))
(<define> (engine_yield term) (<ret> (list #:yield S P CC term)))
(<define> (stub-scm goal box engine)
(goal box engine))
(define postbox (make-fluid #f))
(<wrap> add-fluid-dynamics postbox)
(define (<postbox-ref>) (fluid-ref postbox))
......@@ -33,8 +31,10 @@
(define (generate-engine s size name goal)
(let ((engine (gp-make-engine size)))
(letrec ((state #f)
(first #t)
(guards #f)
(path #f)
(inhibit #f)
(path (cons (list (cons s engine)) '()))
(postbox (make-variable #f))
(on-result
(lambda ()
......@@ -50,13 +50,6 @@
(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
......@@ -77,10 +70,13 @@
(g #f))
(dynamic-wind
(lambda ()
(set! inhibit #t)
(set! g (gp-store-engine-guards))
(if path
(if (not first)
(begin
(set! first #f)
(set! pth
(gp-set-engine path))
(gp-set-engine path)))
(let ((s2.p (gp-new-engine engine)))
(set! s2 (car s2.p))
(set! pth (cdr s2.p))))
......@@ -89,14 +85,13 @@
(lambda ()
(set! state
(stub-scm
(goal
s2
(lambda ()
(set! engine #f)
#:exit)
(lambda (s p x)
(list #:finish s p))
goal
postbox
(lambda () ret)))
(on-result))
......@@ -104,7 +99,8 @@
(lambda ()
(set! guards (gp-store-engine-guards))
(set! path (gp-set-engine pth))
(gp-restore-engine-guards g)))))
(gp-restore-engine-guards g)
(set! inhibit #f)))))
#:exit)))
(next
......@@ -113,6 +109,7 @@
(g #f))
(dynamic-wind
(lambda ()
(set! inhibit #t)
(set! g (gp-store-engine-guards))
(set! pth (gp-set-engine path))
(gp-restore-engine-guards guards))
......@@ -126,9 +123,7 @@
((#:throw e)
state)
((#:stalled thunk cc)
(thunk)
(<state-set!> (car cc))
((#:stalled cc)
(set! state (continue (cdr cc)))
(on-result))
......@@ -146,24 +141,33 @@
(lambda ()
(set! guards (gp-store-engine-guards))
(set! path (gp-set-engine pth))
(gp-restore-engine-guards g))))))
(gp-restore-engine-guards g)
(set! inhibit #f))))))
(ret
(case-lambda
(()
(when (not inhibit)
(let* ((pth (gp-set-engine path))
(s (<state-ref>)))
(gp-set-engine pth)
(list s state path guards engine (variable-ref postbox))))
(list first start-f
s state path guards engine (variable-ref postbox)))))
((l)
(when (not inhibit)
(match l
((s state_ path_ guards_ engine_ post_)
(set! state s)
((first_ start-f_ s state_ path_ guards_ engine_ post_)
(set! start-f start-f_)
(set! first first_)
(set! state state_)
(set! path path_)
(set! guards guards_)
(set! engine engine_)
(variable-set! postbox post_)
(<state-set> s))))
(let ((pth (gp-set-engine path)))
(<state-set!> s)
(gp-set-engine pth))))))
((kind s . term)
(match kind
......@@ -182,6 +186,7 @@
(#:exit #f)
(_ #t)))))))))
(<wrap> add-parameter-dynamics ret)
(set-procedure-property! ret 'engine #t)
(set-procedure-property!
ret 'name (string->symbol (format #f "e<~a>" (name-it name))))
......@@ -210,15 +215,14 @@
((#:yield s p cc x)
(<=> x term))
((#:stalled _ _)
((#:stalled _)
(<and>
(nl)
(write "stalled engine > ")
(write engine)
(nl)
(let ((state res))
(stall)
(<code> (engine #:set-state state))
(lp (engine #:run S)))))
(lp (engine #:run S))))
(x (<ret> x))))))
......@@ -241,7 +245,7 @@
((#:yield s p cc x)
(<=> ,(vector (list "the" x)) term))
((#:stalled _ _)
((#:stalled _)
(<and>
(write "stalled engine > ")
(write engine)
......@@ -280,14 +284,19 @@
(<define> (create-engine-scm t g name size engine)
(let ((e (generate-engine S (<lookup> size) (<lookup> name)
(<lambda> (a b)
(stub t g a b)))))
(mk t g))))
(<=> engine e)))
(<define> (ret_e e) (<ret> (list #:throw e)))
(<define> (ret_g t) (<ret> (list #:finish S P t)))
(define mod (current-module))
(define (mk t g)
(lambda (s p cc a b)
(stub s p cc t g a b)))
(compile-prolog-string "
g(Term,Goal,A,B) :-
......
......@@ -1675,8 +1675,13 @@ SCM_DEFINE(gp_set_engine, "gp-set-engine", 1, 0, 0, (SCM paths),
SCM e = SCM_CDR(SCM_CAR(SCM_CAR(paths)));
SCM pathout = gp_paths;
if(SCM_CONSP(paths))
{
gp_engine_path = SCM_CAR(paths);
gp_store_path = SCM_CDR(paths);
}
else
scm_misc_error("gp-set-engine","paths not a cons ~a",scm_list_1(paths));
gp_paths = paths;
......
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