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

Various missing con/destructors

This commit is contained in:
Tony Garnock-Jones 2021-06-09 14:53:08 +02:00
parent eb3aa40541
commit d0fb1cfa99
2 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
syndicate/distributed/tcp-server.rkt
View File

@ -67,7 +67,7 @@
(during (Bind (SturdyRef-oid unvalidated-sturdyref) $key $target)
(define sturdyref (validate unvalidated-sturdyref key))
(define attenuation
(append-map values (reverse (SturdyRef-caveatChain sturdyref))))
(append-map Attenuation-value (reverse (SturdyRef-caveatChain sturdyref))))
(define attenuated-target
(apply attenuate-entity-ref target attenuation))
(at observer (assert (embedded attenuated-target)))))]))))))))

18
syndicate/rewrite.rkt
View File

@ -33,19 +33,22 @@
(set! bindings saved)
(not result)))]
[(Pattern-Lit (Lit expected)) (preserve=? expected v)]
[(Pattern-PCompound (PCompound (ConstructorSpec-CRec (CRec label arity)) members))
[(Pattern-PCompound (PCompound (ConstructorSpec-CRec (CRec label arity))
(PCompoundMembers members)))
(match v
[(record (== label preserve=?) fields)
(and (= (length fields) arity)
(for/and [((key pp) (in-hash members))]
(and (exact-integer? key) (walk pp (list-ref fields key)))))]
[_ #f])]
[(Pattern-PCompound (PCompound (ConstructorSpec-CArr (CArr arity)) members))
[(Pattern-PCompound (PCompound (ConstructorSpec-CArr (CArr arity))
(PCompoundMembers members)))
(and (list? v)
(= (length v) arity)
(for/and [((key pp) (in-hash members))]
(and (exact-integer? key) (walk pp (list-ref v key)))))]
[(Pattern-PCompound (PCompound (ConstructorSpec-CDict (CDict)) members))
[(Pattern-PCompound (PCompound (ConstructorSpec-CDict (CDict))
(PCompoundMembers members)))
(and (dict? v)
(for/and [((key pp) (in-hash members))]
(define vv (hash-ref v key (void)))
@ -59,16 +62,19 @@
[(Template-TRef (TRef name))
(hash-ref bindings name (lambda () (error 'instantiate-Template "Missing binding: ~v" name)))]
[(Template-Lit (Lit v)) v]
[(Template-TCompound (TCompound (ConstructorSpec-CRec (CRec label arity)) members))
[(Template-TCompound (TCompound (ConstructorSpec-CRec (CRec label arity))
(TCompoundMembers members)))
(record label
(for/list [(i (in-range 0 arity))]
(walk (hash-ref members i (lambda () (error 'instantiate-Template
"Missing record field key ~v" i))))))]
[(Template-TCompound (TCompound (ConstructorSpec-CArr (CArr arity)) members))
[(Template-TCompound (TCompound (ConstructorSpec-CArr (CArr arity))
(TCompoundMembers members)))
(for/list [(i (in-range 0 arity))]
(walk (hash-ref members i (lambda () (error 'instantiate-Template
"Missing array key ~v" i)))))]
[(Template-TCompound (TCompound (ConstructorSpec-CDict (CDict)) members))
[(Template-TCompound (TCompound (ConstructorSpec-CDict (CDict))
(TCompoundMembers members)))
(for/hash [((key tt) (in-hash members))]
(values key (walk tt)))])))