a few ideoms now compiles

parent ac89febe
......@@ -10,7 +10,8 @@
#:use-module (logic guile-log dynamic-features)
#:use-module (logic guile-log prolog goal-transformers)
#:use-module (logic guile-log)
#:export (make_vhash vhash vhashp vhash_ref vhashq_ref vhash_cons vhashq_cons
#:export (make_vhash vhash vhashp vhash_ref vhashq_ref vhashql_ref
vhash_cons vhashq_cons vhashql_cons
peek_vhash vhash_to_assoc))
(mk-sym vhash)
......@@ -73,6 +74,19 @@ it's old datastructure.
(when val
(<=> ,val (_ . ret))))))))
(<define> (vhashql_ref h k ret)
(<let> ((h (<lookup> h))
(k (<lookup> k)))
(cond
((<var?> h)
(instantiation_error))
((not (<vhash?> h))
(type_error vhash h))
(else
(<let> ((val (vhash-assoc k (fluid-ref h))))
(when val
(<=> ,val (_ . ret))))))))
(<define> (vhash_cons h k v)
(<let*> ((h (<lookup> h))
(k.v (canon-it (cons k v) S))
......@@ -86,6 +100,7 @@ it's old datastructure.
(else
(<code> (fluid-set! h (vhash-cons k v (fluid-ref h))))))))
(<define> (vhashq_cons h k v)
(<let*> ((h (<lookup> h))
(k (<lookup> k)))
......@@ -98,6 +113,18 @@ it's old datastructure.
(<code> (fluid-set! h (vhash-consq k
(<lookup> v) (fluid-ref h))))))))
(<define> (vhashql_cons h k v)
(<let*> ((h (<lookup> h))
(k (<lookup> k)))
(cond
((<var?> h)
(instantiation_error))
((not (<vhash?> h))
(type_error vhash h))
(else
(<code> (fluid-set! h (vhash-cons k
(<lookup> v) (fluid-ref h))))))))
(<define> (peek_vhash h)
(<code> (analyze (fluid-ref (<lookup> h)))))
......
This diff is collapsed.
......@@ -628,7 +628,7 @@ For tabling, negations are tricky. the reason is that when a recursive applicati
#'(<let> meta . l))
((_ meta (let* . l))
#'(<let> meta . l))
#'(<let*> meta . l))
((_ meta (if p . l) )
#'(<scm-if> meta p . l))
......
......@@ -146,7 +146,6 @@
(cons (<lookup> x)
(fluid-ref *goal-expansions*)))))
(define-parser-directive-onfkn add_goal_expansion (goal-spc stx l N M)
(match l
((#:atom nm . _)
......
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