syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Retire the gross hack of upper-case symbols standing for variables.

This commit is contained in:
Tony Garnock-Jones 2012-03-11 10:17:55 -04:00
parent 7e0a6228c9
commit bab1beb5ec
3 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
presence/conversation.rkt
View File

@ -26,6 +26,9 @@
topic-subscriber topic-subscriber
co-role co-role
co-topic co-topic
;; Reexported from unify.rkt for convenience
wild
) )
(struct arrived (who) #:prefab) ;; someone arrived (struct arrived (who) #:prefab) ;; someone arrived
@ -122,7 +125,7 @@
the-disconnected-evt) the-disconnected-evt)
(define/public (assert!-evt name) (define/public (assert!-evt name)
(define cname (upper-case-symbols->canonical name)) (define cname (canonicalize name))
(choice-evt the-disconnected-evt (choice-evt the-disconnected-evt
(wrap-evt (channel-put-evt out-ch (arrived cname)) (wrap-evt (channel-put-evt out-ch (arrived cname))
(lambda (v) (lambda (v)
@ -132,7 +135,7 @@
(sync (assert!-evt name))) (sync (assert!-evt name)))
(define/public (retract!-evt name [why #f]) (define/public (retract!-evt name [why #f])
(define cname (upper-case-symbols->canonical name)) (define cname (canonicalize name))
(choice-evt the-disconnected-evt (choice-evt the-disconnected-evt
(wrap-evt (channel-put-evt out-ch (departed cname why)) (wrap-evt (channel-put-evt out-ch (departed cname why))
(lambda (v) (lambda (v)
@ -145,7 +148,7 @@
(sync (retract!-evt name))) (sync (retract!-evt name)))
(define/public (say-evt who what) (define/public (say-evt who what)
(define cname (upper-case-symbols->canonical (freshen who))) ;; TODO freshening is a bit weird (define cname (canonicalize who))
(choice-evt the-disconnected-evt (choice-evt the-disconnected-evt
(channel-put-evt out-ch (says cname what)))) (channel-put-evt out-ch (says cname what))))

16
presence/test-conversation.rkt
View File

@ -14,20 +14,18 @@
(standard-thread (standard-thread
(lambda () (lambda ()
(define handle (join-room r)) (define handle (join-room r))
(send handle assert! (topic-subscriber 'Any #:virtual? #t)) (send handle assert! (topic-subscriber (wild) #:virtual? #t))
(send handle assert! (topic-publisher 'Any #:virtual? #t)) (send handle assert! (topic-publisher (wild) #:virtual? #t))
(let loop () (let loop ()
(define m (send handle listen)) (define m (send handle listen))
;;(write `(robot heard ,m)) (newline) ;;(write `(robot heard ,m)) (newline)
(match m (match m
[(arrived who) ;;[(arrived who) (write `(robot hears arrival ,who)) (newline)]
(write `(robot hears arrival ,who))
(newline)]
[(says _ "die") [(says _ "die")
(error 'robot "Following orders!")] (error 'robot "Following orders!")]
[(says (topic 'publisher _ _) _) [(says (topic 'publisher _ _) _)
(send handle say (topic-subscriber 'Any) `(robot hears ,m))] (send handle say (topic-subscriber (wild)) `(robot hears ,m))]
[else (void)]) [_ (void)])
(loop)))) (loop))))
(define (interaction i o) (define (interaction i o)
@ -39,8 +37,8 @@
(newline o) (newline o)
(flush-output o)) (flush-output o))
(let ((handle (join-room r))) (let ((handle (join-room r)))
(define talk-topic (topic-publisher (list name 'Sink 'speech))) (define talk-topic (topic-publisher (list name (wild) 'speech)))
(define listen-topic (topic-subscriber (list 'Speaker name 'speech))) (define listen-topic (topic-subscriber (list (wild) name 'speech)))
(send handle assert! talk-topic) (send handle assert! talk-topic)
(send handle assert! listen-topic) (send handle assert! listen-topic)
(let loop () (let loop ()

6
presence/unify.rkt
View File

@ -6,6 +6,7 @@
(provide (struct-out variable) (provide (struct-out variable)
(struct-out canonical-variable) (struct-out canonical-variable)
wild
variables-in variables-in
unify unify
unify/env unify/env
@ -39,6 +40,11 @@
(display "?!" port) (display "?!" port)
(write (canonical-variable-index v) port))) (write (canonical-variable-index v) port)))
;; -> Variable
;; Create a fresh (and hence unconstrained) variable.
(define (wild [base-name '_])
(variable (gensym base-name)))
;; Any -> Set<Variable> ;; Any -> Set<Variable>
(define (variables-in x) (define (variables-in x)
(let walk ((x x) (acc (set))) (let walk ((x x) (acc (set)))