tidying

beautiful-racket-demo/bf-demo/test-tokenizer.rkt

@@ -1,7 +1,8 @@
 #lang br
 (require brag/support)
+(provide tokenize)
 
-(define+provide (tokenize ip)
+(define (tokenize ip)
   (define get-token
     (lexer
      [(char-set "><-.,+[]") lexeme]

beautiful-racket-lib/br/case.rkt

@@ -1,24 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base) br/define)
-(provide (all-defined-out))
-
-(define-macro (define-case-macro ID PRED)
-  #'(define-syntax (ID stx)
-      (syntax-case stx ()
-        [(_ test-val
-            [(match-vals) . result] (... ...)
-            [else . else-result])
-         #'(cond
-             [(PRED test-val '(match-vals)) . result] (... ...)
-             [else . else-result])]
-        [(_ test-val
-            match-clause (... ...))
-         #'(ID test-val
-               match-clause (... ...)
-               [else (error 'ID "no match")])])))
-
-;; like case but strictly uses `eq?` comparison (as opposed to `equal?`)
-(define-case-macro caseq memq)
-
-;; `eqv?` is OK for chars (same as `char=?`)
-(define-case-macro casev memv)

beautiful-racket-lib/br/cond.rkt

@@ -1,6 +1,5 @@
 #lang racket/base
-(require (for-syntax racket/base br/syntax)
-         br/define)
+(require (for-syntax racket/base) br/define)
 (provide (all-defined-out))
 
 (define-macro (until COND EXPR ...)
@@ -15,13 +14,6 @@
         EXPR ...
         (loop))))
 
-(define-macro (forever . EXPRS)
-  ;; todo: would be better with a syntax parameter
-  (with-pattern
-   ([STOP (datum->syntax #'EXPRS 'stop)])
-   #'(let/ec STOP
-       (while #t . EXPRS))))
-
 (module+ test
   (require rackunit)
   (check-equal? (let ([x 5])

beautiful-racket-lib/br/datum.rkt

@@ -1,31 +1,32 @@
 #lang racket/base
-(require (for-syntax racket/base br/syntax) br/define)
-(provide (except-out (all-defined-out) string->datum))
+(provide format-datum format-datums)
 
 (define (blank? str)
-  (or (zero? (string-length str))
-      (andmap char-blank? (string->list str))))
+  (for/and ([c (in-string str)])
+    (char-blank? c)))
 
 ;; read "foo bar" the same way as "(foo bar)" 
 ;; otherwise "bar" is dropped, which is too astonishing
 (define (string->datum str)
-  (if (blank? str)
-      (void)
+  (unless (blank? str)
     (let ([result (read (open-input-string (format "(~a)" str)))])
       (if (= (length result) 1)
           (car result)
           result))))
 
-(define (datum? x)
-  (or (list? x) (symbol? x)))
+(define (datum? x) (or (list? x) (symbol? x)))
 
 (define (format-datum datum-template . args)
-  (string->datum (apply format (format "~a" datum-template) (map (λ(arg) (if (syntax? arg)
+  (unless (datum? datum-template)
+    (raise-argument-error 'format-datums "datum?" datum-template))
+  (string->datum (apply format (format "~a" datum-template)
+                        (map (λ (arg) (if (syntax? arg)
                                           (syntax->datum arg)
                                           arg)) args))))
 
-;; todo: rephrase errors from `format` or `map` in terms of `format-datums`
 (define (format-datums datum-template . argss)
+  (unless (datum? datum-template)
+    (raise-argument-error 'format-datums "datum?" datum-template))
   (apply map (λ args (apply format-datum datum-template args)) argss))
 
 (module+ test

beautiful-racket-lib/br/debug.rkt

@@ -1,6 +1,5 @@
 #lang racket/base
-(require (for-syntax racket/base br/syntax)
-         br/define)
+(require (for-syntax racket/base br/syntax) br/define)
 (provide (all-defined-out))
 
 (define-macro-cases report
@@ -11,9 +10,7 @@
        expr-result)])
 
 (define-macro-cases report-datum
-  [(_ STX-EXPR)
-   (with-pattern ([datum (syntax->datum #'STX-EXPR)])
-     #'(report-datum STX-EXPR datum))]
+  [(_ STX-EXPR) #`(report-datum STX-EXPR #,(syntax->datum #'STX-EXPR))]
   [(_ STX-EXPR NAME)
    #'(let () 
        (eprintf "~a = ~v\n" 'NAME (syntax->datum STX-EXPR))

beautiful-racket-lib/br/define.rkt

@@ -1,26 +1,13 @@
 #lang racket/base
-(require
-  racket/function
+(require racket/function
          (for-syntax racket/base
                      syntax/parse
-              br/private/syntax-flatten
                      br/private/generate-literals
                      syntax/define))
 (provide (all-defined-out)
          (for-syntax with-shared-id))
 
-(module+ test
-  (require rackunit))
-
-
-(define-syntax (define+provide stx)
-  (with-syntax ([(id lambda-exp)
-                 (let-values ([(id-stx body-exp-stx)
-                               (normalize-definition stx (datum->syntax stx 'λ) #t #t)])
-                   (list id-stx body-exp-stx))])
-    #'(begin
-        (provide id)
-        (define id lambda-exp))))
+(module+ test (require rackunit))
 
 (begin-for-syntax
   ;; expose the caller context within br:define macros with syntax parameter
@@ -28,7 +15,6 @@
   (provide caller-stx)
   (define-syntax-parameter caller-stx (λ(stx) (error 'caller-stx-not-parameterized))))
 
-
 (define-syntax (define-cases stx)
   (syntax-parse stx
     #:literals (syntax)
@@ -73,7 +59,7 @@
 
 
 (module+ test
-  (require rackunit racket/port)
+  (require racket/port)
   (parameterize ([current-output-port (open-output-nowhere)])
     (check-equal? (let ()
                     (debug-define-macro (foo X Y Z)
@@ -238,9 +224,9 @@
   (check-equal? (elseop "+") 'got-arg)
   (check-equal? (elseop "+" 42) 'got-else)
 
-  (check-exn exn:fail:syntax? (λ _ (expand-once #'(define-macro-cases no-cases))))
+  (check-exn exn:fail:syntax? (λ () (expand-once #'(define-macro-cases no-cases))))
 
-  (check-exn exn:fail:syntax? (λ _ (expand-once #'(define-macro-cases badelseop
+  (check-exn exn:fail:syntax? (λ () (expand-once #'(define-macro-cases badelseop
                                                      [else #''got-else]
                                                      [(_ _arg) #''got-arg]))))
 

beautiful-racket-lib/br/drracket.rkt

@@ -1,11 +0,0 @@
-#lang racket/base
-(require racket/class
-         racket/draw)
-
-(provide (all-defined-out))
-(define (make-drracket-button . args)
-  (define label (or (findf string? args) "untitled"))
-  (define bitmap (or (findf (λ(arg) (is-a? arg bitmap%)) args) (make-object bitmap% 16 16)))
-  (define callback (or (findf procedure? args) (λ(drr-frame) (void))))
-  (define number (or (findf (λ(arg) (or (real? arg) (equal? #f arg))) args) #f))
-  (list label bitmap callback number))

beautiful-racket-lib/br/get-info.rkt

@@ -1,19 +1,19 @@
 #lang racket
+(require racket/class)
 (provide (all-defined-out))
 
-(require racket/class)
 (define (indenter t pos)
   (with-handlers ([exn:fail? (λ (exn) #f)]) ; this function won't work until gui-lib 1.26
     (send t compute-racket-amount-to-indent pos (λ(x)
                                                   (case x
-                                                    [("with-pattern" "with-shared-id") 'lambda]
-                                                    [("define-macro") 'define]
+                                                    [("with-pattern"
+                                                      "with-shared-id") 'lambda]
+                                                    [("define-macro"
+                                                      "define-macro-cases"
+                                                      "define-cases") 'define]
                                                     [else #f])))))
 
 (define (br-get-info key default default-filter)
   (case key
-    #;[(color-lexer)
-       (dynamic-require 'syntax-color/default-lexer 'default-lexer)]
     [(drracket:indentation) indenter]
-    [else
-     (default-filter key default)]))
+    [else (default-filter key default)]))

beautiful-racket-lib/br/list.rkt

@@ -12,3 +12,13 @@
   #'(let ([x (car ID)])
       (set! ID (cdr ID))
       x))
+
+(module+ test
+  (require rackunit)
+  (check-equal? '(1 2 3) (values->list (values 1 2 3)))
+  (check-equal? (let ([xs '(2 3)])
+                  (push! xs 1)
+                  xs) '(1 2 3))
+  (check-equal? (let ([xs '(1 2 3)])
+                  (define x (pop! xs))
+                  (cons x xs)) '(1 2 3)))

beautiful-racket-lib/br/main.rkt

@@ -1,10 +1,10 @@
 #lang racket/base
 (require racket/provide racket/list racket/string racket/format racket/match racket/port  racket/function racket/provide
-         br/define br/syntax br/datum br/debug br/cond br/case br/exception br/list racket/class racket/vector br/reader-utils
+         br/define br/syntax br/datum br/debug br/cond br/exception br/list racket/class racket/vector br/reader-utils
          (for-syntax racket/base racket/syntax br/syntax br/debug br/define br/datum))
 (provide (all-from-out racket/base)
          (all-from-out racket/list racket/string racket/format racket/match racket/port racket/function racket/provide
-                       br/syntax br/datum br/debug br/cond br/case br/exception br/list racket/class racket/vector br/define br/reader-utils)
+                       br/syntax br/datum br/debug br/cond br/exception br/list racket/class racket/vector br/define br/reader-utils)
          (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug br/datum))
          (for-syntax caller-stx with-shared-id)) ; from br/define