minor updates
This commit is contained in:
parent
eeaba0f7c3
commit
9a746eeac9
36
beautiful-racket-lib/br/cond.rkt
Normal file
36
beautiful-racket-lib/br/cond.rkt
Normal file
|
@ -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…
Reference in New Issue
Block a user