Bring up to date with latest changes

This commit is contained in:
Tony Garnock-Jones 2021-07-27 16:01:12 +02:00
parent 90b56b1154
commit f82b9094a0
3 changed files with 16 additions and 11 deletions

View File

@ -24,7 +24,7 @@
(newline) (newline)
(displayln (bytes->hex-string (sturdy-encode (->preserve root-cap)))) (displayln (bytes->hex-string (sturdy-encode (->preserve root-cap))))
(define spec (TcpLocal "0.0.0.0" 5999)) (define spec (TcpLocal "0.0.0.0" 8001))
(at ds (at ds
(stop-on (asserted (StreamListenerError spec _))) (stop-on (asserted (StreamListenerError spec _)))
(during/spawn (StreamConnection $source $sink spec) (during/spawn (StreamConnection $source $sink spec)

View File

@ -9,7 +9,7 @@
(struct-out facet) (struct-out facet)
(struct-out entity-ref) (struct-out entity-ref)
parse-Ref!) parse-Cap!)
(require racket/match) (require racket/match)
(require (only-in racket/string string-join)) (require (only-in racket/string string-join))
@ -95,7 +95,7 @@
"" ""
(format " ~s" a))))]) (format " ~s" a))))])
(define (parse-Ref! r) (define (parse-Cap! r)
(if (entity-ref? r) (if (entity-ref? r)
r r
(error 'parse-Ref! "Expected entity-ref; got ~v" r))) (error 'parse-Ref! "Expected entity-ref; got ~v" r)))

View File

@ -13,7 +13,7 @@
(require "schemas/sturdy.rkt") (require "schemas/sturdy.rkt")
(define (match-Pattern p v) (define (match-Pattern p v)
(define bindings (make-hasheq)) (define bindings-rev '())
(define (walk p v) (define (walk p v)
(match p (match p
@ -26,13 +26,16 @@
[(Pattern-PAtom (PAtom-String)) (string? v)] [(Pattern-PAtom (PAtom-String)) (string? v)]
[(Pattern-PAtom (PAtom-Symbol)) (symbol? v)] [(Pattern-PAtom (PAtom-Symbol)) (symbol? v)]
[(Pattern-PEmbedded (PEmbedded)) (embedded? v)] [(Pattern-PEmbedded (PEmbedded)) (embedded? v)]
[(Pattern-PBind (PBind n p)) (and (walk p v) (begin (hash-set! bindings n v) #t))] [(Pattern-PBind (PBind p))
(and (walk p v)
(begin (set! bindings-rev (cons v bindings-rev))
#t))]
[(Pattern-PAnd ps) (andmap (lambda (p) (walk p v)) ps)] [(Pattern-PAnd ps) (andmap (lambda (p) (walk p v)) ps)]
[(Pattern-PNot p) [(Pattern-PNot p)
(let ((saved bindings)) (let ((saved bindings-rev))
(set! bindings (make-hasheq)) (set! bindings-rev '())
(let ((result (walk p v))) (let ((result (walk p v)))
(set! bindings saved) (set! bindings-rev saved)
(not result)))] (not result)))]
[(Pattern-Lit (Lit expected)) (preserve=? expected v)] [(Pattern-Lit (Lit expected)) (preserve=? expected v)]
[(Pattern-PCompound (PCompound (ConstructorSpec-CRec (CRec label arity)) [(Pattern-PCompound (PCompound (ConstructorSpec-CRec (CRec label arity))
@ -56,7 +59,7 @@
(define vv (hash-ref v key (void))) (define vv (hash-ref v key (void)))
(and (not (void? vv)) (walk pp vv))))])) (and (not (void? vv)) (walk pp vv))))]))
(and (walk p v) bindings)) (and (walk p v) (reverse bindings-rev)))
(define (instantiate-Template t bindings) (define (instantiate-Template t bindings)
(let walk ((t t)) (let walk ((t t))
@ -64,8 +67,10 @@
[(Template-TAttenuate (TAttenuate t (Attenuation attenuation))) [(Template-TAttenuate (TAttenuate t (Attenuation attenuation)))
(match-define (embedded v) (walk t)) (match-define (embedded v) (walk t))
(embedded (apply attenuate-entity-ref v attenuation))] (embedded (apply attenuate-entity-ref v attenuation))]
[(Template-TRef (TRef name)) [(Template-TRef (TRef index))
(hash-ref bindings name (lambda () (error 'instantiate-Template "Missing binding: ~v" name)))] (if (< index (length bindings))
(list-ref bindings index)
(error 'instantiate-Template "Binding index out of range: ~v" index))]
[(Template-Lit (Lit v)) v] [(Template-Lit (Lit v)) v]
[(Template-TCompound (TCompound (ConstructorSpec-CRec (CRec label arity)) [(Template-TCompound (TCompound (ConstructorSpec-CRec (CRec label arity))
(TCompoundMembers members))) (TCompoundMembers members)))