[racket] define-match-expander

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