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

Eliminate one set of dummy wrappers

This commit is contained in:
Tony Garnock-Jones 2018-10-20 18:27:15 +01:00
parent 0c701809e1
commit 8ff6dc5ff8
6 changed files with 22 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
syndicate/HOWITWORKS.md
View File

@ -145,7 +145,7 @@ on a dataflow variable, and that variable changes, the entire handler
is removed, reevaluated, and reinstalled.
constantmap :: P -> [(H, E)]
constantmap p = cmap [0] p
constantmap p = cmap [] p
where
cmap :: H -> P -> [(H, E)]
cmap h e = [(h, e)]
@ -158,7 +158,7 @@ is removed, reevaluated, and reinstalled.
Finally, a capture map extracts all capturing positions in a pattern:
capturemap :: P -> [H]
capturemap p = vmap [0] p
capturemap p = vmap [] p
where
vmap :: H -> P -> [H]
vmap h e = []
@ -241,10 +241,8 @@ cases where handlers are dynamically installed.
given path `h` from an overall value `v`.
project :: V -> H -> V
project v h = go dummy(v) h -- TODO: gross
where
go v [] = v
go x(v_0, ... v_i) (n:h) = v_n @ h
project v [] = v
project x(v_0, ..., v_i) (n:h) = project v_n h
**Definition.** The `projectMany` function projects a sequence of
subvalues.
@ -267,7 +265,7 @@ cases where handlers are dynamically installed.
extend :: Node -> S -> Continuation
extend node s =
let (_, (cont, _)) = walk-edge [0] node 0 0 [s]
let (_, (cont, _)) = walk-node [] node 0 0 s
cont
where

2
syndicate/pattern.rkt
View File

@ -192,7 +192,7 @@
['() '()]
[(cons p pieces) (append (walk-node (cons index key-rev) p)
(walk-edge (+ index 1) key-rev pieces))]))
(walk-node '(0) desc))
(walk-node '() desc))
(define (desc->key desc)
(select-pattern-leaves desc

16
syndicate/skeleton.rkt
View File

@ -222,7 +222,7 @@
[(cons p pieces)
(let-values (((pop-count sk) (walk-node! path sk pop-count index p)))
(walk-edge! (update-path path 1 (+ index 1)) sk pop-count (+ index 1) pieces))]))
(let-values (((_pop-count sk) (walk-edge! '(0) sk 0 0 (list desc))))
(let-values (((_pop-count sk) (walk-node! '() sk 0 0 desc)))
sk))
(define (add-interest! sk i)
@ -340,7 +340,7 @@
(apply-projection-path term path)))
(define (apply-projection-path term path)
(for/fold [(term (list term))] [(index (in-list path))]
(for/fold [(term term)] [(index (in-list path))]
(cond [(non-object-struct? term) (vector-ref (struct->vector term) (+ index 1))]
[(list? term) (list-ref term index)]
[(vector? term) (vector-ref term index)]
@ -369,9 +369,9 @@
(define i1
(skeleton-interest (list struct:a (list struct:b #f) #f)
'((0 0 0))
'((0 0))
'(foo)
'((0 1))
'((1))
(lambda (op . bindings)
(printf "xAB HANDLER: ~v ~v\n" op bindings))
(lambda (vars)
@ -393,9 +393,9 @@
(add-interest! sk
(skeleton-interest (list struct:d (list struct:b #f) #f (list struct:c #f))
'((0 2 0))
'((2 0))
'(DCZ)
'((0) (0 0) (0 0 0) (0 1))
'(() (0) (0 0) (1))
(lambda (op . bindings)
(printf "DBC HANDLER: ~v ~v\n" op bindings))
(lambda (vars)
@ -412,9 +412,9 @@
(add-interest! sk
(skeleton-interest (list struct:d #f (list struct:b #f) #f)
'((0 1 0))
'((1 0))
'(DBY)
'((0 0) (0 2))
'((0) (2))
(lambda (op . bindings)
(printf "xDB HANDLER: ~v ~v\n" op bindings))
(lambda (vars)

2
syndicate/term.rkt
View File

@ -50,7 +50,7 @@
[(cons p pieces) (append (walk-node (cons index key-rev) p)
(walk-edge (+ index 1) key-rev pieces))]))
(walk-node '(0) t))
(walk-node '() t))
(define (term->skeleton-proj t)
(select-term-leaves t

10
syndicate/test/pattern-test.rkt
View File

@ -33,19 +33,19 @@
(check-analyse-pattern '() $cap desc->key)
(check-analyse-pattern '() $cap desc->skeleton-proj)
(check-analyse-pattern '((0)) $cap desc->capture-proj)
(check-analyse-pattern '(()) $cap desc->capture-proj)
(check-analyse-pattern '#f $cap (s->d desc->skeleton-stx))
(check-analyse-pattern '(capture (discard)) $cap (s->d desc->assertion-stx))
(check-analyse-pattern '(123) (foo 123 $cap) desc->key)
(check-analyse-pattern '((0 0)) (foo 123 $cap) desc->skeleton-proj)
(check-analyse-pattern '((0 1)) (foo 123 $cap) desc->capture-proj)
(check-analyse-pattern '((0)) (foo 123 $cap) desc->skeleton-proj)
(check-analyse-pattern '((1)) (foo 123 $cap) desc->capture-proj)
(check-analyse-pattern '(list struct:foo #f #f) (foo 123 $cap) (s->d desc->skeleton-stx))
(check-analyse-pattern '(foo 123 (capture (discard))) (foo 123 $cap) (s->d desc->assertion-stx))
(check-analyse-pattern '((bar 'beep)) (foo (bar 'beep) $cap) desc->key)
(check-analyse-pattern '((0 0)) (foo (bar 'beep) $cap) desc->skeleton-proj)
(check-analyse-pattern '((0 1)) (foo (bar 'beep) $cap) desc->capture-proj)
(check-analyse-pattern '((0)) (foo (bar 'beep) $cap) desc->skeleton-proj)
(check-analyse-pattern '((1)) (foo (bar 'beep) $cap) desc->capture-proj)
(check-analyse-pattern '(list struct:foo #f #f) (foo (bar 'beep) $cap) (s->d desc->skeleton-stx))
(check-analyse-pattern '(foo (bar 'beep) (capture (discard)))
(foo (bar 'beep) $cap)

4
syndicate/test/raw-dataspace.rkt
View File

@ -40,7 +40,7 @@
(skeleton-interest (list struct:set-box #f)
'()
'()
'((0 0))
'((0))
(capture-facet-context
(lambda (op new-value)
(when (eq? '! op)
@ -84,7 +84,7 @@
(skeleton-interest (list struct:box-state #f)
'()
'()
'((0 0))
'((0))
(capture-facet-context
(lambda (op v)
(when (eq? '+ op)