From 556c9705444854bea7f70fedb2391b672b75e2dc Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 24 Jan 2015 12:04:37 -0800 Subject: [PATCH] hashit --- quad/quads-typed.rkt | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/quad/quads-typed.rkt b/quad/quads-typed.rkt index 1a99183a..b3a11910 100644 --- a/quad/quads-typed.rkt +++ b/quad/quads-typed.rkt @@ -48,6 +48,20 @@ [else (loop (cdr qs) (filter check-cap common-attr-pairs))]))) +(: quadattrs ((Listof Any) . -> . QuadAttrs)) +(define (quadattrs xs) + (let-values ([(ks vs even?) (for/fold + ([ks : (Listof Any) null][vs : (Listof Any) null][even? : Boolean #t]) + ([x (in-list xs)]) + (if even? + (values (cons x ks) vs #f) + (values ks (cons x vs) #t)))]) + (when (not even?) (error 'bad-input)) + (cast (for/hash ([k (in-list ks)][v (in-list vs)]) + (values k v)) QuadAttrs))) + + + (define-syntax (define-quad-type stx) (syntax-case stx () [(_ Id) @@ -64,9 +78,9 @@ (Id #hash() '())) (provide id) - (: id ((Listof (U QuadAttrKey QuadAttrValue)) . -> . Id)) - (define (id [attrs '()]) - (apply hash attrs)) + (: id ((Listof Any) . -> . Id)) + (define (id attrs) + (Id (quadattrs attrs) '())) ))]))