6.0 candidate

typed/txexpr/main.rkt

@@ -3,8 +3,9 @@
 (require racket/match racket/string racket/list racket/bool "core-predicates.rkt")
 (provide (all-defined-out) (all-from-out "core-predicates.rkt"))
 (require typed/sugar/debug)
+
 (define/typed (validate-txexpr-attrs x #:context [txexpr-context #f])
-  (Txexpr-Attrs #:context Any  -> Txexpr-Attrs)
+  (Txexpr-Attrs [#:context Any]  -> Txexpr-Attrs)
   (define/typed (make-reason)
     (-> String)
     (if (not (list? x)) 
@@ -21,7 +22,7 @@
 
 
 (define/typed (validate-txexpr-element x #:context [txexpr-context #f])
-  (Txexpr-Element #:context Any -> Txexpr-Element)
+  (Txexpr-Element [#:context Any] -> Txexpr-Element)
   (cond
     [(or (string? x) (txexpr? x) (symbol? x)
          (valid-char? x) (cdata? x)) x]
@@ -44,12 +45,18 @@
     [else (error 'validate-txexpr (format "~v is not a list starting with a symbol" x))]))
 
 
-(define/typed (make-txexpr tag [attrs null] [elements null])
+(define/typed make-txexpr
-  (Symbol Txexpr-Attrs (Listof Txexpr-Element) -> Txexpr)
+  (case-> (Symbol -> Txexpr)
-  (define result (cons tag (append (if (empty? attrs) empty (list attrs)) elements)))
+          (Symbol Txexpr-Attrs -> Txexpr)
-  (if (txexpr? result)
+          (Symbol Txexpr-Attrs (Listof Txexpr-Element) -> Txexpr))
-      result
+  (case-lambda
-      (error 'make-txexpr "This can't happen")))
+    [(tag) (make-txexpr tag null null)]
+    [(tag attrs) (make-txexpr tag attrs null)]
+    [(tag attrs elements)
+     (define result (cons tag (append (if (empty? attrs) empty (list attrs)) elements)))
+     (if (txexpr? result)
+         result
+         (error 'make-txexpr "This can't happen"))]))
 
 
 (define/typed (txexpr->values x)
@@ -105,7 +112,7 @@
   ;; but still need this function to make sure that 'foo and "foo" are treated as the same hash key
   (define items (reverse
                  (for/fold: ([items : (Listof (U Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value)) null])
-                           ([i (in-list items-in)])
+                   ([i (in-list items-in)])
                    (cond
                      [(txexpr-attr? i) (append (reverse i) items)]
                      [(txexpr-attrs? i) (append (append* (map (λ:([a : Txexpr-Attr]) (reverse a)) i)) items)]
@@ -205,22 +212,26 @@
 
 ;; function to split tag out of txexpr
 (define deleted-signal (gensym))
-(define/typed (splitf-txexpr tx pred [proc (λ:([x : Xexpr]) deleted-signal)])
+(define/typed splitf-txexpr
-  (Txexpr (Xexpr -> Boolean) (Xexpr -> Xexpr) -> (values Txexpr Txexpr-Elements))
+  (case-> (Txexpr (Xexpr -> Boolean) -> (values Txexpr Txexpr-Elements))
-  (define: matches : Txexpr-Elements null)
+          (Txexpr (Xexpr -> Boolean) (Xexpr -> Xexpr) -> (values Txexpr Txexpr-Elements)))
-  (define/typed (do-extraction x)
+  (case-lambda
-    (Xexpr -> Xexpr)
+    [(tx pred) (splitf-txexpr tx pred (λ:([x : Xexpr]) deleted-signal))]
-    (cond
+    [(tx pred proc)
-      [(pred x) (begin  ; store matched item and return processed value
+     (define: matches : Txexpr-Elements null)
-                  (set! matches (cons x matches))
+     (define/typed (do-extraction x)
-                  (proc x))]
+       (Xexpr -> Xexpr)
-      [(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)]) 
+       (cond
-                     (make-txexpr tag attr (filter (λ:([e : Xexpr]) (not (equal? e deleted-signal))) (map do-extraction elements))))]
+         [(pred x) (begin  ; store matched item and return processed value
-      [else x]))
+                     (set! matches (cons x matches))
-  (define tx-extracted (do-extraction tx)) ;; do this first to fill matches
+                     (proc x))]
-  (values (if (txexpr? tx-extracted)
+         [(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)]) 
-              tx-extracted
+                        (make-txexpr tag attr (filter (λ:([e : Xexpr]) (not (equal? e deleted-signal))) (map do-extraction elements))))]
-              (error 'splitf-txexpr "Can't get here")) (reverse matches)))
+         [else x]))
+     (define: tx-extracted : Xexpr (do-extraction tx)) ;; do this first to fill matches
+     (values (if (txexpr? tx-extracted)
+                 tx-extracted
+                 (error 'splitf-txexpr "Can't get here")) (reverse matches))]))
 
 
 (define/typed (xexpr->html x)