[racket] define-match-expander

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