From 5bcfae5aedc37aca9d351a16d286704752848267 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 3 Feb 2015 12:51:27 -0800 Subject: [PATCH] aha --- quad/quads-typed.rkt | 3 ++- quad/tests-typed.rkt | 4 ++-- quad/utils-typed.rkt | 18 +++++------------- 3 files changed, 9 insertions(+), 16 deletions(-) diff --git a/quad/quads-typed.rkt b/quad/quads-typed.rkt index eba8c0a7..79ed7123 100644 --- a/quad/quads-typed.rkt +++ b/quad/quads-typed.rkt @@ -19,7 +19,8 @@ (define-type QuadAttrValue Any) (define-predicate QuadAttrValue? QuadAttrValue) (define-type QuadAttrs (HashTable QuadAttrKey QuadAttrValue)) -(define-type HashableList (All (A) (Rec duo (U Null (List* QuadAttrKey A duo))))) +(define-type HashableList (Rec duo (U Null (List* QuadAttrKey Any duo)))) +(define-predicate HashableList? HashableList) (: quad-attrs? (Any . -> . Boolean)) diff --git a/quad/tests-typed.rkt b/quad/tests-typed.rkt index d5dc12a4..1a6c8d45 100644 --- a/quad/tests-typed.rkt +++ b/quad/tests-typed.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require "utils.rkt" "wrap.rkt" "quads-typed.rkt" "world.rkt" racket/list racket/format) +(require "utils-typed.rkt" "quads-typed.rkt" "world-typed.rkt" racket/list racket/format) (require rackunit) -(check-equal? (join-attrs (list (box '(width 10)) (box #f "foobar") (hash 'x 10) (list 'width 20))) +(check-equal? (join-attrs (list (box '(width 10)) (quad-attrs (box '(x 10))) (list 'width 20))) (list (cons 'width 10) (cons 'x 10) (cons 'width 20))) diff --git a/quad/utils-typed.rkt b/quad/utils-typed.rkt index 36df12aa..12cc0aa3 100644 --- a/quad/utils-typed.rkt +++ b/quad/utils-typed.rkt @@ -13,24 +13,16 @@ (: pairs? (Any . -> . Boolean)) (define (pairs? x) (and (list? x) (andmap pair? x))) - ;; push together multiple attr sources into one list of pairs. ;; mostly a helper function for the two attr functions below. -(: join-attrs ((Listof (U Quad QuadAttrs HashableList)) . -> . Any)) ;; temp: end with QuadAttrs +(provide join-attrs) +(: join-attrs ((Listof (U Quad QuadAttrs HashableList)) . -> . (Listof QuadAttrPair))) (define (join-attrs quads-or-attrs-or-lists) - (append-map (inst hash->list QuadAttrs HashableList) (filter-not false? (map (λ(x) + ((inst append-map QuadAttrPair QuadAttrs) (inst hash->list QuadAttrKey QuadAttrValue) (map (λ(x) (cond [(quad? x) (quad-attrs x)] - [(quad-attrs? x) x] + [(quad-attrs? x) (cast x QuadAttrs)] [(hashable-list? x) (quadattrs (cast x (Listof Any)))] - [else #f])) quads-or-attrs-or-lists)))) + [else (cast hash QuadAttrs)])) quads-or-attrs-or-lists))) -#| -(append-map hash->list (filter-not false? (map (λ(x) - (cond - [(quad? x) (quad-attrs x)] - [(quad-attrs? x) x] - [(hashable-list? x) (quadattrs x)] - [else #f])) quads-or-attrs-or-lists))) -|#