[racket] define-match-expander

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

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