added beginning stubs to persist state

parent 751c560a
......@@ -9,6 +9,8 @@
#:use-module (logic guile-log guile-prolog fluid)
#:use-module (logic guile-log guile-prolog attribute)
#:use-module (logic guile-log vlist)
#:use-module (logic guile-log persistance)
#:use-module (logic guile-log prolog persist)
#:use-module (logic guile-log iinterleave)
#:use-module (ice-9 match)
#:use-module (ice-9 readline)
......@@ -34,13 +36,13 @@
#:export (prolog-shell conversation leave read-prolog user_ref user_set
stall thin_stall))
(define -all- (make-fluid false))
(define-named-object -all- (make-fluid false))
(<wrap> add-fluid-dynamics -all-)
(define *once* (gp-make-var #f))
(define -nsol- (make-fluid #f))
(define -mute?- (make-fluid #f))
(define -rec?- (make-fluid #f))
(define -nonrec?- (make-fluid #f))
(define-named-object *once* (gp-make-var #f))
(define-named-object -nsol- (make-fluid #f))
(define-named-object -mute?- (make-fluid #f))
(define-named-object -rec?- (make-fluid #f))
(define-named-object -nonrec?- (make-fluid #f))
(<wrap> add-fluid-dynamics -mute?-)
(define *user-data* (make-fluid vlist-null))
(<wrap> add-vhash-dynamics *user-data*)
......@@ -94,7 +96,7 @@
(define -n- (@ (logic guile-log guile-prolog readline)
-n-))
(define lold #f)
(define *usr-state* (make-fluid #f))
(define-named-object *usr-state* (make-fluid #f))
(define (tosym x)
(cond
......@@ -127,7 +129,7 @@
(<define> (thin_stall)
(<stall>))
(define env (make-fluid '()))
(define-named-object env (make-fluid '()))
(<define> (add_env n x)
(fluid-guard-dynamic-object env)
(<code> (let lp ((r (fluid-ref env)) (n (<scm> n)) (x (<scm> x)))
......@@ -150,6 +152,7 @@
(define *states* (make-hash-table))
(define *persister* (make-persister))
(define (read-prolog port env)
(define nn? #f)
......@@ -166,6 +169,7 @@
(define clear #f)
(define endl #f)
(define profile #f)
(define newp #f)
(let*
((l (with-input-from-port port
(lambda ()
......@@ -192,6 +196,22 @@
(case action
((profile pr)
(set! profile #t))
((newp)
(set! *persister* (make-persister))
(set! old #t))
((setp)
(persist-state *persister* ((@ (guile) read)))
(set! old #t))
((savep)
(save-persists *persister*)
(set! old #t))
((loadp)
(load-persists *persister*)
(set! old #t))
((refp)
(persist-restate *persister*
(((@ (guile) read))))
(set! old #t))
((rec) (begin
(fluid-set! -rec?- #t)
(fluid-set! -nonrec?- #f)))
......
......@@ -10,7 +10,7 @@
save-persists
persist-set!
persist-ref
test))
define-named-object))
(define (default-print-func struct port)
(format port "<pre-struct>"))
......@@ -555,7 +555,8 @@
(log 'set-vector i l)))))
(define (make-a-procedure)
(let* ((free (program-free-variables x))
(let* ((prim? (primitive? x))
(free (if prim? '() (program-free-variables x)))
(nfree (length free))
(i (mk-name 'make-procedure x nfree)))
(do-if-deep x i
......@@ -615,12 +616,9 @@
(else
(mk make-atom))))
(define test
(let ((i 0))
(lambda ()
(pk i)
(set! i (+ i 1)))))
;(set-procedure-property! test 'shallow #t)
(set-procedure-property! test 'name 'test)
(set-procedure-property! test 'module '(logic guile-log persistance))
(define-syntax-rule (define-named-object f x)
(define f
(let ((y x))
(set-object-property! y 'name 'f)
(set-object-property! y 'module (module-name (current-module)))
y)))
......@@ -2,7 +2,9 @@
#:use-module (logic guile-log)
#:use-module (logic guile-log persistance)
#:export (new_persister persist_ref persist_set
load_persists save_persists))
load_persists save_persists
persist-state
persist-restate))
(<define*> (new_persister ret #:key (file "persist.scm"))
......@@ -29,3 +31,12 @@
(<define> (save_persists p)
(<code> (save-persists (<lookup> p))))
(define (persist-state per key)
(let ((state (<state-ref>)))
(<clear>)
(persist-set! per key state)
(<state-set!> state)))
(define (persist-restate per key)
(<state-set!> (persist-ref per key)))
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