minor updates

pull/2/head
Matthew Butterick 8 years ago
parent eeaba0f7c3
commit 9a746eeac9

@ -0,0 +1,36 @@
#lang racket/base
(require (for-syntax racket/base))
(provide (all-defined-out))
(define-syntax-rule (until COND EXPR ...)
(let loop ()
(unless COND
EXPR ...
(loop))))
(define-syntax-rule (while COND EXPR ...)
(let loop ()
(when COND
EXPR ...
(loop))))
(define-syntax (forever stx)
(syntax-case stx ()
[(_ . EXPRS)
;; todo: would be better with a syntax parameter
(with-syntax ([stop (datum->syntax #'EXPRS 'stop)])
#'(let/ec stop
(while #t
. EXPRS)))]))
(module+ test
(require rackunit)
(check-equal? (let ([x 5])
(until (zero? x)
(set! x (- x 1)))
x) 0)
(check-equal? (let ([x 5])
(while (positive? x)
(set! x (- x 1)))
x) 0))

@ -1,15 +0,0 @@
#lang racket/base
(require (for-syntax racket/base))
(provide (all-defined-out))
(define-syntax-rule (until cond expr ...)
(let loop ()
(unless cond
expr ...
(loop))))
(define-syntax-rule (while cond expr ...)
(let loop ()
(when cond
expr ...
(loop))))

@ -23,13 +23,16 @@
(syntax->datum arg) (syntax->datum arg)
arg)) (list <arg> ...)))))]))) arg)) (list <arg> ...)))))])))
(define (datum? x) (or (list? x) (symbol? x)))
(define (format-datum datum-template . args) (define (format-datum datum-template . args)
(string->datum (apply format (format "~a" datum-template) (map (λ(arg) (if (syntax? arg) (string->datum (apply format (format "~a" datum-template) (map (λ(arg) (if (syntax? arg)
(syntax->datum arg) (syntax->datum arg)
arg)) args)))) arg)) args))))
(define (format-datums datum-template args) ;; todo: rephrase errors from `format` or `map` in terms of `format-datums`
(map (λ(arg) (format-datum datum-template arg)) args)) (define (format-datums datum-template . argss)
(apply map (λ args (apply format-datum datum-template args)) argss))
(module+ test (module+ test
(require rackunit syntax/datum) (require rackunit syntax/datum)

@ -4,23 +4,24 @@
(define-syntax (report stx) (define-syntax (report stx)
(syntax-case stx () (syntax-case stx ()
[(_ expr) #'(report expr expr)] [(_ EXPR) #'(report EXPR EXPR)]
[(_ expr name) [(_ EXPR NAME)
#'(let ([expr-result expr]) #'(let ([expr-result EXPR])
(eprintf "~a = ~v\n" 'name expr-result) (eprintf "~a = ~v\n" 'NAME expr-result)
expr-result)])) expr-result)]))
(define-syntax (report-datum stx) (define-syntax (report-datum stx)
(syntax-case stx () (syntax-case stx ()
[(_ stx-expr) (with-syntax ([datum (syntax->datum #'stx-expr)]) [(_ STX-EXPR)
#'(report-datum stx-expr datum))] (with-syntax ([datum (syntax->datum #'STX-EXPR)])
[(_ stx-expr name) #'(report-datum STX-EXPR datum))]
[(_ STX-EXPR NAME)
#'(let () #'(let ()
(eprintf "~a = ~v\n" 'name (syntax->datum stx-expr)) (eprintf "~a = ~v\n" 'NAME (syntax->datum STX-EXPR))
stx-expr)])) STX-EXPR)]))
(define-syntax-rule (define-multi-version multi-name name) (define-syntax-rule (define-multi-version MULTI-NAME NAME)
(define-syntax-rule (multi-name x (... ...)) (define-syntax-rule (MULTI-NAME x (... ...))
(begin (name x) (... ...)))) (begin (NAME x) (... ...))))
(define-multi-version report* report) (define-multi-version report* report)

@ -1,10 +1,10 @@
#lang racket/base #lang racket/base
(require racket/provide racket/list racket/string racket/format racket/match racket/port (require racket/provide racket/list racket/string racket/format racket/match racket/port
br/define br/syntax br/datum br/debug br/conditional racket/function br/define br/syntax br/datum br/debug br/cond racket/function
(for-syntax racket/base racket/syntax br/syntax br/debug br/define)) (for-syntax racket/base racket/syntax br/syntax br/debug br/define))
(provide (except-out (all-from-out racket/base) define) (provide (except-out (all-from-out racket/base) define)
(all-from-out racket/list racket/string racket/format racket/match racket/port (all-from-out racket/list racket/string racket/format racket/match racket/port
br/syntax br/datum br/debug br/conditional racket/function) br/syntax br/datum br/debug br/cond racket/function)
(for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug)) (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug))
(for-syntax caller-stx shared-syntax with-shared-id with-calling-site-id) ; from br/define (for-syntax caller-stx shared-syntax with-shared-id with-calling-site-id) ; from br/define
(filtered-out (filtered-out

Loading…
Cancel
Save