syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Handy logging for diagnosing problems

This commit is contained in:
Tony Garnock-Jones 2018-05-01 22:39:50 +01:00
parent 367b39ce39
commit eb208f3a10
3 changed files with 17 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
syndicate/dataspace.rkt
View File

@ -281,6 +281,8 @@
(define-syntax-rule (with-current-facet [f0] body ...)
(let ((f f0))
;; (when (not f)
;; (error 'with-current-facet "Cannot use with-current-facet this way"))
(parameterize ((current-facet f))
(with-handlers ([(lambda (e) (not (exn:break? e)))
(lambda (e)
@ -299,6 +301,8 @@
(define (capture-facet-context proc)
(let ((f (current-facet)))
;; (when (not f)
;; (error 'capture-facet-context "Cannot capture non-facet"))
(lambda args
(with-current-facet [f]
(apply proc args)))))

5
syndicate/relay.rkt
View File

@ -75,6 +75,11 @@
(term->capture-proj x)
(lambda (op . captured-values)
(define term (inbound (instantiate-term->value x captured-values)))
;; (log-info "~a => ~a ~a ~v"
;; outer-facet
;; inner-facet
;; op
;; term)
(push-script! inner-actor
(lambda ()
;; (log-info "~a (~a) ~v" inner-actor op term)

8
syndicate/syntax.rkt
View File

@ -323,6 +323,10 @@
(capture-facet-context
(lambda (op #,@(desc->capture-names desc))
(when (eq? op '!)
;; (log-info "~a ~a ~v"
;; (current-facet)
;; op
;; (list #,@(desc->capture-names desc)))
(schedule-script!
#:priority #,priority-stx
(current-actor)
@ -370,6 +374,10 @@
(capture-facet-context
(lambda (op #,@(desc->capture-names desc))
(when (eq? op #,(if asserted? #''+ #''-))
;; (log-info "~a ~a ~v"
;; (current-facet)
;; op
;; (list #,@(desc->capture-names desc)))
(schedule-script!
#:priority #,priority-stx
(current-actor)