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

match.ss: abstract some boilerplate, and use syntax/loc when doing conversion to plt-match

Browse Source 
match-helper.ss: add helper macro

render-test-list-impl.ss: fix hygiene bug in checking for non-linear patters
			  (thanks to Ryan Culpepper)

gen-match.ss: Fix error reporting location in match errors.
	      (thanks to Ryan Culpepper)

svn: r3689

original commit: b42a11d12dbff0a32779566f00f3f612ad47a356
This commit is contained in:
Sam Tobin-Hochstadt 2006-07-12 18:59:07 +00:00
parent 61c432ef3f
commit ba944cf708
1 changed files with 47 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
collects/mzlib/match.ss
View File

@ -125,61 +125,66 @@
(require-for-syntax "private/convert-pat.ss"
"private/match-helper.ss")
(require-for-template mzscheme)
(require (prefix plt: "private/match-internal-func.ss")
"private/match-expander.ss"
"private/match-helper.ss"
"private/match-error.ss"
"private/test-no-order.ss")
(define-syntax (match-lambda stx)
(syntax-case stx ()
[(k clause ...)
(with-syntax ([(new-clauses ...) (handle-clauses #'(clause ...))])
#'(plt:match-lambda new-clauses ...))]))
(define-syntax (match-lambda* stx)
(syntax-case stx ()
[(k clause ...)
(with-syntax ([(new-clauses ...) (handle-clauses #'(clause ...))])
#'(plt:match-lambda* new-clauses ...))]))
(define-syntax match-definer
(syntax-rules ()
[(match-definer name clauses ...)
(define-syntax (name stx)
(md-help syntax stx
(syntax-case stx ()
clauses ...)))]))
(define-syntax (match-let stx)
(syntax-case stx ()
[(k name (clauses ...) body ...)
(identifier? (syntax name))
(with-syntax ([(new-clauses ...) (handle-clauses #'(clauses ...))])
#'(plt:match-let name (new-clauses ...) body ...))]
[(k (clauses ...) body ...)
(with-syntax ([(new-clauses ...) (handle-clauses #'(clauses ...))])
#'(plt:match-let (new-clauses ...) body ...))]))
(match-definer match-lambda
[(k clause ...)
(with-syntax ([(new-clauses ...) (handle-clauses #'(clause ...))])
#'(plt:match-lambda new-clauses ...))])
(define-syntax (match-let* stx)
(syntax-case stx ()
[(k (clauses ...) body ...)
(with-syntax
([(new-clauses ...) (handle-clauses #'(clauses ...))])
#'(plt:match-let* (new-clauses ...) body ...))]))
(match-definer match-lambda*
[(k clause ...)
(with-syntax ([(new-clauses ...) (handle-clauses #'(clause ...))])
#'(plt:match-lambda* new-clauses ...))])
(define-syntax (match stx)
(syntax-case stx ()
[(_ exp clause ...)
(with-syntax
([(new-clauses ...) (handle-clauses #'(clause ...))])
#'(plt:match exp new-clauses ...))]))
(match-definer match-let
[(k name (clauses ...) body ...)
(identifier? (syntax name))
(with-syntax ([(new-clauses ...) (handle-clauses #'(clauses ...))])
#'(plt:match-let name (new-clauses ...) body ...))]
[(k (clauses ...) body ...)
(with-syntax ([(new-clauses ...) (handle-clauses #'(clauses ...))])
#'(plt:match-let (new-clauses ...) body ...))])
(define-syntax (match-letrec stx)
(syntax-case stx ()
[(k (clauses ...) body ...)
(with-syntax
([(new-clauses ...) (handle-clauses #'(clauses ...))])
#'(plt:match-letrec (new-clauses ...) body ...))]))
(match-definer match-let*
[(k (clauses ...) body ...)
(with-syntax
([(new-clauses ...) (handle-clauses #'(clauses ...))])
#'(plt:match-let* (new-clauses ...) body ...))])
(match-definer match
[(_ exp clause ...)
(with-syntax
([(new-clauses ...) (handle-clauses #'(clause ...))])
#'(plt:match exp new-clauses ...))])
(match-definer match-letrec
[(k (clauses ...) body ...)
(with-syntax
([(new-clauses ...) (handle-clauses #'(clauses ...))])
#'(plt:match-letrec (new-clauses ...) body ...))])
(define-syntax (match-define stx)
(syntax-case stx ()
[(k pat exp)
(with-syntax ([new-pat (convert-pat #'pat)])
#'(plt:match-define new-pat exp))]))
(match-definer match-define
[(k pat exp)
(with-syntax ([new-pat (convert-pat #'pat)])
#'(plt:match-define new-pat exp))])