[racket] define-match-expander

I got it to work for prefab structures.  Is there anything else I  
should put in?

(define (rewrite pat_0)
   (syntax-case pat_0 ()
     [pat (identifier? #'pat) (rewrite-id #'pat stx)]
     [(pat ...)
      (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])
        (syntax/loc stx (p ...)))]
     [#(pat ...)
      (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])
        (syntax/loc stx #(p ...)))]
     [#&pat
      (with-syntax ([p (rewrite #'pat)])
        (syntax/loc stx #&p))]
     [pat (prefab-struct-key (syntax-e #'pat))
          (let ([key-datum (prefab-struct-key (syntax-e #'pat))])
            (match (struct->vector (syntax-e #'pat))
              [(vector struct:key-datum subpats ...)
               (datum->syntax stx (apply make-prefab-struct key-datum  
(map rewrite subpats)))]))]
     [pat #'pat]))

(check-equal? (:match #s(key-datum 1 2 3)
                       [`#s(key-datum ,a:num ,b:num ,c:num) (list a b  
c)])
               (list 1 2 3))

(check-equal? (:match #s(key-datum_0 1 2 3)
                       [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a  
b c)])
               (list 1 2 3))

The whole thing is here:
(by the way I also made it so that something:something-else:num works  
as a pattern with the name something:something-else.)

#lang racket

(require rackunit)
(require (for-syntax
           (only-in lang/htdp-intermediate-lambda
                    string-contains?)
           racket/list
           racket/string
           racket/match))

(begin-for-syntax
  (define (type-str->stx-type-pred type-str)
    (match type-str
      ["num" #'number?]
      ["int" #'integer?]
      ["str" #'string?]
      ["sym" #'symbol?]
      ["lst" #'list?]
      ["vec" #'vector?]
      ["bool" #'boolean?]
      ["proc" #'procedure?]
      [_ #f]))

  (define (split str)
    (string-split str ":"))

  (define (rewrite-id pat stx)
    (let* ([pat-sym (syntax->datum pat)]
           [pat-str (symbol->string pat-sym)])
      (if (id:type? pat-str)
          (parse-pat-str pat-str stx)
          pat)))

  (define (parse-pat-str pat-str stx)
    (match (split pat-str)
      [(list pat-name-strs ... type-str)
       (with-syntax ([type-pred (type-str->stx-type-pred type-str)]
                     [pat-name (datum->syntax stx (string->symbol  
(string-join pat-name-strs ":")))])
         #'(? type-pred pat-name))]))

  (define (id:type? str)
    (and (string-contains? ":" str)
         (<= 2 (length (split str)))
         (type-str->stx-type-pred (last (split str)))))
  )

(define-match-expander :pat
   (lambda (stx)
     (define (rewrite pat_0)
       (syntax-case pat_0 ()
         [pat (identifier? #'pat) (rewrite-id #'pat stx)]
         [(pat ...)
          (with-syntax ([(p ...) (map rewrite (syntax->list  
#'(pat ...)))])
            (syntax/loc stx (p ...)))]
         [#(pat ...)
          (with-syntax ([(p ...) (map rewrite (syntax->list  
#'(pat ...)))])
            (syntax/loc stx #(p ...)))]
         [#&pat
          (with-syntax ([p (rewrite #'pat)])
            (syntax/loc stx #&p))]
         [pat (prefab-struct-key (syntax-e #'pat))
              (let ([key-datum (prefab-struct-key (syntax-e #'pat))])
                (match (struct->vector (syntax-e #'pat))
                  [(vector struct:key-datum subpats ...)
                   (datum->syntax stx (apply make-prefab-struct key- 
datum (map rewrite subpats)))]))]
         [pat #'pat]))
     (syntax-case stx ()
       [(_ pat) (rewrite #'pat)])))

(define-syntax (:match stx)
  (syntax-case stx ()
    [(:match val-expr [pat . more] ...)
     (with-syntax ([(new-pat ...) (for/list ([pat-stx (in-list (syntax- 
 >list #'(pat ...)))])
                                    (datum->syntax pat-stx `(:pat , 
(syntax->datum pat-stx))))])
     #'(match val-expr [new-pat . more] ...))]))


(check-equal? (:match 1 [n:num n]) 1)
(check-equal? (:match 'x [n:num n] [_ 2]) 2)

(check-equal? (:match "string" [s:str s]) "string")
(check-equal? (:match 'x [s:str s] [_ 2]) 2)

(check-equal? (:match (list 1 2 3) [l:lst l]) (list 1 2 3))
(check-equal? (:match 'x [l:lst l] [_ 2]) 2)

(check-equal? (:match (vector 1 2 3) [v:vec v]) (vector 1 2 3))
(check-equal? (:match 'x [v:vec v] [_ 2]) 2)

(check-equal? (:match #t [b:bool b]) #t)
(check-equal? (:match #f [b:bool b]) #f)
(check-equal? (:match 'x [b:bool b] [_ 2]) 2)

(check-equal? (:match 'x [l l]) 'x)

(check-equal? (:match '(2 x "foo" (3 4)) [(list n s f l) (list n s f  
l)]) '(2 x "foo" (3 4)))
(check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)]) '(42 x))

(check-equal? (:match (list 1 "2" '|3|)
                       [(list a:1:num b:2:str c:3:sym)
                        (list a:1 (string->number b:2) (string->number  
(symbol->string c:3)))])
               (list 1 2 3))

(check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4)))
                       [(list a:num b:num (vector c:num d:num e:num  
(list f:num g:num h:num i:num)))
                        (list a b c d e f g h i)])
               (list 1 2 1 2 3 1 2 3 4))

(check-equal? (:match '(1 2 #(1 2 3 (1 2 3 #&4)))
                       [`(,a:num ,b:num #(,c:num ,d:num ,e:num  
(,f:num ,g:num ,h:num #&,i:num)))
                        (list a b c d e f g h i)])
               (list 1 2 1 2 3 1 2 3 4))

(check-equal? (:match #s(key-datum 1 2 3)
                       [`#s(key-datum ,a:num ,b:num ,c:num) (list a b  
c)])
               (list 1 2 3))

(check-equal? (:match #s(key-datum_0 1 2 3)
                       [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a  
b c)])
               (list 1 2 3))


On Dec 29, 2013, at 6:53 PM, Alexander D. Knauth wrote:

> I got it to work for lists, vectors, and boxes, but I'm having  
> trouble for prefab structure types.
> (by the way I renamed the rewrite function to rewrite-id and made a  
> new rewrite function that deals with lists, vectors, boxes, and  
> prefab structures.)
>
> Here's my new rewrite function:
>
> (define (rewrite pat_0)
>   (syntax-case pat_0 ()
>     [pat (identifier? #'pat) (rewrite-id #'pat stx)]
>     [(pat ...)
>      (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])
>        (syntax/loc stx (p ...)))]
>     [#(pat ...)
>      (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])
>        (syntax/loc stx #(p ...)))]
>     [#&pat
>      (with-syntax ([p (rewrite #'pat)])
>        (syntax/loc stx #&p))]
>     [#s(key-datum pat ...)
>      (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])
>        (syntax/loc stx #s(key-datum p ...)))]
>     [pat #'pat]))
>
> the problem is that I can't make key-datum a pattern.  For example  
> this works:
>
> (check-equal? (:match #s(key-datum 1 2 3)
>                       [`#s(key-datum ,a:num ,b:num ,c:num) (list a b  
> c)])
>               (list 1 2 3))
>
> But this doesn't (because a, b, and c are undefined)
>
> (check-equal? (:match #s(key-datum_0 1 2 3)
>                       [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a  
> b c)])
>               (list 1 2 3))
>
> How do I turn the key-datum in #s(key-datum pat ...) into a syntax- 
> case pattern so that it recognizes all prefab structures instead of  
> just #s(key-datum pat ...) as opposed to #s(other-key-datum pat ...)?
>
> Here's the whole thing:
>
> #lang racket
>
> (require rackunit)
> (require (for-syntax
>           (only-in lang/htdp-intermediate-lambda
>                    string-contains?)
>           racket/string
>           racket/match))
>
> (begin-for-syntax
>  (define (type-str->stx-type-pred type-str)
>    (match type-str
>      ["num" #'number?]
>      ["int" #'integer?]
>      ["str" #'string?]
>      ["sym" #'symbol?]
>      ["lst" #'list?]
>      ["vec" #'vector?]
>      ["bool" #'boolean?]
>      ["proc" #'procedure?]
>      [_ #f]))
>
>  (define (split str) (string-split str ":"))
>
>  (define (rewrite-id pat stx)
>    (let* ([pat-sym (syntax->datum pat)]
>           [pat-str (symbol->string pat-sym)])
>      (if (id:type? pat-str)
>          (parse-pat-str pat-str stx)
>          pat)))
>
>  (define (parse-pat-str pat-str stx)
>    (match (split pat-str)
>      [(list pat-name-str type-str)
>       (with-syntax ([type-pred (type-str->stx-type-pred type-str)]
>                     [pat-name (datum->syntax stx (string->symbol pat- 
> name-str))])
>         #'(? type-pred pat-name))]))
>
>  (define (id:type? str)
>    (and (string-contains? ":" str)
>         (= 2 (length (split str)))
>         (type-str->stx-type-pred (cadr (split str)))))
>  )
>
> (define-match-expander :pat
>   (lambda (stx)
>     (define (rewrite pat_0)
>       (syntax-case pat_0 ()
>         [pat (identifier? #'pat) (rewrite-id #'pat stx)]
>         [(pat ...)
>          (with-syntax ([(p ...) (map rewrite (syntax->list  
> #'(pat ...)))])
>            (syntax/loc stx (p ...)))]
>         [#(pat ...)
>          (with-syntax ([(p ...) (map rewrite (syntax->list  
> #'(pat ...)))])
>            (syntax/loc stx #(p ...)))]
>         [#&pat
>          (with-syntax ([p (rewrite #'pat)])
>            (syntax/loc stx #&p))]
>         [#s(key-datum pat ...)
>          (with-syntax ([(p ...) (map rewrite (syntax->list  
> #'(pat ...)))])
>            (syntax/loc stx #s(key-datum p ...)))]
>         [pat #'pat]))
>     (syntax-case stx ()
>       [(_ pat) (rewrite #'pat)])))
>
> (define-syntax (:match stx)
>  (syntax-case stx ()
>    [(:match val-expr [pat . more] ...)
>     (with-syntax ([(new-pat ...) (for/list ([pat-stx (in-list  
> (syntax->list #'(pat ...)))])
>                                    (datum->syntax pat-stx `(:pat , 
> (syntax->datum pat-stx))))])
>     #'(match val-expr [new-pat . more] ...))]))
>
>
> (check-equal? (:match 1 [n:num n]) 1)
> (check-equal? (:match 'x [n:num n] [_ 2]) 2)
>
> (check-equal? (:match "string" [s:str s]) "string")
> (check-equal? (:match 'x [s:str s] [_ 2]) 2)
>
> (check-equal? (:match (list 1 2 3) [l:lst l]) (list 1 2 3))
> (check-equal? (:match 'x [l:lst l] [_ 2]) 2)
>
> (check-equal? (:match (vector 1 2 3) [v:vec v]) (vector 1 2 3))
> (check-equal? (:match 'x [v:vec v] [_ 2]) 2)
>
> (check-equal? (:match #t [b:bool b]) #t)
> (check-equal? (:match #f [b:bool b]) #f)
> (check-equal? (:match 'x [b:bool b] [_ 2]) 2)
>
> (check-equal? (:match 'x [l l]) 'x)
>
> (check-equal? (:match '(2 x "foo" (3 4)) [(list n s f l) (list n s f  
> l)]) '(2 x "foo" (3 4)))
> (check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)]) '(42  
> x))
>
> (check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4)))
>                       [(list a:num b:num (vector c:num d:num e:num  
> (list f:num g:num h:num i:num)))
>                        (list a b c d e f g h i)])
>               (list 1 2 1 2 3 1 2 3 4))
>
> (check-equal? (:match '(1 2 #(1 2 3 (1 2 3 #&4)))
>                       [`(,a:num ,b:num #(,c:num ,d:num ,e:num  
> (,f:num ,g:num ,h:num #&,i:num)))
>                        (list a b c d e f g h i)])
>               (list 1 2 1 2 3 1 2 3 4))
>
> (check-equal? (:match #s(key-datum 1 2 3)
>                       [`#s(key-datum ,a:num ,b:num ,c:num) (list a b  
> c)])
>               (list 1 2 3))
>
> ;; this doesn't work:
> ;
> ;(check-equal? (:match #s(key-datum_0 1 2 3)
> ;                      [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list  
> a b c)])
> ;              (list 1 2 3))
>
>
> On Dec 29, 2013, at 4:01 PM, Jens Axel Søgaard wrote:
>
>> 2013/12/29 Alexander D. Knauth <alexander at knauth.org>:
>>> I was seeing if it would work with nested patterns and quasiquoted  
>>> patterns
>>> and it didn't, so I had to change the rewrite function and use  
>>> (vector?
>>> (syntax-e pat)) to check for a vector written like  
>>> `#(,a:num ,b:num ,c:num).
>>>
>>> like this:
>>>
>>> (define (rewrite pat)
>>>     (cond [(identifier? pat) (let* ([pat-sym (syntax->datum pat)]
>>>                                     [pat-str (symbol->string pat- 
>>> sym)])
>>>                                (if (id:type? pat-str)
>>>                                    (parse-pat-str pat-str stx)
>>>                                    pat))]
>>>           [(syntax->list pat) (datum->syntax pat (map rewrite  
>>> (syntax->list
>>> pat)))]
>>>           [(vector? (syntax-e pat)) (datum->syntax pat (vector-map  
>>> rewrite
>>> (syntax-e pat)))]
>>>           [else (print pat) (newline) (error "I don't know what to  
>>> do.
>>> given:" pat)]))
>>>
>>> For the vector thing, I had to put a special clause in that did a  
>>> vector-map
>>> instead of a map.
>>>
>>> Is there any other stuff (like the #(1 2 3) notation for vectors)  
>>> that I
>>> should be worried about,
>>
>> There are boxes and prefab structures. See the list here:
>>
>> http://docs.racket-lang.org/reference/stx-patterns.html?q=syntax-case#%28form._%28%28lib._racket%2Fprivate%2Fstxcase-scheme..rkt%29._syntax-case%29%29
>>
>>> ... or is there another way to write the rewrite
>>> function to handle stuff like this that wouldn't require a cond  
>>> case for
>>> every type of data that pat could be?
>>
>> I don't see a way around it.
>>
>> /Jens Axel
>>
>>
>>
>>>
>>> The whole thing is here:
>>>
>>> #lang racket
>>>
>>> (require rackunit)
>>> (require (for-syntax
>>>          (only-in lang/htdp-intermediate-lambda
>>>                   string-contains?)
>>>          racket/string
>>>          racket/match
>>>          racket/vector))
>>>
>>> (begin-for-syntax
>>> (define (type-str->stx-type-pred type-str)
>>>   (match type-str
>>>     ["num" #'number?]
>>>     ["str" #'string?]
>>>     ["sym" #'symbol?]
>>>     ["lst" #'list?]
>>>     ["vec" #'vector?]
>>>     ["bool" #'boolean?]
>>>     ["proc" #'procedure?]
>>>     [_ #f]))
>>>
>>> (define (split str) (string-split str ":"))
>>>
>>> (define (parse-pat-str pat-str stx)
>>>   (match (split pat-str)
>>>     [(list pat-name-str type-str)
>>>      (with-syntax ([type-pred (type-str->stx-type-pred type-str)]
>>>                    [pat-name (datum->syntax stx (string->symbol
>>> pat-name-str))])
>>>        #'(? type-pred pat-name))]))
>>>
>>> (define (id:type? str)
>>>   (and (string-contains? ":" str)
>>>        (= 2 (length (split str)))
>>>        (type-str->stx-type-pred (cadr (split str)))))
>>> )
>>>
>>> (define-match-expander :pat
>>> (lambda (stx)
>>>   (define (rewrite pat)
>>>     (cond [(identifier? pat) (let* ([pat-sym (syntax->datum pat)]
>>>                                     [pat-str (symbol->string pat- 
>>> sym)])
>>>                                (if (id:type? pat-str)
>>>                                    (parse-pat-str pat-str stx)
>>>                                    pat))]
>>>           [(syntax->list pat) (datum->syntax pat (map rewrite  
>>> (syntax->list
>>> pat)))]
>>>           [(vector? (syntax-e pat)) (datum->syntax pat (vector-map  
>>> rewrite
>>> (syntax-e pat)))]
>>>           [else (print pat) (newline) (error "I don't know what to  
>>> do.
>>> given:" pat)]))
>>>   (syntax-case stx ()
>>>     [(_ pat) (identifier? #'pat) (rewrite #'pat)]
>>>     [(_ (pat ...))
>>>      (with-syntax ([(p ...) (map rewrite (syntax->list  
>>> #'(pat ...)))])
>>>        (syntax/loc stx (p ...)))]
>>>     [(_ pat) #'pat])))
>>>
>>> (define-syntax (:match stx)
>>> (syntax-case stx ()
>>>   [(:match val-expr [pat . more] ...)
>>>    (with-syntax ([(new-pat ...) (for/list ([pat-stx (in-list  
>>> (syntax->list
>>> #'(pat ...)))])
>>>                                   (datum->syntax pat-stx `(:pat
>>> ,(syntax->datum pat-stx))))])
>>>    #'(match val-expr [new-pat . more] ...))]))
>>>
>>>
>>> (check-equal? (:match 1 [n:num n]) 1)
>>> (check-equal? (:match 'x [n:num n] [_ 2]) 2)
>>>
>>> (check-equal? (:match "string" [s:str s]) "string")
>>> (check-equal? (:match 'x [s:str s] [_ 2]) 2)
>>>
>>> (check-equal? (:match (list 1 2 3) [l:lst l]) (list 1 2 3))
>>> (check-equal? (:match 'x [l:lst l] [_ 2]) 2)
>>>
>>> (check-equal? (:match (vector 1 2 3) [v:vec v]) (vector 1 2 3))
>>> (check-equal? (:match 'x [v:vec v] [_ 2]) 2)
>>>
>>> (check-equal? (:match #t [b:bool b]) #t)
>>> (check-equal? (:match #f [b:bool b]) #f)
>>> (check-equal? (:match 'x [b:bool b] [_ 2]) 2)
>>>
>>> (check-equal? (:match 'x [l l]) 'x)
>>>
>>> (check-equal? (:match '(2 x "foo" (3 4)) [(list n s f l) (list n s  
>>> f l)])
>>> '(2 x "foo" (3 4)))
>>> (check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)])  
>>> '(42 x))
>>>
>>> (check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4)))
>>>                      [(list a:num b:num (vector a:num b:num c:num  
>>> (list
>>> a:num b:num c:num d:num)))
>>>                       (list a b c d)])
>>>              (list 1 2 3 4))
>>>
>>> (check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4)))
>>>                      [`(,a:num ,b:num #(,a:num ,b:num ,c:num  
>>> (,a:num ,b:num
>>> ,c:num ,d:num)))
>>>                       (list a b c d)])
>>>              (list 1 2 3 4))
>>>
>>>
>>> On Dec 29, 2013, at 12:04 PM, Alexander D. Knauth wrote:
>>>
>>> I'm not really sure why this works either, but try this:
>>>
>>> (define-syntax (:match stx)
>>> (syntax-case stx ()
>>>   [(:match val-expr [pat . more] ...)
>>>    (with-syntax ([(new-pat ...) (for/list ([pat-stx (in-list  
>>> (syntax->list
>>> #'(pat ...)))])
>>>                                   (datum->syntax pat-stx `(:pat
>>> ,(syntax->datum pat-stx))))])
>>>    #'(match val-expr [new-pat . more] ...))]))
>>>
>>> (check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)])
>>>              (match '(42 x) [(:pat (list n:num s:sym)) (list n s)]))
>>>
>>> On Dec 29, 2013, at 8:54 AM, Jens Axel Søgaard wrote:
>>>
>>> Hi Alexander,
>>>
>>> I extended your example to allow other patterns than symbols  
>>> inside :pat.
>>>
>>> (match '(42 x)  [(:pat (list n:num s:sym))   (list n s)])
>>>
>>>   (list 42 x)
>>>
>>> This works fine. I now want to "hide" the :pat, that is I want to  
>>> write:
>>>
>>>   (:match '(42 x)  [(list n:num s:sym)  (list n s)])
>>>
>>> Since the syntax of match is: (match val-expr clause ...) and each  
>>> clause
>>> has the form  [pat . more]  we can rewrite pat to [(:pat pat) .  
>>> more].
>>>
>>> So I tried this:
>>>
>>> (define-syntax (:match stx)
>>>   (syntax-case stx ()
>>>     [(_ val-expr [pat . more] ...)
>>>      #'(match val-expr [(:pat pat) . more] ...)]))
>>>
>>> This doesn't work however. I am tempted to consider this a bug in  
>>> match,
>>> but I am not sure.
>>>
>>> #lang racket
>>> (require (for-syntax (only-in lang/htdp-intermediate-lambda
>>> string-contains?)
>>>                    racket/string
>>>                    racket/match)
>>>        rackunit)
>>>
>>> (begin-for-syntax
>>> (define (type-str->stx-type-pred type-str)
>>>   (match type-str
>>>     ["num" #'number?]
>>>     ["str" #'string?]
>>>     ["sym" #'symbol?]
>>>     ["lst" #'list?]
>>>     [_ #f]))
>>>
>>> (define (split str) (string-split str ":"))
>>>
>>> (define (parse-pat-str pat-str stx)
>>>   (match (split pat-str)
>>>     [(list pat-name-str type-str)
>>>      (with-syntax ([type-pred (type-str->stx-type-pred type-str)]
>>>                    [pat-name (datum->syntax stx (string->symbol
>>> pat-name-str))])
>>>        #'(? type-pred pat-name))]))
>>>
>>> (define (id:type? str)
>>>   (and (string-contains? ":" str)
>>>        (type-str->stx-type-pred (cadr (split str))))))
>>>
>>> (define-match-expander :pat
>>> (lambda (stx)
>>>   (define (rewrite pat)
>>>     (let* ([pat-sym (syntax->datum pat)]
>>>            [pat-str (symbol->string pat-sym)])
>>>       (if (id:type? pat-str)
>>>           (parse-pat-str pat-str stx)
>>>           pat)))
>>>   (syntax-case stx ()
>>>     [(_ pat) (identifier? #'pat) (rewrite #'pat)]
>>>     [(_ (pat ...))
>>>      (with-syntax ([(p ...) (map rewrite (syntax->list  
>>> #'(pat ...)))])
>>>        (syntax/loc stx (p ...)))]
>>>     [(_ pat) #'pat])))
>>>
>>> (define-syntax (:match stx)
>>> (syntax-case stx ()
>>>   [(_ val-expr [pat . more] ...)
>>>    #'(match val-expr [(:pat pat) . more] ...)]))
>>>
>>>
>>> (check-equal? (match 1 [(:pat n:num) n]) 1)
>>> (check-equal? (match 'x [(:pat n:num) n] [_ 2]) 2)
>>>
>>> (check-equal? (match "string" [(:pat s:str) s]) "string")
>>> (check-equal? (match 'x [(:pat s:str) s] [_ 2]) 2)
>>>
>>> (check-equal? (match (list 1 2 3) [(:pat l:lst) l]) (list 1 2 3))
>>> (check-equal? (match 'x [(:pat l:lst) l] [_ 2]) 2)
>>>
>>> (check-equal? (match 'x [(:pat l) l]) 'x)
>>>
>>> (check-equal? (match '(2 x "foo" (3 4)) [(:pat (list n s f l))  
>>> (list n
>>> s f l)]) '(2 x "foo" (3 4)))
>>> (check-equal? (match '(42 x) [(:pat (list n:num s:sym)) (list n  
>>> s)]) '(42
>>> x))
>>>
>>>
>>> (match '(42 x) [(:pat (list n:num s:sym)) (list n s)])
>>> ; (:match '(42 x) [(list n:num s:sym) (list n s)])
>>>
>>>
>>>
>>> 2013/12/28 Alexander D.Knauth <alexander at knauth.org>:
>>>
>>> I just wrote a match-expander that does something like that:
>>>
>>>
>>> (check-equal? (match 1 [(my-pat n:num) n]) 1)
>>>
>>> (check-equal? (match 'x [(my-pat n:num) n] [_ 2]) 2)
>>>
>>>
>>> like this:
>>>
>>>
>>> #lang racket
>>>
>>>
>>> (require rackunit)
>>>
>>> (require (for-syntax
>>>
>>>         (only-in lang/htdp-intermediate-lambda
>>>
>>>                  string-contains?)
>>>
>>>         racket/string
>>>
>>>         racket/match))
>>>
>>>
>>> (define-match-expander my-pat
>>>
>>> (lambda (stx)
>>>
>>>   (syntax-case stx ()
>>>
>>>     [(my-pat pat)
>>>
>>>      (let* ([pat-sym (syntax->datum #'pat)]
>>>
>>>             [pat-str (symbol->string pat-sym)])
>>>
>>>        (cond [(not (string-contains? ":" pat-str))
>>>
>>>               #'pat]
>>>
>>>              [else
>>>
>>>               (parse-pat-str pat-str stx)]))])))
>>>
>>>
>>> (define-for-syntax (parse-pat-str pat-str stx)
>>>
>>> (let ([split-pat (string-split pat-str ":")])
>>>
>>>   (match split-pat
>>>
>>>     [(list pat-name-str type-str)
>>>
>>>      (with-syntax ([type-pred (type-str->stx-type-pred type-str)]
>>>
>>>                    [pat-name (datum->syntax stx (string->symbol
>>>
>>> pat-name-str))])
>>>
>>>        #'(? type-pred pat-name))])))
>>>
>>>
>>> (define-for-syntax (type-str->stx-type-pred type-str)
>>>
>>> (match type-str
>>>
>>>   ["num" #'number?]
>>>
>>>   ["str" #'string?]
>>>
>>>   ["lst" #'list?]))
>>>
>>>
>>> (check-equal? (match 1 [(my-pat n:num) n]) 1)
>>>
>>> (check-equal? (match 'x [(my-pat n:num) n] [_ 2]) 2)
>>>
>>>
>>> (check-equal? (match "string" [(my-pat s:str) s]) "string")
>>>
>>> (check-equal? (match 'x [(my-pat s:str) s] [_ 2]) 2)
>>>
>>>
>>> (check-equal? (match (list 1 2 3) [(my-pat l:lst) l]) (list 1 2 3))
>>>
>>> (check-equal? (match 'x [(my-pat l:lst) l] [_ 2]) 2)
>>>
>>>
>>>
>>>
>>> On Dec 26, 2013, at 2:45 PM, Jens Axel Søgaard wrote:
>>>
>>>
>>> The match pattern (? number? n) matches  number and
>>>
>>> binds it to n.
>>>
>>>
>>> (match 1 [(? number? n) n])
>>>
>>>
>>> 1
>>>
>>>
>>> I'd like to write  (match 1 [n:num n]) instead.
>>>
>>>
>>> Since there is no define-identifier-match-expander I have
>>>
>>> tried to make (match 1 [(n:num) n]) work. I need a hint.
>>>
>>>
>>> Here is a non-working attempt:
>>>
>>>
>>> (define-match-expander n:num
>>>
>>> (λ(stx)
>>>
>>>  (syntax-case stx ()
>>>
>>>    [(id)
>>>
>>>     (with-syntax ([n (syntax/loc #'id n)])
>>>
>>>       #'(? number? n))])))
>>>
>>>
>>>
>>> (check-equal? (match 1 [(n:num) n]) 1)
>>>
>>> (check-equal? (match 'x [(n:num) n] [_ 2]) 2)
>>>
>>>
>>> /Jens Axel
>>>
>>>
>>>
>>>
>>>
>>>
>>>
>>> --
>>>
>>> Jens Axel Søgaard
>>>
>>>
>>> ____________________
>>>
>>> Racket Users list:
>>>
>>> http://lists.racket-lang.org/users
>>>
>>>
>>>
>>>
>>>
>>>
>>> --
>>> --
>>> Jens Axel Søgaard
>>>
>>>
>>> ____________________
>>> Racket Users list:
>>> http://lists.racket-lang.org/users
>>>
>>>
>>
>>
>>
>> -- 
>> --
>> Jens Axel Søgaard
>
> ____________________
>  Racket Users list:
>  http://lists.racket-lang.org/users

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20131230/a92cfae0/attachment-0001.html>