First steps toward correct facet-termination.
- Facet IDs are now lists so arbitrary ancestors can be computed with repeated application of cdr - `stop-facet` is new and untested, other than that `stop-when` is refactored to use `stop-facet` - *all* matching stop-when instances run now; the limitation that exactly one instance should match is lifted. - roughly, (stop-when E X ...) === (on E (stop (current-facet-id) X ...)) Remaining to be done: fix `terminate-facet!` to do the right things in the right order.
This commit is contained in:
parent
1fdd62d56d
commit
ac5c5d2e5f
|
@ -9,9 +9,11 @@
|
||||||
until
|
until
|
||||||
forever
|
forever
|
||||||
|
|
||||||
|
current-facet-id
|
||||||
field
|
field
|
||||||
field/c
|
field/c
|
||||||
assert
|
assert
|
||||||
|
stop-facet
|
||||||
stop-when
|
stop-when
|
||||||
on-start
|
on-start
|
||||||
on-stop
|
on-stop
|
||||||
|
@ -96,7 +98,10 @@
|
||||||
;; A FieldTable is a WEAK hash table: (FieldDescriptor |-> Any)
|
;; A FieldTable is a WEAK hash table: (FieldDescriptor |-> Any)
|
||||||
|
|
||||||
;; (field-descriptor Symbol UniqueNatural)
|
;; (field-descriptor Symbol UniqueNatural)
|
||||||
(struct field-descriptor (name id))
|
(struct field-descriptor (name id)
|
||||||
|
#:methods gen:custom-write
|
||||||
|
[(define (write-proc d p mode)
|
||||||
|
(fprintf p "#<field-descriptor:~a>" (field-descriptor-name d)))])
|
||||||
|
|
||||||
;; (field-handle FieldDescriptor)
|
;; (field-handle FieldDescriptor)
|
||||||
(struct field-handle (desc)
|
(struct field-handle (desc)
|
||||||
|
@ -165,6 +170,11 @@
|
||||||
f
|
f
|
||||||
'(expected: "a field"))]))))))
|
'(expected: "a field"))]))))))
|
||||||
|
|
||||||
|
;; A FID is a (Listof UniqueNatural).
|
||||||
|
;;
|
||||||
|
;; The (unique) ID of the specific facet is the car; the parent's
|
||||||
|
;; unique ID is the cadr; and so on.
|
||||||
|
|
||||||
(struct actor-state (mux ;; Mux
|
(struct actor-state (mux ;; Mux
|
||||||
facets ;; (Hash FID Facet)
|
facets ;; (Hash FID Facet)
|
||||||
previous-knowledge ;; AssertionSet
|
previous-knowledge ;; AssertionSet
|
||||||
|
@ -177,10 +187,10 @@
|
||||||
[(define (syndicate-pretty-print a [p (current-output-port)])
|
[(define (syndicate-pretty-print a [p (current-output-port)])
|
||||||
(pretty-print-actor-state a p))])
|
(pretty-print-actor-state a p))])
|
||||||
|
|
||||||
(struct facet (endpoints ;; (Hash EID Endpoint)
|
(struct facet (id ;; FID; this includes parent IDs etc
|
||||||
|
endpoints ;; (Hash EID Endpoint)
|
||||||
stop-scripts ;; (Listof Script) -- IN REVERSE ORDER
|
stop-scripts ;; (Listof Script) -- IN REVERSE ORDER
|
||||||
children ;; (Setof FID)
|
children ;; (Setof FID)
|
||||||
parent ;; (Option FID)
|
|
||||||
) #:prefab)
|
) #:prefab)
|
||||||
|
|
||||||
(struct endpoint (id patch-fn handler-fn) #:prefab)
|
(struct endpoint (id patch-fn handler-fn) #:prefab)
|
||||||
|
@ -224,7 +234,7 @@
|
||||||
(define current-actor-state (make-store))
|
(define current-actor-state (make-store))
|
||||||
|
|
||||||
;; Parameterof FID
|
;; Parameterof FID
|
||||||
(define current-facet-id (make-parameter #f))
|
(define current-facet-id (make-parameter '()))
|
||||||
|
|
||||||
;; Storeof Patch
|
;; Storeof Patch
|
||||||
(define current-pending-patch (make-store))
|
(define current-pending-patch (make-store))
|
||||||
|
@ -363,7 +373,7 @@
|
||||||
[(_ [id:id init maybe-contract ...] ...)
|
[(_ [id:id init maybe-contract ...] ...)
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(begin
|
(begin
|
||||||
(when (and (in-script?) (current-facet-id))
|
(when (and (in-script?) (pair? (current-facet-id)))
|
||||||
(error 'field
|
(error 'field
|
||||||
"~a: Cannot declare fields in a script; are you missing a (react ...)?"
|
"~a: Cannot declare fields in a script; are you missing a (react ...)?"
|
||||||
#,(source-location->string stx)))
|
#,(source-location->string stx)))
|
||||||
|
@ -384,21 +394,36 @@
|
||||||
patch-stx)))
|
patch-stx)))
|
||||||
void))]))
|
void))]))
|
||||||
|
|
||||||
|
(define (fid-ancestor? fid maybe-ancestor)
|
||||||
|
(and (pair? fid) ;; empty fid lists obviously no ancestors at all!
|
||||||
|
(or (equal? fid maybe-ancestor)
|
||||||
|
(fid-ancestor? (cdr fid) maybe-ancestor))))
|
||||||
|
|
||||||
|
(define-syntax (stop-facet stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_ fid-expr script ...)
|
||||||
|
(quasisyntax/loc stx
|
||||||
|
(let ((fid fid-expr))
|
||||||
|
(when (not (fid-ancestor? (current-facet-id) fid))
|
||||||
|
(error 'stop-facet "Attempt to stop non-ancestor facet ~a" fid))
|
||||||
|
(terminate-facet! fid)
|
||||||
|
(parameterize ((current-facet-id (cdr fid))) ;; run in parent context wrt terminating facet
|
||||||
|
(schedule-script! (lambda () (begin/void-default script ...))))))]))
|
||||||
|
|
||||||
(define-syntax (stop-when stx)
|
(define-syntax (stop-when stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ w:when-pred E prio:priority script ...)
|
[(_ w:when-pred E prio:priority script ...)
|
||||||
(analyze-event stx
|
(analyze-event stx
|
||||||
#'w.Pred
|
#'w.Pred
|
||||||
#'E
|
#'E
|
||||||
#t
|
(syntax/loc stx (stop-facet (current-facet-id) script ...))
|
||||||
(syntax/loc stx (begin/void-default script ...))
|
|
||||||
#'prio.level)]))
|
#'prio.level)]))
|
||||||
|
|
||||||
(define-syntax (on-start stx)
|
(define-syntax (on-start stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ script ...)
|
[(_ script ...)
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(schedule-script! #f (lambda () (begin/void-default script ...))))]))
|
(schedule-script! (lambda () (begin/void-default script ...))))]))
|
||||||
|
|
||||||
(define-syntax (on-stop stx)
|
(define-syntax (on-stop stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
@ -420,7 +445,7 @@
|
||||||
(add-endpoint! where
|
(add-endpoint! where
|
||||||
(lambda () patch-empty)
|
(lambda () patch-empty)
|
||||||
(lambda (e _current-interests _synthetic?)
|
(lambda (e _current-interests _synthetic?)
|
||||||
(schedule-script! #:priority priority #f (lambda () (proc e))))))
|
(schedule-script! #:priority priority (lambda () (proc e))))))
|
||||||
|
|
||||||
(define-syntax (on stx)
|
(define-syntax (on stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
@ -428,7 +453,6 @@
|
||||||
(analyze-event stx
|
(analyze-event stx
|
||||||
#'w.Pred
|
#'w.Pred
|
||||||
#'E
|
#'E
|
||||||
#f
|
|
||||||
(syntax/loc stx (begin/void-default script ...))
|
(syntax/loc stx (begin/void-default script ...))
|
||||||
#'prio.level)]))
|
#'prio.level)]))
|
||||||
|
|
||||||
|
@ -493,7 +517,6 @@
|
||||||
(define subject-id (current-dataflow-subject-id))
|
(define subject-id (current-dataflow-subject-id))
|
||||||
(schedule-script!
|
(schedule-script!
|
||||||
#:priority prio.level
|
#:priority prio.level
|
||||||
#f
|
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(parameterize ((current-dataflow-subject-id subject-id))
|
(parameterize ((current-dataflow-subject-id subject-id))
|
||||||
expr ...)))
|
expr ...)))
|
||||||
|
@ -545,7 +568,6 @@
|
||||||
(if maybe-expr-stx
|
(if maybe-expr-stx
|
||||||
(quasisyntax/loc maybe-expr-stx
|
(quasisyntax/loc maybe-expr-stx
|
||||||
((schedule-script! #:priority *query-handler-priority*
|
((schedule-script! #:priority *query-handler-priority*
|
||||||
#f
|
|
||||||
(lambda () #,maybe-expr-stx))))
|
(lambda () #,maybe-expr-stx))))
|
||||||
#'())))
|
#'())))
|
||||||
|
|
||||||
|
@ -699,7 +721,6 @@
|
||||||
(define-for-syntax (analyze-asserted/retracted outer-expr-stx
|
(define-for-syntax (analyze-asserted/retracted outer-expr-stx
|
||||||
when-pred-stx
|
when-pred-stx
|
||||||
event-stx
|
event-stx
|
||||||
terminal?
|
|
||||||
script-stx
|
script-stx
|
||||||
asserted?
|
asserted?
|
||||||
P-stx
|
P-stx
|
||||||
|
@ -729,29 +750,14 @@
|
||||||
"Wildcard interest discovered while projecting by ~v at ~a"
|
"Wildcard interest discovered while projecting by ~v at ~a"
|
||||||
proj
|
proj
|
||||||
#,(source-location->string P-stx)))
|
#,(source-location->string P-stx)))
|
||||||
#,(let ((entry-handler-stx
|
(for [(entry (in-set entry-set))]
|
||||||
(quasisyntax/loc script-stx
|
(let ((instantiated (instantiate-projection proj entry)))
|
||||||
(let ((instantiated (instantiate-projection proj entry)))
|
(and (#,change-detector-stx instantiated synthetic?)
|
||||||
(and (#,change-detector-stx instantiated synthetic?)
|
(schedule-script!
|
||||||
(schedule-script!
|
#:priority #,priority-stx
|
||||||
#:priority #,priority-stx
|
(lambda ()
|
||||||
#,(if terminal? #'#t #'#f)
|
(match-define (list #,@bindings) entry)
|
||||||
(lambda ()
|
#,script-stx)))))]))))))
|
||||||
(match-define (list #,@bindings) entry)
|
|
||||||
#,script-stx)))))))
|
|
||||||
(if terminal?
|
|
||||||
#`(let ((entry-count (set-count entry-set)))
|
|
||||||
(cond
|
|
||||||
[(zero? entry-count)]
|
|
||||||
[(= entry-count 1)
|
|
||||||
(let ((entry (set-first entry-set)))
|
|
||||||
#,entry-handler-stx)]
|
|
||||||
[else
|
|
||||||
(error 'asserted
|
|
||||||
"Multiple assertions triggered stop-when at ~a"
|
|
||||||
#,(source-location->string P-stx))]))
|
|
||||||
#`(for [(entry (in-set entry-set))]
|
|
||||||
#,entry-handler-stx)))]))))))
|
|
||||||
|
|
||||||
(define-for-syntax orig-insp
|
(define-for-syntax orig-insp
|
||||||
(variable-reference->module-declaration-inspector (#%variable-reference)))
|
(variable-reference->module-declaration-inspector (#%variable-reference)))
|
||||||
|
@ -759,7 +765,6 @@
|
||||||
(define-for-syntax (analyze-event outer-expr-stx
|
(define-for-syntax (analyze-event outer-expr-stx
|
||||||
when-pred-stx
|
when-pred-stx
|
||||||
armed-event-stx
|
armed-event-stx
|
||||||
terminal?
|
|
||||||
script-stx
|
script-stx
|
||||||
priority-stx)
|
priority-stx)
|
||||||
(define event-stx (syntax-disarm armed-event-stx orig-insp))
|
(define event-stx (syntax-disarm armed-event-stx orig-insp))
|
||||||
|
@ -773,7 +778,6 @@
|
||||||
(analyze-event outer-expr-stx
|
(analyze-event outer-expr-stx
|
||||||
when-pred-stx
|
when-pred-stx
|
||||||
(syntax-rearm result event-stx)
|
(syntax-rearm result event-stx)
|
||||||
terminal?
|
|
||||||
script-stx
|
script-stx
|
||||||
priority-stx)))]
|
priority-stx)))]
|
||||||
[(core:message P)
|
[(core:message P)
|
||||||
|
@ -795,15 +799,14 @@
|
||||||
(and capture-vals
|
(and capture-vals
|
||||||
(schedule-script!
|
(schedule-script!
|
||||||
#:priority #,priority-stx
|
#:priority #,priority-stx
|
||||||
#,(if terminal? #'#t #'#f)
|
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(apply (lambda #,bindings #,script-stx)
|
(apply (lambda #,bindings #,script-stx)
|
||||||
capture-vals))))])))))]
|
capture-vals))))])))))]
|
||||||
[(asserted P)
|
[(asserted P)
|
||||||
(analyze-asserted/retracted outer-expr-stx when-pred-stx event-stx terminal? script-stx
|
(analyze-asserted/retracted outer-expr-stx when-pred-stx event-stx script-stx
|
||||||
#t #'P priority-stx)]
|
#t #'P priority-stx)]
|
||||||
[(retracted P)
|
[(retracted P)
|
||||||
(analyze-asserted/retracted outer-expr-stx when-pred-stx event-stx terminal? script-stx
|
(analyze-asserted/retracted outer-expr-stx when-pred-stx event-stx script-stx
|
||||||
#f #'P priority-stx)]
|
#f #'P priority-stx)]
|
||||||
[(rising-edge Pred)
|
[(rising-edge Pred)
|
||||||
(define field-name
|
(define field-name
|
||||||
|
@ -822,7 +825,6 @@
|
||||||
(#,field-name new-val)
|
(#,field-name new-val)
|
||||||
(when new-val
|
(when new-val
|
||||||
(schedule-script! #:priority #,priority-stx
|
(schedule-script! #:priority #,priority-stx
|
||||||
#,(if terminal? #'#t #'#f)
|
|
||||||
(lambda () #,script-stx)))))
|
(lambda () #,script-stx)))))
|
||||||
patch-empty)
|
patch-empty)
|
||||||
void)))]))
|
void)))]))
|
||||||
|
@ -839,7 +841,6 @@
|
||||||
|
|
||||||
(define field-counter 0)
|
(define field-counter 0)
|
||||||
(define (make-field name initial-value)
|
(define (make-field name initial-value)
|
||||||
(define fid (current-facet-id))
|
|
||||||
(define desc (field-descriptor name field-counter))
|
(define desc (field-descriptor name field-counter))
|
||||||
(set! field-counter (+ field-counter 1))
|
(set! field-counter (+ field-counter 1))
|
||||||
(hash-set! (actor-state-field-table (current-actor-state))
|
(hash-set! (actor-state-field-table (current-actor-state))
|
||||||
|
@ -898,14 +899,8 @@
|
||||||
(call-with-syndicate-effects
|
(call-with-syndicate-effects
|
||||||
(lambda () (apply proc args)))))))
|
(lambda () (apply proc args)))))))
|
||||||
|
|
||||||
(define (schedule-script! #:priority [priority *normal-priority*] terminal? thunk)
|
(define (schedule-script! #:priority [priority *normal-priority*] thunk)
|
||||||
(if terminal?
|
(push-script! priority (capture-facet-context thunk)))
|
||||||
(let ((f (terminate-facet! (current-facet-id))))
|
|
||||||
(when f ;; only want to run a terminal script if we genuinely terminated
|
|
||||||
(push-script! priority
|
|
||||||
(parameterize ((current-facet-id (facet-parent f)))
|
|
||||||
(capture-facet-context thunk)))))
|
|
||||||
(push-script! priority (capture-facet-context thunk))))
|
|
||||||
|
|
||||||
(define (push-script! priority thunk-with-context)
|
(define (push-script! priority thunk-with-context)
|
||||||
(define v (current-pending-scripts))
|
(define v (current-pending-scripts))
|
||||||
|
@ -946,7 +941,8 @@
|
||||||
(define new-eid (mux-next-pid (actor-state-mux a)))
|
(define new-eid (mux-next-pid (actor-state-mux a)))
|
||||||
(define-values (new-mux _new-eid _delta delta-aggregate)
|
(define-values (new-mux _new-eid _delta delta-aggregate)
|
||||||
(mux-add-stream (actor-state-mux a)
|
(mux-add-stream (actor-state-mux a)
|
||||||
(parameterize ((current-dataflow-subject-id (list (current-facet-id) new-eid)))
|
(parameterize ((current-dataflow-subject-id
|
||||||
|
(list (current-facet-id) new-eid)))
|
||||||
(patch-fn))))
|
(patch-fn))))
|
||||||
(current-actor-state (struct-copy actor-state (current-actor-state) [mux new-mux]))
|
(current-actor-state (struct-copy actor-state (current-actor-state) [mux new-mux]))
|
||||||
(values new-eid delta-aggregate)))
|
(values new-eid delta-aggregate)))
|
||||||
|
@ -963,16 +959,17 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Facet Lifecycle
|
;; Facet Lifecycle
|
||||||
|
|
||||||
(define next-fid 0)
|
(define next-fid-uid 0)
|
||||||
(define (add-facet! where setup-proc)
|
(define (add-facet! where setup-proc)
|
||||||
(when (not (in-script?))
|
(when (not (in-script?))
|
||||||
(error 'add-facet!
|
(error 'add-facet!
|
||||||
"~a: Cannot add facet outside script; are you missing an (on ...)?"
|
"~a: Cannot add facet outside script; are you missing an (on ...)?"
|
||||||
where))
|
where))
|
||||||
(define parent-fid (current-facet-id))
|
(define parent-fid (current-facet-id))
|
||||||
(define fid next-fid)
|
(define fid-uid next-fid-uid)
|
||||||
(set! next-fid (+ next-fid 1))
|
(define fid (cons fid-uid parent-fid))
|
||||||
(update-facet! fid (lambda (_f) (facet (hasheqv) '() (seteqv) parent-fid)))
|
(set! next-fid-uid (+ next-fid-uid 1))
|
||||||
|
(update-facet! fid (lambda (_f) (facet fid (hasheqv) '() (set))))
|
||||||
(update-facet! parent-fid
|
(update-facet! parent-fid
|
||||||
(lambda (pf)
|
(lambda (pf)
|
||||||
(and pf (struct-copy facet pf
|
(and pf (struct-copy facet pf
|
||||||
|
@ -982,43 +979,39 @@
|
||||||
(lookup-facet fid)
|
(lookup-facet fid)
|
||||||
(patch (actor-state-knowledge (current-actor-state)) trie-empty)
|
(patch (actor-state-knowledge (current-actor-state)) trie-empty)
|
||||||
#t)
|
#t)
|
||||||
(when (and (facet-live? fid) parent-fid (not (facet-live? parent-fid)))
|
(when (and (facet-live? fid) (pair? parent-fid) (not (facet-live? parent-fid)))
|
||||||
(terminate-facet! fid)))
|
(terminate-facet! fid)))
|
||||||
|
|
||||||
;; If the named facet is live, terminate it and return its facet
|
;; If the named facet is live, terminate it.
|
||||||
;; record; otherwise, return #f.
|
|
||||||
(define (terminate-facet! fid)
|
(define (terminate-facet! fid)
|
||||||
(define f (lookup-facet fid))
|
(define f (lookup-facet fid))
|
||||||
(and f
|
(when f
|
||||||
(begin
|
(for [((eid ep) (in-hash (facet-endpoints f)))]
|
||||||
(for [((eid ep) (in-hash (facet-endpoints f)))]
|
(define a (current-actor-state))
|
||||||
(define a (current-actor-state))
|
(dataflow-forget-subject! (actor-state-field-dataflow a) (list fid eid))
|
||||||
(dataflow-forget-subject! (actor-state-field-dataflow a) (list fid eid))
|
(define-values (new-mux _eid _delta delta-aggregate)
|
||||||
(define-values (new-mux _eid _delta delta-aggregate)
|
(mux-remove-stream (actor-state-mux a) eid))
|
||||||
(mux-remove-stream (actor-state-mux a) eid))
|
(current-actor-state (struct-copy actor-state a [mux new-mux]))
|
||||||
(current-actor-state (struct-copy actor-state a [mux new-mux]))
|
(schedule-action! delta-aggregate))
|
||||||
(schedule-action! delta-aggregate))
|
|
||||||
|
|
||||||
(let ((parent-fid (facet-parent f)))
|
(let ((parent-fid (cdr fid)))
|
||||||
(when parent-fid
|
(when (pair? parent-fid)
|
||||||
(update-facet! parent-fid
|
(update-facet! parent-fid
|
||||||
(lambda (f)
|
(lambda (f)
|
||||||
(and f
|
(and f
|
||||||
(struct-copy facet f
|
(struct-copy facet f
|
||||||
[children (set-remove (facet-children f)
|
[children (set-remove (facet-children f)
|
||||||
fid)]))))))
|
fid)]))))))
|
||||||
(store-facet! fid #f)
|
(store-facet! fid #f)
|
||||||
|
|
||||||
(for [(child-fid (in-set (facet-children f)))]
|
(for [(child-fid (in-set (facet-children f)))]
|
||||||
(terminate-facet! child-fid))
|
(terminate-facet! child-fid))
|
||||||
|
|
||||||
;; Run stop-scripts after terminating children. This means that
|
;; Run stop-scripts after terminating children. This means that
|
||||||
;; children's stop-scripts run before ours.
|
;; children's stop-scripts run before ours.
|
||||||
(with-current-facet fid #t
|
(with-current-facet fid #t
|
||||||
(for [(script (in-list (reverse (facet-stop-scripts f))))]
|
(for [(script (in-list (reverse (facet-stop-scripts f))))]
|
||||||
(call-with-syndicate-effects script)))
|
(call-with-syndicate-effects script)))))
|
||||||
|
|
||||||
f)))
|
|
||||||
|
|
||||||
(define (add-stop-script! script-proc)
|
(define (add-stop-script! script-proc)
|
||||||
(update-facet! (current-facet-id)
|
(update-facet! (current-facet-id)
|
||||||
|
@ -1033,7 +1026,7 @@
|
||||||
(define (boot-actor script-proc)
|
(define (boot-actor script-proc)
|
||||||
(with-store [(current-actor-state
|
(with-store [(current-actor-state
|
||||||
(actor-state (mux)
|
(actor-state (mux)
|
||||||
(hasheqv)
|
(hash)
|
||||||
trie-empty
|
trie-empty
|
||||||
trie-empty
|
trie-empty
|
||||||
(make-weak-hasheq)
|
(make-weak-hasheq)
|
||||||
|
@ -1042,8 +1035,8 @@
|
||||||
(current-pending-actions '())
|
(current-pending-actions '())
|
||||||
(current-pending-scripts (make-empty-pending-scripts))
|
(current-pending-scripts (make-empty-pending-scripts))
|
||||||
(current-action-transformer values)]
|
(current-action-transformer values)]
|
||||||
(with-current-facet #f #f
|
(with-current-facet '() #f
|
||||||
(schedule-script! #f script-proc)
|
(schedule-script! script-proc)
|
||||||
(run-scripts!))))
|
(run-scripts!))))
|
||||||
|
|
||||||
(define (pop-next-script!)
|
(define (pop-next-script!)
|
||||||
|
@ -1243,8 +1236,8 @@
|
||||||
(fprintf p " - Knowledge:\n ~a" (trie->pretty-string knowledge #:indent 3))
|
(fprintf p " - Knowledge:\n ~a" (trie->pretty-string knowledge #:indent 3))
|
||||||
(fprintf p " - Facets:\n")
|
(fprintf p " - Facets:\n")
|
||||||
(for ([(fid f) (in-hash facets)])
|
(for ([(fid f) (in-hash facets)])
|
||||||
(match-define (facet endpoints _ children parent) f)
|
(match-define (facet _fid endpoints _ children) f)
|
||||||
(fprintf p " ---- facet ~a, parent=~a, children=~a" fid parent (set->list children))
|
(fprintf p " ---- facet ~a, children=~a" fid (set->list children))
|
||||||
(when (not (hash-empty? endpoints))
|
(when (not (hash-empty? endpoints))
|
||||||
(fprintf p ", endpoints=~a" (hash-keys endpoints)))
|
(fprintf p ", endpoints=~a" (hash-keys endpoints)))
|
||||||
(newline p))
|
(newline p))
|
||||||
|
|
Loading…
Reference in New Issue