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)
arg)) (list <arg> ...)))))])))
(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)
(syntax->datum arg)
arg)) args))))
(define (format-datums datum-template args)
(map (λ(arg) (format-datum datum-template arg)) args))
;; todo: rephrase errors from `format` or `map` in terms of `format-datums`
(define (format-datums datum-template . argss)
(apply map (λ args (apply format-datum datum-template args)) argss))
(module+ test
(require rackunit syntax/datum)

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

@ -1,10 +1,10 @@
#lang racket/base
(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))
(provide (except-out (all-from-out racket/base) define)
(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 caller-stx shared-syntax with-shared-id with-calling-site-id) ; from br/define
(filtered-out

Loading…
Cancel
Save