once_i and similar constructs debugged

parent e1c38965
......@@ -4,7 +4,6 @@
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log dynlist)
#:use-module (logic guile-log indexer)
#:use-module (logic guile-log iinterleave)
#:use-module (srfi srfi-60)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
......@@ -36,6 +35,7 @@
make_dynamic make_generic_dynamic
make-functional-dynamic-db))
(define or-ii-f 'not-define-or-ii-f)
(define tags (get-index-tags))
(define and-tag (list-ref tags 0))
(define or-tag (cons 'or 'tag))
......
......@@ -574,14 +574,14 @@ Our version of once, this works beutifully
(<define> (once-ii-machine x)
(<let*> ((mac.wind (get-machine-wind))
(mac (car mac.wind))
(level (+ (max S 'level) 1))
(depth (+ (mac S 'depth) 1))
(cc (lambda (s p)
(mac s 'pack level)
(mac s 'pack depth)
(mac s 'remove-level)
(CC s p)))
(f (lambda (x)
(f (lambda (bla)
(lambda ()
(x S P cc)))))
((<lookup> x) S P cc)))))
(<code> (mac S 'prepend (list f)))
(<ret> ((mac S 'dive)))))
......@@ -595,4 +595,5 @@ Our version of once, this works beutifully
(<define-guile-log-rule> (<once-ii> x) (once-ii (<lambda> () x)))
(set! (@@ (logic guile-log tools) new-machine) new-machine)
(set! (@@ (logic guile-log tools) new-machine) new-machine)
(set! (@@ (logic guile-log functional-database) or-ii-f) or-ii-f)
......@@ -105,7 +105,7 @@
make_generic_hash_dynamic
make_dynamic
make_generic_dynamic
add_sym
add_sym once_i
;;Swi global variables
b_setval b_getval nb_setval nb_getval nb_current
......
......@@ -44,7 +44,7 @@
var atomic compound nonvar
directive
procedure_name
once *once* once-f
once once_i *once* once-f
-var -atom
halt
......@@ -1132,6 +1132,15 @@ floor(x) (floor x)
(<code> (gp-var-set *call-expression* v S))
(goal-eval v)
(<with-fail> p <cc>)))))
(<define> (once_i v)
(<let> ((v (<lookup> v)))
(if (<var?> v)
(instantiation_error)
(<let> ((p P))
(<code> (gp-var-set *call-expression* v S))
(<once-ii> (goal-eval v))
(<with-fail> p <cc>)))))
(<define-guile-log-rule> (once-mac v) (once-f v))
(mk-prolog-term-1 tr-once once once-mac a)
......
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