so it begins

quad/quads-typed.rkt

@@ -0,0 +1,62 @@
+#lang typed/racket/base
+(require (for-syntax typed/racket/base racket/syntax))
+
+;; struct implementation
+
+(struct: quad ([name : Symbol] [attrs : (HashTable Symbol Any)] [list : (Listof quad)]) #:transparent
+  
+  #:property prop:sequence (λ(q) (quad-list q)))
+
+
+
+(define h (quad 'hello #hash((foo . bar)) (list (quad 'hello #hash((foo . bar)) '()))))
+
+(define-syntax (define-box-type stx)
+  (syntax-case stx ()
+    [(_ id) 
+     (with-syntax ([id? (format-id #'id "~a?" #'id)]
+                   [ids? (format-id #'id "~as?" #'id)]
+                   [lists-of-ids? (format-id #'id "list-of-~as?" #'id)]
+                   [quads->id (format-id #'id "quads->~a" #'id)]
+                   [inline/quads->id (format-id #'id "inline/quads->~a" #'id)])
+       #'(begin
+           ;; quad predicate - ok to be relaxed here if we're strict when making the struct
+           (provide id?)
+           (: id? (Any . -> . Boolean))
+           (define (id? x)
+             (and (quad? x) (equal? (quad-name x) 'id)))
+           
+           ;; quad constructor
+           ;; put contract here rather than on struct, because this is the main interface
+           ;; and this contract is more liberal.
+           ;; but don't put a separate contract on struct, because it's superfluous.
+           (define/contract (id [attrs #f] . xs)
+             (() ((or/c quad-attrs? hashable-list?)) #:rest quad-list? . ->* . id?)
+             (quad 'id (and attrs (if (hash? attrs) attrs (apply hash attrs))) xs))))]))
+
+
+(define-box-type hello)
+(define-box-type gbye)
+
+
+#|
+;; make this a macro because qs-in is often huge
+;; and the macro avoids allocation + garbage collection
+(define attr-missing (gensym))
+(: gather-common-attrs ((Listof quad) . -> . (Listof CommonAttr)))
+(define (gather-common-attrs qs)
+  (let loop : (Listof Commonattr) 
+    ([qs : (Listof quad) qs]
+             [common-attrs : (Listof Commonattr) (if (quad-attrs (car qs))
+                               (for/list ([kv-pair (in-hash-pairs (quad-attrs (car qs)))] 
+                                          #:unless (member (car kv-pair) cannot-be-common-attrs))  
+                                 kv-pair)
+                               empty)])
+    (cond
+      [(empty? common-attrs) #f]
+      [(empty? qs) (flatten common-attrs)]
+      [else (loop (cdr qs) 
+                  (filter (λ(ca) (equal? (quad-attr-ref (car qs) (car ca) attr-missing) (cdr ca)))
+                          common-attrs))])))
+|#
+