suzanne.soy/beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

update define

Browse Source
This commit is contained in:
Matthew Butterick 2016-08-11 19:13:43 -07:00
parent 6fefd30ca7
commit da3ee27045
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
beautiful-racket-lib/br/define.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require (require
racket/function
(for-syntax racket/list (for-syntax racket/list
racket/base racket/base
syntax/parse syntax/parse
@ -56,7 +57,7 @@
#'(define id #'(define id
(case-lambda (case-lambda
[pat-args . body] ... [pat-args . body] ...
[else (raise-syntax-error 'id "no matching case for argument pattern")]))] [rest-pat (apply raise-arity-error 'id (normalize-arity (map length '(pat-args ...))) rest-pat)]))]
[else (raise-syntax-error [else (raise-syntax-error
'define-cases 'define-cases
"no matching case for calling pattern" "no matching case for calling pattern"
@ -66,9 +67,15 @@
(module+ test (module+ test
(define-cases f (define-cases f
[(_ arg) (add1 arg)] [(_ arg) (add1 arg)]
[(_ arg1 arg2) (+ arg1 arg2)]) [(_ arg1 arg2) (+ arg1 arg2)]
[(_ . any) 'boing])
(check-equal? (f 42) 43) (check-equal? (f 42) 43)
(check-equal? (f 42 5) 47)) (check-equal? (f 42 5) 47)
(check-equal? (f 42 5 'zonk) 'boing)
(define-cases f-one-arg
[(_ arg) (add1 arg)])
(check-exn exn:fail:contract:arity? (λ _ (f-one-arg 1 2 3))))
(define-syntax-rule (debug-define-macro (ID . PAT-ARGS) BODY) (define-syntax-rule (debug-define-macro (ID . PAT-ARGS) BODY)