From 1faa122c49b9a1e23fd2607dfb685d73283412e2 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 14 Jun 2014 12:41:17 -0400 Subject: [PATCH] Changes from code review --- minimart/gestalt.rkt | 32 ++++++++++++++++++-------------- minimart/ground.rkt | 2 +- minimart/route.rkt | 16 ++++++++-------- 3 files changed, 27 insertions(+), 23 deletions(-) diff --git a/minimart/gestalt.rkt b/minimart/gestalt.rkt index 7b7383e..2a3544d 100644 --- a/minimart/gestalt.rkt +++ b/minimart/gestalt.rkt @@ -105,14 +105,17 @@ ;; Only adds to its second argument if its first is nonempty. (define cons-metalevel (guarded-cons empty-metalevel)) +;; Gestalt Nat -> Metalevel +(define (gestalt-metalevel-ref g n) + (safe-list-ref (gestalt-metalevels g) n (lambda () empty-metalevel))) + ;; Gestalt × Value × Natural × Boolean → (Setof PID) ;; Retrieves those PIDs that have active subscriptions/advertisements ;; covering the given message at the given metalevel. (define (gestalt-match-value g body metalevel is-feedback?) - (define levels (safe-list-ref (gestalt-metalevels g) metalevel (lambda () empty-metalevel))) - (for/fold [(acc (set))] [(level (in-list levels))] - (define matcher ((if is-feedback? cdr car) level)) ;; feedback targets advertisers/publishers - (set-union (matcher-match-value matcher body) acc))) + (define extract-matcher (if is-feedback? cdr car)) ;; feedback targets advertisers/publishers + (define (pids-at level) (matcher-match-value (extract-matcher level) body)) + (apply set-union (map pids-at (gestalt-metalevel-ref g metalevel)))) ;; (Listof Projection) -> CompiledProjection ;; For use with gestalt-project. @@ -133,10 +136,10 @@ ;; Retrieves the Matcher within g at the given metalevel and level, ;; representing subscriptions or advertisements, projected by capture-spec. (define (gestalt-project g metalevel level get-advertisements? capture-spec) - (define levels (safe-list-ref (gestalt-metalevels g) metalevel (lambda () empty-metalevel))) - (define matcher ((if get-advertisements? cdr car) - (safe-list-ref levels level (lambda () empty-level)))) - (if (equal? capture-spec capture-everything-projection) + (define extract-matcher (if get-advertisements? cdr car)) + (define level (safe-list-ref (gestalt-metalevel-ref g metalevel) level (lambda () empty-level))) + (define matcher (extract-matcher level)) + (if (equal? capture-spec capture-everything-projection) ;; efficiency hack. Avoid projecting by identity matcher (matcher-project matcher capture-spec))) @@ -165,9 +168,8 @@ ;; Gestalts. (define (simple-gestalt is-adv? p level metalevel) (define m (pattern->matcher #t p)) - (gestalt (prepend metalevel empty-metalevel - (list (prepend level empty-level - (list (if is-adv? (cons #f m) (cons m #f)))))))) + (define pom (if is-adv? (cons #f m) (cons m #f))) + (gestalt (prepend metalevel empty-metalevel (list (prepend level empty-level (list pom)))))) ;; -> Gestalt ;; The empty gestalt. @@ -178,9 +180,8 @@ ;; TODO: our invariants should ensure that (gestalt-empty? g) iff (equal? g (gestalt '())). ;; Make sure this actually is true. (define (gestalt-empty? g) - (andmap (lambda (ml) - (andmap (lambda (l) (and (matcher-empty? (car l)) (matcher-empty? (cdr l)))) ml)) - (gestalt-metalevels g))) + (for*/and [(ml (in-list (gestalt-metalevels g))) (l (in-list ml))] + (and (matcher-empty? (car l)) (matcher-empty? (cdr l))))) ;; map-zip: ((U 'right-longer 'left-longer) (Listof X) -> (Listof Y)) ;; (X X -> Y) @@ -235,8 +236,11 @@ ;; Computes the union of its arguments. (define (gestalt-union1 g1 g2) (gestalt-combine-straight g1 g2 (lambda (side x) x) matcher-union)) +;; TODO: abstract out the folding skeletons of gestalt-filter and gestalt-match. + ;; Gestalt Gestalt -> Gestalt ;; View on g1 from g2's perspective. +;; Implements the "(p)_n ||

_m if n < m" part of NC. (define gestalt-filter (let () (define (filter-metalevels mls1 mls2) diff --git a/minimart/ground.rkt b/minimart/ground.rkt index 15becc4..b751508 100644 --- a/minimart/ground.rkt +++ b/minimart/ground.rkt @@ -48,7 +48,7 @@ ;; In principle, security restrictions should make it impossible. ;; But absent those, what should be done? Should an offending ;; process be identified and terminated? - (when (not es) (error 'extract-active-events "User program subscribed to wildcard event")) + (unless es (error 'extract-active-events "User program subscribed to wildcard event")) (for/list [(ev (in-set es))] (match-define (list e) ev) (event-handler e))) diff --git a/minimart/route.rkt b/minimart/route.rkt index ddfa3fc..08a1758 100644 --- a/minimart/route.rkt +++ b/minimart/route.rkt @@ -8,6 +8,8 @@ ;; TODO: rename to matcher.rkt or similar. ;; TODO: Ontology +;; TODO: (generally) interpretations for data definitions + (provide ;; Patterns and Projections ? wildcard? @@ -82,6 +84,7 @@ (define matcher-match-matcher-unit (make-parameter (cons (set) (set)))) +;; The project-success function should return #f to signal "no success values". (define matcher-project-success (make-parameter values)) ;; Constructs a structure type and a singleton instance of it. @@ -665,23 +668,19 @@ (define (projection->pattern p) (let walk ((p p)) (match p - [(capture sub) (walk sub)] ;; TODO: maybe enforce non-nesting here too? + [(capture sub) sub] ;; TODO: maybe enforce non-nesting here too? [(cons p1 p2) (cons (walk p1) (walk p2))] [(? vector? v) (for/vector [(e (in-vector v))] (walk e))] - [(embedded-matcher _) p] [(? non-object-struct?) - (define-values (t skipped?) (struct-info p)) - (when skipped? (error 'projection->pattern "Cannot reflect on struct instance ~v" p)) - (define fs (cdr (vector->list (struct->vector p)))) - (apply (struct-type-make-constructor t) (map walk fs))] + (apply (struct-type-make-constructor (struct->struct-type p)) + (map walk (cdr (vector->list (struct->vector p)))))] ;; TODO: consider options for treating hash tables as compounds ;; rather than (useless) atoms [(? hash?) (error 'projection->pattern "Cannot match on hash tables at present")] [other other]))) -;; Matcher × CompiledProjection [× (Value -> (Option Value))] → Matcher +;; Matcher × CompiledProjection -> Matcher ;; The result matches a sequence of inputs of length equal to the number of captures. -;; The project-success function should return #f to signal "no success values". (define matcher-project ;; TODO: skip-nested, capture-nested, and various cases in walk all ;; share a suspicious amount of code. Refactor it away. @@ -714,6 +713,7 @@ [else (rupdate acc key (capture-nested mk k))])))] [_ (matcher-empty)])) + ;; Boolean Matcher CompiledProjection -> Matcher (define (walk capturing? m spec) (match spec ['()