cleanup

coerce.rkt

@@ -1,155 +0,0 @@
-#lang racket/base
-(require racket/contract net/url xml racket/set)
-(module+ test (require rackunit))
-(require "len.rkt" "exception.rkt" "define.rkt" "debug.rkt")
-
-
-(define (make-coercion-error-handler target-format x)
-  (λ(e) (error (format "Can’t convert ~a to ~a" x target-format))))
-
-;; general way of coercing to integer
-(define+provide/contract (->int x)
-  (any/c . -> . integer?)
-  (try 
-   (cond
-     [(or (integer? x) (real? x)) (inexact->exact (floor x))] 
-     [(and (string? x) (> (len x) 0)) (->int (string->number x))]
-     [(symbol? x) (->int (->string x))]
-     [(char? x) (char->integer x)]
-     [else (len x)])
-   (except [exn:fail? (make-coercion-error-handler 'integer x)])))
-
-
-
-;; general way of coercing to string
-(define+provide/contract (->string x)
-  (any/c . -> . string?)
-  (if (string? x)
-      x ; fast exit for strings
-      (try   
-       (cond
-         [(equal? '() x) ""]
-         [(symbol? x) (symbol->string x)]
-         [(number? x) (number->string x)]
-         [(url? x) (->string (->path x))] ; todo: a url is more than just a path-string ... it has character encoding issues
-         [(path? x) (path->string x)]
-         [(char? x) (format "~a" x)]
-         [else (error)]) ; put this last so other xexprish things don't get caught
-       (except [exn:fail? (make-coercion-error-handler 'string x)]))))
-
-
-;; general way of coercing to html
-(define+provide/contract (->html x)
-  (any/c . -> . string?)
-  ;; todo: omit 'script and 'style tags (and ... ?)
-  (try (xexpr->string x)
-       (except [exn:fail? (make-coercion-error-handler 'html x)])))
-
-; todo: must get this right — no escaped chars
-;(->html '(script ((type "text/javascript")) "3 > 2"))
-
-
-
-;; general way of coercing to symbol
-(define+provide/contract (->symbol x)
-  (any/c . -> . symbol?)
-  (if (symbol? x)
-      x
-      (try (string->symbol (->string x)) 
-           (except [exn:fail? (make-coercion-error-handler 'symbol x)]))))
-
-;; general way of coercing to path
-(define+provide/contract (->path x)
-  (any/c . -> . path?)
-  (if (path? x)
-      x 
-      (try
-       (cond 
-         [(url? x) (apply build-path (map path/param-path (url-path x)))]
-         [else (string->path (->string x))])
-       (except [exn:fail? (make-coercion-error-handler 'path x)]))))
-
-
-;; general way of coercing to url
-(define+provide/contract (->url x)
-  (any/c . -> . url?)
-  (try (string->url (->string x))
-       (except [exn:fail? (make-coercion-error-handler 'url x)])))
-
-(define+provide/contract (->complete-path x)
-  (any/c . -> . complete-path?)
-  (try (path->complete-path (->path x))
-       (except [exn:fail? (make-coercion-error-handler 'complete-path x)])))
-
-
-;; general way of coercing to a list
-(define+provide/contract (->list x)
-  (any/c . -> . list?)
-  (if (list? x)
-      x
-      (try
-       (cond 
-         [(vector? x) (vector->list x)]
-         [(set? x) (set->list x)]
-         [else (list x)])
-       (except [exn:fail? (make-coercion-error-handler 'list x)]))))
-
-
-;; general way of coercing to vector
-(define+provide/contract (->vector x)
-  (any/c . -> . vector?)
-  (if (vector? x)
-      x
-      (try
-       (list->vector (->list x))
-       (except [exn:fail? (make-coercion-error-handler 'vector x)]))))
-
-
-
-;; general way of coercing to boolean
-(define+provide/contract (->boolean x)
-  (any/c . -> . boolean?)
-  (if x #t #f))
-
-
-;;
-;; Coercion contracts
-;;
-
-(define-syntax-rule (make-blame-handler try-proc expected-sym)
-  (λ (b)
-    (λ (x)
-      (try (try-proc x)
-           (except [exn:fail? (λ(e)
-                                (raise-blame-error
-                                 b x
-                                 '(expected: "~a" given: "~e")
-                                 expected-sym x))])))))
-
-
-(define+provide coerce/integer?
-  (make-contract
-   #:name 'coerce/integer?
-   #:projection (make-blame-handler ->int 'can-be-integer?)))
-
-(define+provide coerce/string?
-  (make-contract
-   #:name 'coerce/string?
-   #:projection (make-blame-handler ->string 'can-be-string?)))
-
-(define+provide coerce/symbol?
-  (make-contract
-   #:name 'coerce/symbol?
-   #:projection (make-blame-handler ->symbol 'can-be-symbol?)))
-
-(define+provide coerce/path?
-  (make-contract
-   #:name 'coerce/path?
-   #:projection (make-blame-handler ->path 'can-be-path?)))
-
-(define+provide coerce/boolean?
-  (make-contract
-   #:name 'coerce/boolean?
-   #:projection (make-blame-handler ->boolean 'can-be-boolean?)))
-
-

coercion.rkt

@@ -0,0 +1,4 @@
+#lang racket/base
+
+(require "coercion/values.rkt" "coercion/contracts.rkt")
+(provide (all-from-out "coercion/values.rkt" "coercion/contracts.rkt"))

coercion/contracts.rkt

@@ -0,0 +1,46 @@
+#lang racket/base
+(require racket/contract "../define/provide.rkt" "values.rkt")
+
+
+(define-syntax-rule (make-blame-handler try-proc expected-sym)
+  (λ(b)
+    (λ(x)
+      (with-handlers ([exn:fail? (λ(e)
+                                   (raise-blame-error
+                                    b x
+                                    '(expected: "~a" given: "~e")
+                                    expected-sym x))])
+                      (try-proc x)))))
+
+(define+provide coerce/integer?
+  (make-contract
+   #:name 'coerce/integer?
+   #:projection (make-blame-handler ->int 'can-be-integer?)))
+
+
+(define+provide coerce/string?
+  (make-contract
+   #:name 'coerce/string?
+   #:projection (make-blame-handler ->string 'can-be-string?)))
+
+
+(define+provide coerce/symbol?
+  (make-contract
+   #:name 'coerce/symbol?
+   #:projection (make-blame-handler ->symbol 'can-be-symbol?)))
+
+
+(define+provide coerce/path?
+  (make-contract
+   #:name 'coerce/path?
+   #:projection (make-blame-handler ->path 'can-be-path?)))
+
+
+(define+provide coerce/boolean?
+  (make-contract
+   #:name 'coerce/boolean?
+   #:projection (make-blame-handler ->boolean 'can-be-boolean?)))
+
+
+
+

coercion/values.rkt

@@ -0,0 +1,79 @@
+#lang racket/base
+(require net/url xml racket/set)
+(require "../len.rkt" "../define/provide.rkt")
+
+
+(define (make-coercion-error-handler target-format x)
+  (λ(e) (error (format "Can’t convert ~a to ~a" x target-format))))
+
+
+(define+provide (->int x)
+  (with-handlers ([exn:fail? (make-coercion-error-handler 'integer x)])
+    (cond
+      [(or (integer? x) (real? x)) (inexact->exact (floor x))] 
+      [(and (string? x) (> (len x) 0)) (->int (string->number x))]
+      [(symbol? x) (->int (->string x))]
+      [(char? x) (char->integer x)]
+      [else (len x)])))
+
+
+(define+provide (->string x)
+  (if (string? x)
+      x ; fast exit for strings
+      (with-handlers ([exn:fail? (make-coercion-error-handler 'string x)])
+        (cond
+          [(equal? '() x) ""]
+          [(symbol? x) (symbol->string x)]
+          [(number? x) (number->string x)]
+          [(path? x) (path->string x)]
+          [(char? x) (format "~a" x)]
+          [else (error)]))))
+
+
+(define+provide (->symbol x)
+  (if (symbol? x)
+      x
+      (with-handlers ([exn:fail? (make-coercion-error-handler 'symbol x)])
+        (string->symbol (->string x)))))
+
+
+(define+provide (->path x)
+  (if (path? x)
+      x 
+      (with-handlers ([exn:fail? (make-coercion-error-handler 'path x)])
+        (cond 
+          [(url? x) (apply build-path (map path/param-path (url-path x)))]
+          [else (string->path (->string x))]))))
+
+
+(define+provide (->url x)
+  (with-handlers ([exn:fail? (make-coercion-error-handler 'url x)])
+    (string->url (->string x))))
+
+
+(define+provide (->complete-path x)
+  (with-handlers ([exn:fail? (make-coercion-error-handler 'complete-path x)])
+    (path->complete-path (->path x))))
+
+
+(define+provide (->list x)
+  (if (list? x)
+      x
+      (with-handlers ([exn:fail? (make-coercion-error-handler 'list x)])
+        (cond 
+          [(vector? x) (vector->list x)]
+          [(set? x) (set->list x)]
+          [else (list x)]))))
+
+
+(define+provide (->vector x)
+  (if (vector? x)
+      x
+      (with-handlers ([exn:fail? (make-coercion-error-handler 'vector x)])
+        (list->vector (->list x)))))
+
+
+(define+provide (->boolean x)
+  (if x #t #f))
+
+

container.rkt

@@ -1,48 +1,36 @@
 #lang racket/base
-(require racket/contract racket/vector racket/list)
-(require "coerce.rkt" "len.rkt")
+(require "define/contract.rkt")
+(require "coercion.rkt" "len.rkt" racket/list)
 
-(provide get in?)
-
-
-(define/contract (sliceable-container? x)
-  (any/c . -> . boolean?)
+(define (sliceable-container? x)
   (ormap (λ(proc) (proc x)) (list list? string? symbol? vector?)))
 
-(define/contract (gettable-container? x)
-  (any/c . -> . boolean?)
+(define (gettable-container? x)
   (ormap (λ(proc) (proc x)) (list sliceable-container? hash?))) 
 
 
-
-;; general way of fetching an item from a container
-(define/contract (get container start [end #f])
-  ((gettable-container? any/c) ((λ(i)(or (integer? i) (and (symbol? i) (equal? i 'end))))) 
-                               . ->* . any/c)
-  
-  (set! end
-        (if (sliceable-container? container)
-            (cond 
-              ;; treat negative lengths as offset from end (Python style)
-              [(and (integer? end) (< end 0)) (+ (len container) end)]
-              ;; 'end slices to the end
-              [(equal? end 'end) (len container)]
-              ;; default to slice length of 1 (i.e, single-item retrieval)
-              [(equal? end #f) (add1 start)]
-              [else end])
-            end))
-  
-  (define result (cond
-                   ;; for sliceable containers, make a slice
-                   [(list? container) (for/list ([i (range start end)]) 
-                                        (list-ref container i))]
-                   [(vector? container) (for/vector ([i (range start end)])
-                                          (vector-ref container i))] 
-                   [(string? container) (substring container start end)]
-                   [(symbol? container) (->symbol (get (->string container) start end))] 
-                   ;; for hash, just get item
-                   [(hash? container) (hash-ref container start)]
-                   [else #f]))
+(define+provide/contract (get container start [end #f])
+  ((gettable-container? any/c) ((λ(i)(or (integer? i) (and (symbol? i) (equal? i 'end))))) . ->* . any/c)
+  
+  (define result 
+    (with-handlers ([exn:fail? (λ(exn) (error (format "Couldn't get item from ~a" container)))])
+      (let ([end (if (sliceable-container? container)
+                     (cond 
+                       ;; treat negative lengths as offset from end (Python style)
+                       [(and (integer? end) (< end 0)) (+ (len container) end)]
+                       ;; 'end slices to the end
+                       [(equal? end 'end) (len container)]
+                       ;; default to slice length of 1 (i.e, single-item retrieval)
+                       [(equal? end #f) (add1 start)]
+                       [else end])
+                     end)])
+        (cond
+          [(list? container) (for/list ([i (range start end)]) (list-ref container i))]
+          [(vector? container) (for/vector ([i (range start end)]) (vector-ref container i))] 
+          [(string? container) (substring container start end)]
+          [(symbol? container) (->symbol (get (->string container) start end))] 
+          [(hash? container) (hash-ref container start)]
+          [else (error)]))))
   
   ;; don't return single-item results inside a list
   (if (and (sliceable-container? container) (= (len result) 1))
@@ -50,18 +38,12 @@
       result))
 
 
-
-
-;; general way of testing for membership (à la Python 'in')
-;; put item as first arg so function can use infix notation
-;; (item . in . container)
-(define/contract (in? item container)
+(define+provide/contract (in? item container)
   (any/c any/c . -> . coerce/boolean?)
   (cond
     [(list? container) (member item container)] ; returns #f or sublist beginning with item
-    [(vector? container) (vector-member item container)] ; returns #f or zero-based item index
-    [(hash? container) 
-     (and (hash-has-key? container item) (get container item))] ; returns #f or hash value
-    [(string? container) (regexp-match (->string item) (->string container))] ; returns #f or substring beginning with item
-    [(symbol? container) ((->string item) . in? . (->string container))] ; returns #f or subsymbol (?!) beginning with item
+    [(vector? container) (member item (vector->list container))] ; returns #f or sublist beginning with item
+    [(hash? container) (and (hash-has-key? container item) (get container item))] ; returns #f or hash value
+    [(string? container) (and (string? item) (regexp-match (->string item) (->string container)))] ; returns #f or substring beginning with item
+    [(symbol? container) (and (symbol? item) ((->string item) . in? . (->string container)))] ; returns #f or subsymbol (?!) beginning with item
     [else #f]))

debug.rkt

@@ -2,14 +2,12 @@
 
 (provide report describe)
 
-; report the current value of the variable, then return it
 (define-syntax-rule (report var)
   (begin 
     (displayln (format "~a = ~a" 'var var) (current-error-port)) 
     var))
 
-
-(require (prefix-in williams: (planet williams/describe/describe)))
+(require (prefix-in williams: describe))
 
 (define (describe x)
   (parameterize ([current-output-port (current-error-port)])

define.rkt

@@ -1,40 +1,5 @@
 #lang racket/base
-(require (for-syntax racket/base))
-(require racket/contract)
 
-(provide define+provide define+provide/contract define/contract+provide)
+(require "define/provide.rkt" "define/contract.rkt")
 
-;; each define macro recursively converts any form of define
-;; into its lambda form (define name body ...) and then operates on that.
-
-(define-syntax (define+provide stx)
-  (syntax-case stx ()
-    [(_ (proc arg ... . rest-arg) body ...)
-     #'(define+provide proc
-         (λ(arg ... . rest-arg) body ...))]
-    [(_ name body ...)
-     #'(begin
-         (provide name)
-         (define name body ...))]))
-
-
-(define-syntax (define+provide/contract stx)
-  (syntax-case stx ()
-    [(_ (proc arg ... . rest-arg) contract body ...)
-     #'(define+provide/contract proc contract
-         (λ(arg ... . rest-arg) body ...))]
-    [(_ name contract body ...)
-     #'(begin
-         (provide (contract-out [name contract]))
-         (define name body ...))]))
-
-
-(define-syntax (define/contract+provide stx)
-  (syntax-case stx ()
-    [(_ (proc arg ... . rest-arg) contract body ...)
-     #'(define/contract+provide proc contract
-         (λ(arg ... . rest-arg) body ...))]
-    [(_ name contract body ...)
-     #'(begin
-         (provide name)
-         (define/contract name contract body ...))]))
+(provide (all-from-out "define/provide.rkt" "define/contract.rkt"))

define/contract.rkt

@@ -0,0 +1,41 @@
+#lang racket/base
+(require (for-syntax racket/base))
+(require racket/contract)
+
+(provide (all-defined-out) (all-from-out racket/contract))
+
+;; each define macro recursively converts any form of define
+;; into its lambda form (define name body ...) and then operates on that.
+
+(define-syntax (define+provide+safe stx)
+  (syntax-case stx ()
+    [(_ (proc arg ... . rest-arg) contract body ...)
+     #'(define+provide+safe proc contract
+         (λ(arg ... . rest-arg) body ...))]
+    [(_ name contract body ...)
+     #'(begin
+         (define name body ...)
+         (provide name)
+         (module+ safe 
+           (provide (contract-out [name contract]))))]))
+
+(define-syntax (define+provide/contract stx)
+  (syntax-case stx ()
+    [(_ (proc arg ... . rest-arg) contract body ...)
+     #'(define+provide/contract proc contract
+         (λ(arg ... . rest-arg) body ...))]
+    [(_ name contract body ...)
+     #'(begin
+         (provide (contract-out [name contract]))
+         (define name body ...))]))
+
+
+(define-syntax (define/contract+provide stx)
+  (syntax-case stx ()
+    [(_ (proc arg ... . rest-arg) contract body ...)
+     #'(define/contract+provide proc contract
+         (λ(arg ... . rest-arg) body ...))]
+    [(_ name contract body ...)
+     #'(begin
+         (provide name)
+         (define/contract name contract body ...))]))

define/provide.rkt

@@ -0,0 +1,14 @@
+#lang racket/base
+(require (for-syntax racket/base))
+
+(provide (all-defined-out))
+
+(define-syntax (define+provide stx)
+  (syntax-case stx ()
+    [(_ (proc arg ... . rest-arg) body ...)
+     #'(define+provide proc
+         (λ(arg ... . rest-arg) body ...))]
+    [(_ name body ...)
+     #'(begin
+         (provide name)
+         (define name body ...))]))

exception.rkt

@@ -1,9 +1,8 @@
 #lang racket/base
 (require (for-syntax racket/base))
 
-(provide try)
+(provide (all-defined-out))
 
-;; Pythonlike try/except 
 (define-syntax (try stx)
    (syntax-case stx ()
      [(_ body ... (except tests ...))

info.rkt

@@ -1,3 +1,4 @@
 #lang info
 (define collection "sugar")
 (define scribblings '(("scribblings/sugar.scrbl" ())))
+(define deps '("describe"))

len.rkt

@@ -1,21 +1,15 @@
 #lang racket/base
-(require racket/contract racket/set)
+(require racket/set)
 
 (provide len)
 
-(define/contract (has-length? x)
-  (any/c . -> . boolean?)
-  (ormap (λ(proc) (proc x)) (list list? string? symbol? vector? hash? set?)))
-
-;; general way of asking for length
-(define/contract (len x)
-  (any/c . -> . (or/c integer? #f))
+(define (len x)
   (cond
     [(list? x) (length x)]
     [(string? x) (string-length x)]
     [(symbol? x) (len (symbol->string x))]
-    [(vector? x) (len (vector->list x))]
+    [(vector? x) (vector-length x)]
     [(hash? x) (len (hash-keys x))]
-    [(set? x) (len (set->list x))]
     [(integer? x) (len (number->string x))]
+    [(set? x) (len (set->list x))]
     [else (error "len: can’t calculate length of" x)]))

list.rkt

@@ -1,13 +1,12 @@
 #lang racket/base
-(require racket/contract racket/list racket/set)
-(require "define.rkt" "len.rkt" "coerce.rkt")
+(require racket/list racket/set)
+(require "define/contract.rkt" "len.rkt" "coercion/values.rkt")
 
-;; trim from beginning & end of list
 (define+provide/contract (trim items test-proc)
   (list? procedure? . -> . list?)
   (dropf-right (dropf items test-proc) test-proc))
 
-;; convert a list into a list of slices that are len long (last one might be shorter)
+
 (define+provide/contract (list->slices xs len)
   (list? integer? . -> . (listof list?))
   (cond
@@ -16,34 +15,19 @@
     [else (cons (take xs len) (list->slices (drop xs len) len))]))
 
 
-
-
-;; split list into list of sublists using test-proc
 (define+provide/contract (splitf-at* xs split-test)
-  
-  ;; todo: better error message when split-test is not a predicate
   (list? predicate/c . -> . (listof list?))
-  (define (&splitf-at* xs [acc '()]) ; use acc for tail recursion
+  (let loop ([xs (trim xs split-test)] [acc '()]) 
     (if (empty? xs) 
-        ;; reverse because accumulation is happening backward 
-        ;; (because I'm using cons to push latest match onto front of list)
-        (reverse acc)
+        (reverse acc)  ; because accumulation is happening backward 
         (let-values ([(item rest) 
                       ;; drop matching elements from front
                       ;; then split on nonmatching 
                       ;; = nonmatching item + other elements (which will start with matching)
                       (splitf-at (dropf xs split-test) (compose1 not split-test))])
-          ;; recurse, and store new item in accumulator
-          (&splitf-at* rest (cons item acc)))))
-  
-  ;; trim off elements matching split-test
-  (&splitf-at* (trim xs split-test)))
+          (loop rest (cons item acc))))))
 
 
-;; count incidence of elements in a list
-;; returns hash where key is element, value is incidence
-;; todo: move this? Ideally it would be in tools,
-;; but that would create a circular dependency.
 (define+provide/contract (count-incidence x)
   (list? . -> . hash?)
   (define counter (make-hash))
@@ -60,6 +44,7 @@
     [(string? x) (members-unique? (string->list x))]
     [else (error (format "members-unique cannot be determined for ~a" x))]))
 
+
 (define+provide/contract (members-unique?/error x)
   (any/c . -> . boolean?)
   (define result (members-unique? x))

main.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require
-  "coerce.rkt"
+  "coercion.rkt"
   "container.rkt"
   "debug.rkt"
   "define.rkt"
@@ -11,11 +11,12 @@
   "len.rkt"
   "exception.rkt"
   "scribble.rkt"
+  "tree.rkt"
   "values.rkt")
 
 (provide 
  (all-from-out
-  "coerce.rkt"
+  "coercion.rkt"
   "container.rkt"
   "debug.rkt"
   "define.rkt"
@@ -25,4 +26,5 @@
   "len.rkt"
   "exception.rkt"
   "scribble.rkt"
+  "tree.rkt"
   "values.rkt"))

misc.rkt

@@ -1,13 +1,9 @@
 #lang racket/base
 (require (for-syntax racket/base))
-(require racket/contract)
+(require "define/contract.rkt")
 
-(provide (contract-out
-          [bytecount->string (integer? . -> . string?)])
-          when/splice)
-
-;; convert a bytecount into a string
-(define (bytecount->string bytecount)
+(define+provide/contract (bytecount->string bytecount)
+  (integer? . -> . string?)
   (define (format-with-threshold threshold suffix)
     ;; upconvert by factor of 100 to get two digits after decimal
     (format "~a ~a" (exact->inexact (/ (round ((* bytecount 100) . / . threshold)) 100)) suffix))
@@ -28,6 +24,7 @@
 ;; for use inside quasiquote
 ;; instead of ,(when ...) use ,@(when/splice ...)
 ;; to avoid voids
+(provide when/splice)
 (define-syntax (when/splice stx)
   (syntax-case stx ()
     [(_ test body)

scribble.rkt

@@ -1,7 +1,6 @@
 #lang racket
 (require (for-syntax racket/base))
-(require "coerce.rkt")
-
+(require "coercion/values.rkt")
 
 (provide when/block)
 
@@ -13,4 +12,7 @@
 (define-syntax (when/block stx)
   (syntax-case stx ()
     [(_ condition body ...)
-  #'(if condition (string-append* (map ->string (list body ...))) "")]))
+     #'(if condition (string-append* 
+                      (with-handlers ([exn:fail? (λ(exn) (error (format "when/block: ~a" (exn-message exn))))])
+                        (map ->string (list body ...))))
+           "")]))

string.rkt

@@ -1,23 +1,14 @@
 #lang racket/base
-(require racket/contract)
-(require "coerce.rkt" "container.rkt" "len.rkt" "exception.rkt")
+(require "define/contract.rkt" "coercion.rkt")
 
-(provide starts-with? ends-with? stringish?)
 
-;; stringish: data type that can be trivially converted to string
-;; todo: merge this with pathish
-(define/contract (stringish? x)
-  (any/c . -> . boolean?)
-  (try (->boolean (->string x)) (except [exn:fail? (λ(e) #f)])))
+(define+provide/contract (starts-with? str starter)
+  (string? string? . -> . coerce/boolean?)
+  (define starter-pattern (regexp (format "^~a" starter)))
+  (regexp-match starter-pattern str))
 
-;; python-style string testers
-(define/contract (starts-with? str starter)
-  (stringish? stringish? . -> . boolean?)
-  (let ([str (->string str)]
-        [starter (->string starter)])
-    (and (<= (len starter) (len str)) (equal? (get str 0 (len starter)) starter))))
 
-
-(define/contract (ends-with? str ender)
-  (string? string? . -> . boolean?)
-  (and (<= (len ender) (len str)) (equal? (get str (- (len str) (len ender)) 'end) ender)))
+(define+provide/contract (ends-with? str ender)
+  (string? string? . -> . coerce/boolean?)
+  (define ender-pattern (regexp (format "~a$" ender)))
+  (regexp-match ender-pattern str))

tests.rkt

@@ -1,13 +1,13 @@
 #lang racket/base
 
 (require rackunit net/url racket/set)
-(require "coerce.rkt" "container.rkt" "string.rkt" "list.rkt" "len.rkt")
+(require "main.rkt")
 
 (check-equal? (->string "foo") "foo")
 (check-equal? (->string '()) "")
 (check-equal? (->string 'foo) "foo")
 (check-equal? (->string 123) "123")
-(check-equal? (->string (string->url "foo/bar.html")) "foo/bar.html")
+;(check-equal? (->string (string->url "foo/bar.html")) "foo/bar.html")
 (define file-name-as-text "foo.txt")
 (check-equal? (->string (string->path file-name-as-text)) file-name-as-text)
 (check-equal? (->string #\¶) "¶")
@@ -90,5 +90,18 @@
 
 ;  (check-equal? (trim (list "\n" " " 1 2 3 "\n") whitespace?) '(1 2 3))
 (check-equal? (trim (list 1 3 2 4 5 6 8 9 13) odd?) '(2 4 5 6 8))
-; (check-equal? (splitf-at* '("foo" " " "bar" "\n" "\n" "ino") whitespace?) '(("foo")("bar")("ino")))
+;(check-equal? (splitf-at* '("foo" " " "bar" "\n" "\n" "ino") whitespace?) '(("foo")("bar")("ino")))
 (check-equal? (splitf-at* '(1 2 3 4 5 6) even?) '((1)(3)(5)))
+
+
+(check-equal? (filter-tree string? '(p)) null)
+(check-equal? (filter-tree string? '(p "foo" "bar")) '("foo" "bar"))
+(check-equal? (filter-tree string? '(p "foo" (p "bar"))) '("foo" ("bar")))
+(check-equal? (filter-tree (λ(i) (and (string? i) (equal? i "\n"))) '("\n" (foo "bar") "\n")) '("\n" "\n"))
+(check-equal? (filter-not-tree string? '(p)) '(p))
+(check-equal? (filter-not-tree string? '(p "foo" "bar")) '(p))
+(check-equal? (filter-not-tree string? '(p "foo" (p "bar"))) '(p (p)))
+;(check-equal? (filter-tree (λ(i) (and (tagged-xexpr? i) (equal? 'em (car i)))) '(p "foo" (em "bar"))) '(p "foo"))
+
+(check-equal? (map-tree (λ(i) (if (number? i) (* 2 i) i)) '(p 1 2 3 (em 4 5))) '(p 2 4 6 (em 8 10)))
+(check-equal? (map-tree (λ(i) (if (symbol? i) 'foo i)) '(p 1 2 3 (em 4 5))) '(foo 1 2 3 (foo 4 5)))

tree.rkt

@@ -1,51 +1,31 @@
 #lang racket/base
-(require racket/list racket/contract)
-(require "define.rkt")
+(require "define/contract.rkt")
 
 (module+ test (require rackunit))
 
-;; apply filter proc recursively
 (define+provide/contract (filter-tree proc tree)
   (procedure? list? . -> . list?)
   (define (remove-empty x)
     (cond
-      [(list? x) (filter-not empty? (map remove-empty x))]
+      [(list? x) (filter (compose1 not null?) (map remove-empty x))]
       [else x]))
   
   (define (filter-tree-inner proc x)
     (cond
       [(list? x) (map (λ(i) (filter-tree-inner proc i)) x)]
-      [else (if (proc x) x empty)]))
+      [else (if (proc x) x null)]))
   
   (remove-empty (filter-tree-inner proc tree)))
  
 
-(module+ test
-  (check-equal? (filter-tree string? '(p)) empty)
-  (check-equal? (filter-tree string? '(p "foo" "bar")) '("foo" "bar"))
-  (check-equal? (filter-tree string? '(p "foo" (p "bar"))) '("foo" ("bar")))
-  (check-equal? (filter-tree (λ(i) (and (string? i) (equal? i "\n"))) '("\n" (foo "bar") "\n")) '("\n" "\n"))) 
-
-;; apply filter-not proc recursively
 (define+provide/contract (filter-not-tree proc tree)
   (procedure? list? . -> . list?)
   (filter-tree (λ(i) (not (proc i))) tree))
 
-(module+ test
-  (check-equal? (filter-not-tree string? '(p)) '(p))
-  (check-equal? (filter-not-tree string? '(p "foo" "bar")) '(p))
-  (check-equal? (filter-not-tree string? '(p "foo" (p "bar"))) '(p (p)))
-  ;(check-equal? (filter-tree (λ(i) (and (tagged-xexpr? i) (equal? 'em (car i)))) '(p "foo" (em "bar"))) '(p "foo"))
-  )
-
 
-;; todo: doc this function
 (define+provide/contract (map-tree proc tree)
   (procedure? list? . -> . list?)
   (cond 
     [(list? tree) (map (λ(i) (map-tree proc i)) tree)]
     [else (proc tree)]))
 
-(module+ test
-  (check-equal? (map-tree (λ(i) (if (number? i) (* 2 i) i)) '(p 1 2 3 (em 4 5))) '(p 2 4 6 (em 8 10)))
-  (check-equal? (map-tree (λ(i) (if (symbol? i) 'foo i)) '(p 1 2 3 (em 4 5))) '(foo 1 2 3 (foo 4 5))))