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 <alexan...@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
____________________
Racket Users list:
http://lists.racket-lang.org/users
