back out `br` libs

sugar/unstable/case.rkt

@@ -1,9 +1,10 @@
 #lang racket/base
-(require (for-syntax racket/base racket/syntax br/syntax) br/define)
+(require (for-syntax racket/base racket/syntax))
 (provide (all-defined-out))
 
-(define-macro (define-case-macro ID PRED)
-  #'(define-macro-cases ID
+(define-syntax-rule (define-case-macro ID PRED)
+  (define-syntax (ID stx)
+    (syntax-case stx ()
       [(_ TEST-VAL [(MATCH0 . MATCH-VALS) . RESULT] (... ...) [else . ELSE-RESULT])
        #'(cond
            [(PRED TEST-VAL '(MATCH0 . MATCH-VALS)) . RESULT] (... ...)
@@ -11,7 +12,7 @@
       [(_ TEST-VAL MATCH-CLAUSE (... ...))
        #'(ID TEST-VAL
              MATCH-CLAUSE (... ...)
-             [else (error 'ID (format "no match for ~a" TEST-VAL))])]))
+             [else (error 'ID (format "no match for ~a" TEST-VAL))])])))
 
 ;; like case but strictly uses `eq?` comparison (as opposed to `equal?`)
 (define-case-macro caseq memq)
@@ -19,6 +20,7 @@
 
 
 (require sugar/debug)
-(define-macro-cases cond-report
-  [(_ [COND . BODY] ... [else . ELSE-BODY]) #'(cond [(report COND) (report (let () (void) . BODY))] ... [else . ELSE-BODY])]
-  [(_ [COND . BODY] ... ) #'(cond-report [COND . BODY] ... [else (void)])]) 
+(define-syntax (cond-report stx)
+  (syntax-case stx ()
+    [(_ [COND . BODY] ... [else . ELSE-BODY]) #'(cond [(report COND) (report (let () (void) . BODY))] ... [else . ELSE-BODY])]
+    [(_ [COND . BODY] ... ) #'(cond-report [COND . BODY] ... [else (void)])])) 

sugar/unstable/class.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require (for-syntax racket/base racket/syntax br/syntax) br/define racket/class)
+(require (for-syntax racket/base racket/syntax) racket/class)
 (provide (all-defined-out))
 
 (define string%
@@ -17,69 +17,79 @@
     (super-new)
     (define/public (addContent val) (make-object string% val))))
 
-(define-macro (as-method ID)
-  (with-pattern ([PRIVATE-ID (generate-temporary #'ID)])
-                #'(begin
-                    (public [PRIVATE-ID ID])
-                    (define (PRIVATE-ID . args) (apply ID this args)))))
+(define-syntax (as-method stx)
+  (syntax-case stx ()
+    [(_ ID) (with-syntax ([PRIVATE-ID (generate-temporary #'ID)])
+              #'(begin
+                  (public [PRIVATE-ID ID])
+                  (define (PRIVATE-ID . args) (apply ID this args))))]))
 
 
-(define-macro (as-methods ID ...)
-  #'(begin (as-method ID) ...))
+(define-syntax-rule (as-methods ID ...)
+  (begin (as-method ID) ...))
 
 
-(define-macro (define-instance ID (MAKER BASE-CLASS . ARGS))
-  (with-pattern ([ID-CLASS (prefix-id #'BASE-CLASS ":" #'ID)])
-                #'(define ID (let ([ID-CLASS (class BASE-CLASS (super-new))])
-                               (MAKER ID-CLASS . ARGS)))))
+(define-syntax (define-instance stx)
+  (syntax-case stx ()
+    [(_ ID (MAKER BASE-CLASS . ARGS))
+     (with-syntax ([ID-CLASS (format-id stx "~a:~a" (syntax->datum #'BASE-CLASS) (syntax->datum #'ID))])
+       #'(define ID (let ([ID-CLASS (class BASE-CLASS (super-new))])
+                      (MAKER ID-CLASS . ARGS))))]))
 
 
-(define-macro (define-class-predicates ID)
-  (with-pattern ([+ID (prefix-id "+" #'ID)]
-                 [ID? (suffix-id #'ID "?")])
-                #'(begin (define (ID? x) (is-a? x ID))
-                         (define (+ID . args) (apply make-object ID args)))))
+(define-syntax (define-class-predicates stx)
+  (syntax-case stx ()
+    [(_ ID)
+     (with-syntax ([+ID (format-id #'ID "+~a" (syntax->datum #'ID))]
+                   [ID? (format-id #'ID "~a?" (syntax->datum #'ID))])
+       #'(begin (define (ID? x) (is-a? x ID))
+                (define (+ID . args) (apply make-object ID args))))]))
 
-(define-macro (define-subclass*/interfaces SUPERCLASS INTERFACES (ID . INIT-ARGS) . BODY)
-  #'(begin
-      (define ID (class* SUPERCLASS INTERFACES (init-field . INIT-ARGS) . BODY))
-      (define-class-predicates ID)))
+(define-syntax-rule (define-subclass*/interfaces SUPERCLASS INTERFACES (ID . INIT-ARGS) . BODY)
+  (begin
+    (define ID (class* SUPERCLASS INTERFACES (init-field . INIT-ARGS) . BODY))
+    (define-class-predicates ID)))
 
-(define-macro (define-subclass/interfaces SUPERCLASS INTERFACES (ID . INIT-ARGS) . BODY)
-  #'(define-subclass*/interfaces SUPERCLASS INTERFACES (ID . INIT-ARGS) (super-new) . BODY))
+(define-syntax-rule (define-subclass/interfaces SUPERCLASS INTERFACES (ID . INIT-ARGS) . BODY)
+  (define-subclass*/interfaces SUPERCLASS INTERFACES (ID . INIT-ARGS) (super-new) . BODY))
 
-(define-macro (define-subclass* SUPERCLASS (ID . INIT-ARGS) . BODY)
-  #'(define-subclass*/interfaces SUPERCLASS () (ID . INIT-ARGS) . BODY))
+(define-syntax-rule (define-subclass* SUPERCLASS (ID . INIT-ARGS) . BODY)
+  (define-subclass*/interfaces SUPERCLASS () (ID . INIT-ARGS) . BODY))
 
-(define-macro (define-subclass SUPERCLASS (ID . INIT-ARGS) . BODY)
-  #'(define-subclass* SUPERCLASS (ID . INIT-ARGS) (super-new) . BODY))
+(define-syntax-rule (define-subclass SUPERCLASS (ID . INIT-ARGS) . BODY)
+  (define-subclass* SUPERCLASS (ID . INIT-ARGS) (super-new) . BODY))
 
 
-(define-macro (push-field! FIELD O EXPR)
-  #'(set-field! FIELD O (cons EXPR (get-field FIELD O))))
+(define-syntax-rule (push-field! FIELD O EXPR)
+  (set-field! FIELD O (cons EXPR (get-field FIELD O))))
 
 
-(define-macro (push-end-field! FIELD O EXPR)
-  #'(set-field! FIELD O (append (get-field FIELD O) (list EXPR))))
+(define-syntax-rule (push-end-field! FIELD O EXPR)
+  (set-field! FIELD O (append (get-field FIELD O) (list EXPR))))
 
-(define-macro (pop-field! FIELD O)
-  #'(let ([xs (get-field FIELD O)])
-      (set-field! FIELD O (cdr xs))
-      (car xs)))
+(define-syntax-rule (pop-field! FIELD O)
+  (let ([xs (get-field FIELD O)])
+    (set-field! FIELD O (cdr xs))
+    (car xs)))
 
-(define-macro-cases increment-field!
-  [(_ FIELD O)  #'(increment-field! FIELD O 1)]
-  [(_ FIELD O EXPR)
-   #'(begin (set-field! FIELD O (+ (get-field FIELD O) EXPR)) (get-field FIELD O))])
+(define-syntax (increment-field! stx)
+  (syntax-case stx ()
+    [(_ FIELD O)  #'(increment-field! FIELD O 1)]
+    [(_ FIELD O EXPR)
+     #'(begin (set-field! FIELD O (+ (get-field FIELD O) EXPR)) (get-field FIELD O))]))
 
 
-(define-macro (getter-field/override [ID . EXPRS])
-  (syntax-property #'(getter-field [ID . EXPRS]) 'override #t))
+(define-syntax (getter-field/override stx)
+  (syntax-case stx ()
+    [(_ [ID . EXPRS])
+     (syntax-property #'(getter-field [ID . EXPRS]) 'override #t)]))
 
 
-(define-macro (getter-field [ID . EXPRS])
-  (with-pattern ([_ID (prefix-id "_" #'ID)])
-                #`(begin
-                    (field [(ID _ID)  . EXPRS])
-                    (public (_ID ID))
-                    (#,(if (syntax-property caller-stx 'override) #'define/override #'define) (_ID) ID))))
+(define-syntax (getter-field stx)
+  (syntax-case stx ()
+    [(_ [ID . EXPRS])
+     (with-syntax ([_ID (format-id #'ID "_~a" (syntax->datum #'ID))])
+       #`(begin
+           (field [(ID _ID)  . EXPRS])
+           (public (_ID ID))
+           (#,(if (syntax-property stx 'override) #'define/override #'define) (_ID) ID)))]))

sugar/unstable/js.rkt

@@ -1,27 +1,28 @@
 #lang racket/base
-(require racket/class (for-syntax racket/base racket/syntax br/syntax) br/define racket/dict)
+(require racket/class (for-syntax racket/base racket/syntax) racket/dict)
 (provide (all-defined-out))
 
 
 ;; js-style `push`, which appends to end of list
-(define-macro (push-end! ID THING)
-  #'(set! ID (append ID (list THING))))
+(define-syntax-rule (push-end! ID THING)
+  (set! ID (append ID (list THING))))
 
 
-(define-macro-cases increment!
-  [(_ ID)  #'(increment! ID 1)]
-  [(_ ID EXPR)
-   #'(begin (set! ID (+ ID EXPR)) ID)])
+(define-syntax (increment! stx)
+  (syntax-case stx ()
+    [(_ ID)  #'(increment! ID 1)]
+    [(_ ID EXPR)
+     #'(begin (set! ID (+ ID EXPR)) ID)]))
 
 (module+ test
   (define xs '(1 2 3))
   (push-end! xs 4)
   (check-equal? xs '(1 2 3 4)))
 
-(define-macro (+= ID THING) #'(begin (set! ID (+ ID THING)) ID)) 
-(define-macro (++ ID) #'(+= ID 1))
-(define-macro (-- ID) #'(+= ID -1))
-(define-macro (-= ID THING) #'(+= ID (- THING)))
+(define-syntax-rule (+= ID THING) (begin (set! ID (+ ID THING)) ID)) 
+(define-syntax-rule (++ ID) (+= ID 1))
+(define-syntax-rule (-- ID) (+= ID -1))
+(define-syntax-rule (-= ID THING) (+= ID (- THING)))
 
 
 ;; fancy number->string. bounds are checked, inexact integers are coerced.
@@ -57,7 +58,7 @@
                         [else #f])]
          [else (raise-argument-error '· "object or dict" x)]))) '·))
 
-(define-macro (· X REF ...) #'(·-helper X 'REF ...))
+(define-syntax-rule (· X REF ...) (·-helper X 'REF ...))
 
 #;(module+ test
     (define c (class object%
@@ -71,8 +72,8 @@
     (check-equal? (· co a) 42)
     (check-equal? (· co b) 43))
 
-(define-macro (·map REF XS)
-  #'(for/list ([x (in-list XS)]) (· x REF)))
+(define-syntax-rule (·map REF XS)
+  (for/list ([x (in-list XS)]) (· x REF)))
 
 (module+ test
   (require rackunit)

sugar/unstable/stub.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require (for-syntax racket/base br/syntax) br/define)
+(require (for-syntax racket/base racket/syntax))
 (provide (all-defined-out))
 
 (begin-for-syntax
@@ -7,25 +7,33 @@
   (define (make-prefix caller-stx)
     (string-join (map ~a (list (syntax-source caller-stx) (syntax-line caller-stx))) ":" #:after-last ":")))
 
-(define-macro (define-stub-stop ID)
-  (with-pattern ([ERROR-ID (suffix-id (prefix-id (make-prefix caller-stx) #'ID) ":not-implemented")])
-                #'(define (ID . args)
-                    (error 'ERROR-ID))))
+(define-syntax (define-stub-stop stx)
+  (syntax-case stx ()
+    [(_ ID)
+     (with-syntax ([ERROR-ID (format-id stx "~a~a:not-implemented" (make-prefix stx) (syntax->datum #'ID))])
+       #'(define (ID . args)
+           (error 'ERROR-ID)))]))
 
 (provide (rename-out [define-stub-stop define-stub]))
 
-(define-macro (define-stub-go ID)
-  (with-pattern ([ERROR-ID (suffix-id (prefix-id (make-prefix caller-stx) #'ID) ":not-implemented")])
-                #'(define (ID . args)
-                    (displayln 'ERROR-ID))))
+(define-syntax (define-stub-go stx)
+  (syntax-case stx ()
+    [(_ ID)
+     (with-syntax ([ERROR-ID (format-id stx "~a~a:not-implemented" (make-prefix stx) (syntax->datum #'ID))])
+       #'(define (ID . args)
+           (displayln 'ERROR-ID)))]))
 
-(define-macro (define-unfinished (ID . ARGS) . BODY)
-  (with-pattern ([ID-UNFINISHED (suffix-id (prefix-id (make-prefix caller-stx) #'ID) ":unfinished")])
-                #'(define (ID . ARGS)
-                    (begin . BODY)
-                    (error 'ID-UNFINISHED))))
+(define-syntax (define-unfinished stx)
+  (syntax-case stx ()
+    [(_ (ID . ARGS) . BODY)
+     (with-syntax ([ID-UNFINISHED (format-id stx "~a~a:unfinished" (make-prefix stx) (syntax->datum #'ID))])
+       #'(define (ID . ARGS)
+           (begin . BODY)
+           (error 'ID-UNFINISHED)))]))
 
 
-(define-macro (unfinished)
-  (with-pattern ([ID-UNFINISHED (prefix-id (syntax-source caller-stx) ":" (syntax-line caller-stx) ":" #'unfinished)])
-                #'(error 'ID-UNFINISHED)))
+(define-syntax (unfinished stx)
+  (syntax-case stx ()
+    [(_)
+     (with-syntax ([ID-UNFINISHED (format-id stx "~a:~a:~a" (syntax-source stx) (syntax-line stx) (syntax->datum #'unfinished))])
+       #'(error 'ID-UNFINISHED))]))