[racket] define-match-expander

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, 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?

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

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