Initial tests of user variables, bugfixings of dynamic features I

parent 6661b973
......@@ -183,7 +183,7 @@ used it is then a safe journey.
(()
(let ((ret (ref h)))
(when (and tr? (not (eq? e ret)))
(++ h))
(++ ret))
ret))
((x)
......@@ -191,7 +191,7 @@ used it is then a safe journey.
h
(begin
(aset h x)
(when (not (eq? x e)) (tr h))
(when (not (eq? x e)) (tr x))
(if #f #f)))))))
(set api (if tr? itr ibt) bt)
bt))))
......@@ -363,10 +363,11 @@ before. This works very much like a fluid
(gp-fluid-set bt e)
(code s p
(lambda (s p)
(when (not (eq? e (ref h)))
(++ h))
(gp-fluid-set bt e)
(cc s p)))))))
(let ((d (ref h)))
(when (not (eq? e d))
(++ d))
(gp-fluid-set bt e)
(cc s p))))))))
(define* (with-fluid-guard-dynamic-object-once
s p cc h code
......@@ -376,7 +377,6 @@ before. This works very much like a fluid
(fail s p cc h)
(let* ((ref (get api iref))
(e (ref h))
(++ (get api i++))
(bt (mk api e h ref (dobt))))
(gp-fluid-set bt e)
(code s p
......@@ -468,19 +468,21 @@ before. This works very much like a fluid
(define* (copy-dynamic-object
s p cc x y #:key (name #f) (fail (dfail 'copy)))
(let ((api (get-dynamic-api x)))
(if (not api)
(fail s p cc x)
(let* ((++ (get api i++))
(mk (get api imk))
(ref (get api iref))
(h (if name
(mk (ref x) #:name name)
(mk (ref x)))))
((<lambda> ()
(<=> y h)
(<code> (++ x)))
s p cc)))))
(let ((x (gp-lookup x s))
(y (gp-lookup y s)))
(let ((api (get-dynamic-api x)))
(if (not api)
(fail s p cc x)
(let* ((++ (get api i++))
(mk (get api imk))
(ref (get api iref))
(h (if name
(mk (ref x) #:name name)
(mk (ref x)))))
((<lambda> ()
(<=> y h)
(<code> (++ (ref x))))
s p cc))))))
(<define> (failsetxy s p cc x y tx ty)
(error (format #f "not similar objects (set ~a:~a ~a:~a)"
......@@ -488,22 +490,24 @@ before. This works very much like a fluid
(define* (set-dynamic
s p cc x y #:key (fail (dfail 'set)) (failxy failsetxy))
(let ((api-x (get-dynamic-api x)))
(if (not api-x)
(fail s p cc x)
(let ((api-y (get-dynamic-api y)))
(if (not api-y)
(fail s p cc y)
(let ((tag-x (get api-x itag))
(tag-y (get api-y itag)))
(if (eq? tag-x tag-y)
(let ((set (get api-x iset))
(ref (get api-y iref))
(++ (get api-y i++)))
(set x (ref y))
(++ y)
(cc s p))
(failxy s p cc x y tag-x tag-y))))))))
(let ((x (gp-lookup x s))
(y (gp-lookup y s)))
(let ((api-x (get-dynamic-api x)))
(if (not api-x)
(fail s p cc x)
(let ((api-y (get-dynamic-api y)))
(if (not api-y)
(fail s p cc y)
(let ((tag-x (get api-x itag))
(tag-y (get api-y itag)))
(if (eq? tag-x tag-y)
(let ((set (get api-x iset))
(ref (get api-y iref))
(++ (get api-y i++)))
(set x (ref y))
(++ (ref y))
(cc s p))
(failxy s p cc x y tag-x tag-y)))))))))
;; Use this to debug vhash behavior
(define (analyze pred x)
......
(define-module (logic guile-log guile-prolog interpreter)
#:use-module ((logic guile-log) #:select
(<clear> <define> <let> <let*> <=> <lookup> <match> <fail>
<cut> <wrap> <state-ref> <state-set!> <continue>))
<cut> <wrap> <state-ref> <state-set!> <continue>
<code> <scm>))
#:use-module (logic guile-log guile-prolog hash)
#:use-module (logic guile-log guile-prolog fluid)
#:use-module (logic guile-log vlist)
#:use-module (ice-9 match)
#:use-module (ice-9 readline)
#:use-module (ice-9 rdelim)
......@@ -14,10 +16,24 @@
#:use-module (logic guile-log dynamic-features)
#:use-module (logic guile-log guile-prolog dynamic-features)
#:export (prolog-shell conversation leave read-prolog))
#:export (prolog-shell conversation leave read-prolog user_ref user_set))
(define -all- (make-fluid false))
(<wrap> add-fluid-dynamics -all-)
(define *user-data* (make-fluid vlist-null))
(<wrap> add-vhash-dynamics *user-data*)
(<define> (user_set a v)
(<code> (fluid-set! *user-data* (vhash-cons (<lookup> a)
(<scm> v)
(fluid-ref *user-data*)))))
(<define> (user_ret a v)
(<=> (_ . v) ,(vhash-assoc (<lookup> a) (fluid-ref *user-data*))))
(define (usr-ref x)
(cdr (vhash-assoc x (fluid-ref *user-data*))))
(define (usr-set! x v)
(fluid-set! *user-data* (vhash-cons x v (fluid-ref *user-data*))))
(define conversation1 #t)
(define conversation2 #t)
(define loop #f)
......@@ -63,6 +79,8 @@
(define save #f)
(define load #f)
(define cont #f)
(define ref #f)
(define set #f)
(let* ((l
(with-input-from-port port
(lambda ()
......@@ -90,12 +108,15 @@
((s save) (set! save ((@ (guile) read))))
((l load) (set! load ((@ (guile) read))))
((c cont) (set! cont #t))
((ref) (set! ref ((@ (guile) read))))
((set) (set! set (list ((@ (guile) read))
((@ (guile) read)))))
(else
(set! fail? #t))))
(cond
((or fail? help?)
#f)
((or load save cont)
((or load save cont ref set)
#t)
(else
(lp #t (peek-char) '()))))
......@@ -119,6 +140,14 @@
(lp #f (peek-char) (cons ch r)))))))))
(cond
(ref
`((@@ (logic guile-log guile-prolog interpreter) usr-ref) ,ref))
(set
`((@ (guile) begin)
((@@ (logic guile-log guile-prolog interpreter) usr-set!) ,@set)
((@ (guile) if) #f #f)))
(load
`((@ (guile) begin)
((@ (logic guile-log) <state-set!>)
......@@ -146,13 +175,19 @@
(help?
(format #t "
HELP FOR PROLOG COMMANDS
(.n ) try to find n solutions
(.all | .*) try to find all solutions
(.once | .1) try to find one solution
(.mute | .m) no value output is written.
(.save | .s) <ref> associate current state with ref
(.load | .l) <ref> restore associate state with ref
(.cont | .c) continue the execution from last stall point
---------------------------------------------------------------------
(.n ) try to find n solutions
(.all | .*) try to find all solutions
(.once | .1) try to find one solution
(.mute | .m) no value output is written.
---------------------------------------------------------------------
(.save | .s) <ref> associate current state with ref
(.load | .l) <ref> restore associate state with ref
(.cont | .c) continue the execution from last stall point
---------------------------------------------------------------------
(.ref ) <ref> get value of reference variable ref
(.set ) <ref> <val> set user variable ref to value val
---------------------------------------------------------------------
")
'(if #f #f))
......@@ -234,7 +269,8 @@ conversation_ :-
conversation1(X,All,Mute) :-
fluid_guard_dynamic_object(scm[-n-], scm[-nsol-], scm[-all-]),
state_guard_dynamic_object(scm[-n-], scm[-nsol-], scm[-all-]),
state_guard_dynamic_object(scm[-n-], scm[-nsol-], scm[-all-],
scm[*user-data*]),
conversation2(X,All,Mute).
conversation2(X,All,Mute) :-
......
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