From 8ff6dc5ff8ec76df35eba138226cbea8e2092344 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 20 Oct 2018 18:27:15 +0100 Subject: [PATCH] Eliminate one set of dummy wrappers --- syndicate/HOWITWORKS.md | 12 +++++------- syndicate/pattern.rkt | 2 +- syndicate/skeleton.rkt | 16 ++++++++-------- syndicate/term.rkt | 2 +- syndicate/test/pattern-test.rkt | 10 +++++----- syndicate/test/raw-dataspace.rkt | 4 ++-- 6 files changed, 22 insertions(+), 24 deletions(-) diff --git a/syndicate/HOWITWORKS.md b/syndicate/HOWITWORKS.md index 5a1b1e6..ca2e788 100644 --- a/syndicate/HOWITWORKS.md +++ b/syndicate/HOWITWORKS.md @@ -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 diff --git a/syndicate/pattern.rkt b/syndicate/pattern.rkt index 13f3fd4..a3c476b 100644 --- a/syndicate/pattern.rkt +++ b/syndicate/pattern.rkt @@ -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 diff --git a/syndicate/skeleton.rkt b/syndicate/skeleton.rkt index 3a2958c..19a5e14 100644 --- a/syndicate/skeleton.rkt +++ b/syndicate/skeleton.rkt @@ -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) diff --git a/syndicate/term.rkt b/syndicate/term.rkt index 42d404b..54c3e4f 100644 --- a/syndicate/term.rkt +++ b/syndicate/term.rkt @@ -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 diff --git a/syndicate/test/pattern-test.rkt b/syndicate/test/pattern-test.rkt index 79fb804..5e3f9fe 100644 --- a/syndicate/test/pattern-test.rkt +++ b/syndicate/test/pattern-test.rkt @@ -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) diff --git a/syndicate/test/raw-dataspace.rkt b/syndicate/test/raw-dataspace.rkt index 907f9f5..c9b4547 100644 --- a/syndicate/test/raw-dataspace.rkt +++ b/syndicate/test/raw-dataspace.rkt @@ -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)