From a27bab85022188ed9724c81afdaf9fd70083a8b0 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Mon, 17 Sep 2012 19:43:49 -0400 Subject: [PATCH] unstable/match: add `define/match` Match-based function definition form that supports optional, keyword, rest-arg, and curried arguments. original commit: 1a0a06db6262e2eb54d729389e7233927a3f3d23 --- collects/unstable/match.rkt | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/collects/unstable/match.rkt b/collects/unstable/match.rkt index 9fdd8d72..b19a1ad6 100644 --- a/collects/unstable/match.rkt +++ b/collects/unstable/match.rkt @@ -3,7 +3,8 @@ (require racket/class racket/match (for-syntax racket/base) - (for-syntax syntax/parse)) + (for-syntax syntax/parse + syntax/parse/experimental/template)) (provide match? as object) @@ -14,6 +15,38 @@ (syntax-rules () [(as ([x e] ...) p ...) (and (app (lambda (y) e) x) ... p ...)])) +;; Added by asumu +;; Comprehensive `define` procedure form for match +(provide define/match) + +(begin-for-syntax + (define-syntax-class function-header + (pattern ((~or header:function-header name:id) . args:args) + #:attr params + (template ((?@ . (?? header.params ())) + . args.params)))) + + (define-syntax-class args + (pattern (arg:arg ...) + #:attr params #'(arg.name ...)) + (pattern (arg:arg ... . rest:id) + #:attr params #'(arg.name ... rest))) + + (define-splicing-syntax-class arg + #:attributes (name) + (pattern name:id) + (pattern [name:id default]) + (pattern (~seq kw:keyword name:id)) + (pattern (~seq kw:keyword [name:id default])))) + +(define-syntax (define/match stx) + (syntax-parse stx + [(_ ?header:function-header ?clause ...) + (template + (define ?header + (match* (?? ?header.params) + ?clause ...)))])) + ;; Added by asumu ;; Match expander for objects from racket/class (define-match-expander object