dynamic features refinements

parent b8788986
......@@ -15,6 +15,9 @@
add-dynamic-function-dynamics
add-dynamic-barrier
mk-combine-dynamics
;; this can combine many dynamics into one dynamic
;; to enable a dynamic object feature from this point and up the
;; stack (h #:optional fail)
backtrack-dynamic-object
......@@ -110,6 +113,33 @@ used it is then a safe journey.
(error (format #t "~a-dynamics association failed on element ~a" str h))))
(define nop (lambda (x) (if #f #f)))
(define* (mk-combine-dynamics s p cc . l)
(let ((data (map (lambda (h) (hash-ref *dynamic-trackers* h))
l)))
(add-dynamic-object-features s p cc data
(lambda (x) #t)
(map (lambda (d) (vector-ref d 0)) data)
(lambda (l)
(map (lambda (d x) ((vector-ref d 1) x))
data l))
(lambda (h v)
(map (lambda (d h v)
((vector-ref d 2) h v))
data h v))
(lambda (h)
(for-each
(lambda (d h) ((vector-ref d 3) h))
data h))
(lambda (h)
(for-each
(lambda (d h) ((vector-ref d 4) h))
data h))
(lambda (vs)
(map (lambda (d v)
((vector-ref d 5) v))
data vs)))
l))
(define* (add-fluid-dynamics s p cc h #:optional (fail (mkf 'fluid)))
(add-dynamic-object-features s p cc h
dynamic-fluid?
......
(define-module (logic guile-log prolog namespace)
#:use-module (logic guile-log code-load)
#:use-module ((logic guile-log)
#:select (<define> <lookup> <scm> <=> <code>))
#:select (<define> <lookup> <scm> <=> <code> <wrap>))
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log prolog closed)
#:use-module (logic guile-log prolog names)
......@@ -84,6 +84,8 @@ Two things will happen
(define fail-when-new-namespace? (make-fluid #f))
(<wrap> add-fluid-dynamics fail-when-new-namespace?)
(<define> (error_on_namespace_switch)
(<code> (fluid-set! fail-when-new-namespace? 'error)))
(<define> (fail_on_namespace_switch)
......@@ -94,6 +96,8 @@ Two things will happen
(<=> x ,fail-when-new-namespace?))
(define white-list-namespaces (make-fluid #f))
(<wrap> add-fluid-dynamics white-list-namespaces)
(<define> (namespace_white_list_handle H)
(<=> H white-list-namespaces))
(<define> (set_no_namespace_whitelist)
......
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