Hi, I have introduced modules and "conventions".
Identifiers in a pattern that begins with sym must match symbols Identifiers in a pattern that begins with r or s must match numbers. Identifiers in a pattern that begins with m or n must match exact integers. The conventions are hard coded, so a nice exension would we to replace the hard coded conventions with user-defineable ones. Something like define-conventions for syntax-parse. http://docs.racket-lang.org/syntax/Literal_Sets_and_Conventions.html?q=syntax-parse#%28form._%28%28lib._syntax%2Fparse..rkt%29._define-conventions%29%29 /Jens Axel #lang racket (require (for-syntax racket/string racket/match) rackunit) (module+ test (require rackunit)) (module conventions racket (provide find-convention-type conventions (struct-out convention)) (require racket/stxparam (for-template racket)) ; A CONVENTION consists of a predicate ; pred? : string -> boolean ; and a syntax object representing an identifier ; bound to a predicate e.g #'number? (struct convention (pred? type)) (define (make-begins-with-pred s) (λ (t) (regexp-match (~a "^" s) t))) (define conventions (list (convention (make-begins-with-pred "sym") #'symbol?) (convention (make-begins-with-pred "r") #'number?) (convention (make-begins-with-pred "s") #'number?) (convention (make-begins-with-pred "m") #'exact-integer?) (convention (make-begins-with-pred "n") #'exact-integer?))) (define (find-convention-type s) (for/or ([c (in-list conventions)]) (and ((convention-pred? c) s) (convention-type c))))) (module+ test (require (submod ".." conventions)) (check-equal? (syntax->datum (find-convention-type "r")) 'number?) (check-equal? (syntax->datum (find-convention-type "sym")) 'symbol?) (check-equal? (find-convention-type "foo") #f)) (module colon-match-helpers racket (provide type-str->stx-type-pred id:type? parse-pat-str) (require (only-in lang/htdp-intermediate-lambda string-contains?) (for-template (only-in racket number? string? symbol? list? vector? boolean? procedure?))) (define (type-str->stx-type-pred type-str) (match type-str ["num" #'number?] ["int" #'integer?] ["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-strs ... type-str) (with-syntax ([type-pred (type-str->stx-type-pred type-str)] [pat-name (datum->syntax stx (string->symbol (string-join pat-name-strs ":")))]) #'(? type-pred pat-name))])) (define (id:type? str) (and (string-contains? ":" str) (<= 2 (length (split str))) (type-str->stx-type-pred (last (split str)))))) (module colon-match racket (provide :match :pat) (require (for-syntax racket/match (submod ".." colon-match-helpers) (submod ".." conventions))) (define-match-expander :pat (lambda (stx) (define (rewrite-id pat) (let* ([pat-sym (syntax->datum pat)] [pat-str (symbol->string pat-sym)]) (cond [(id:type? pat-str) (parse-pat-str pat-str stx)] [(find-convention-type pat-str) => (λ (pred) (with-syntax ([pred pred] [name (datum->syntax stx pat-sym)]) #'(? pred name)))] [else pat]))) (define (rewrite pat_0) (syntax-case pat_0 () [pat (identifier? #'pat) (rewrite-id #'pat)] [pat #'pat])) (syntax-case stx () [(_ pat) (identifier? #'pat) (rewrite-id #'pat)] [(_ #(pat ...)) (syntax/loc stx (vector (:pat pat) ...))] [(_ (pat0 pat ...)) (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat0 pat ...)))]) (syntax/loc stx (p ...)))] [(_ #&pat) (with-syntax ([p (rewrite #'pat)]) (syntax/loc stx #&p))] [(_ pat) (prefab-struct-key (syntax-e #'pat)) (let ([key-datum (prefab-struct-key (syntax-e #'pat))]) (match (struct->vector (syntax-e #'pat)) [(vector struct:key-datum subpats ...) (datum->syntax stx (apply make-prefab-struct key-datum (map rewrite subpats)))]))] [(_ 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))))]) (syntax/loc stx (match val-expr [new-pat . more] ...)))]))) (module+ test (require (submod ".." colon-match)) (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 t f l)) (list n t f l)]) '(2 x "foo" (3 4))) (check-equal? (match '(42 x) [(:pat (list n:num s:sym)) (list n s)]) '(42 x)) (check-equal? (match '(42 x) [(:pat (list n:num s:sym)) (list n s)]) '(42 x)) (check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)]) '(42 x)) (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 (list 1 "2" '|3|) [(list a:1:num b:2:str c:3:sym) (list a:1 (string->number b:2) (string->number (symbol->string c:3)))]) (list 1 2 3)) (check-equal? (:match 42.0 [r r]) 42.0) (check-equal? (:match 42.0 [n n] [r #t]) #t) (check-equal? (:match 'x [r r] [_ 42]) 42) (check-equal? (:match 'x [sym123 sym123]) 'x)) (require (submod "." colon-match)) 2013/12/30 Alexander D. Knauth <alexan...@knauth.org>: > I got it to work for prefab structures. Is there anything else I should put > in? > > (define (rewrite pat_0) > (syntax-case pat_0 () > [pat (identifier? #'pat) (rewrite-id #'pat stx)] > [(pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx (p ...)))] > [#(pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx #(p ...)))] > [#&pat > (with-syntax ([p (rewrite #'pat)]) > (syntax/loc stx #&p))] > [pat (prefab-struct-key (syntax-e #'pat)) > (let ([key-datum (prefab-struct-key (syntax-e #'pat))]) > (match (struct->vector (syntax-e #'pat)) > [(vector struct:key-datum subpats ...) > (datum->syntax stx (apply make-prefab-struct key-datum (map > rewrite subpats)))]))] > [pat #'pat])) > > (check-equal? (:match #s(key-datum 1 2 3) > [`#s(key-datum ,a:num ,b:num ,c:num) (list a b c)]) > (list 1 2 3)) > > (check-equal? (:match #s(key-datum_0 1 2 3) > [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a b c)]) > (list 1 2 3)) > > The whole thing is here: > (by the way I also made it so that something:something-else:num works as a > pattern with the name something:something-else.) > > #lang racket > > (require rackunit) > (require (for-syntax > (only-in lang/htdp-intermediate-lambda > string-contains?) > racket/list > racket/string > racket/match)) > > (begin-for-syntax > (define (type-str->stx-type-pred type-str) > (match type-str > ["num" #'number?] > ["int" #'integer?] > ["str" #'string?] > ["sym" #'symbol?] > ["lst" #'list?] > ["vec" #'vector?] > ["bool" #'boolean?] > ["proc" #'procedure?] > [_ #f])) > > (define (split str) > (string-split str ":")) > > (define (rewrite-id pat stx) > (let* ([pat-sym (syntax->datum pat)] > [pat-str (symbol->string pat-sym)]) > (if (id:type? pat-str) > (parse-pat-str pat-str stx) > pat))) > > (define (parse-pat-str pat-str stx) > (match (split pat-str) > [(list pat-name-strs ... type-str) > (with-syntax ([type-pred (type-str->stx-type-pred type-str)] > [pat-name (datum->syntax stx (string->symbol > (string-join pat-name-strs ":")))]) > #'(? type-pred pat-name))])) > > (define (id:type? str) > (and (string-contains? ":" str) > (<= 2 (length (split str))) > (type-str->stx-type-pred (last (split str))))) > ) > > (define-match-expander :pat > (lambda (stx) > (define (rewrite pat_0) > (syntax-case pat_0 () > [pat (identifier? #'pat) (rewrite-id #'pat stx)] > [(pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx (p ...)))] > [#(pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx #(p ...)))] > [#&pat > (with-syntax ([p (rewrite #'pat)]) > (syntax/loc stx #&p))] > [pat (prefab-struct-key (syntax-e #'pat)) > (let ([key-datum (prefab-struct-key (syntax-e #'pat))]) > (match (struct->vector (syntax-e #'pat)) > [(vector struct:key-datum subpats ...) > (datum->syntax stx (apply make-prefab-struct key-datum > (map rewrite subpats)))]))] > [pat #'pat])) > (syntax-case stx () > [(_ pat) (rewrite #'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 (list 1 "2" '|3|) > [(list a:1:num b:2:str c:3:sym) > (list a:1 (string->number b:2) (string->number > (symbol->string c:3)))]) > (list 1 2 3)) > > (check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4))) > [(list a:num b:num (vector c:num d:num e:num (list > f:num g:num h:num i:num))) > (list a b c d e f g h i)]) > (list 1 2 1 2 3 1 2 3 4)) > > (check-equal? (:match '(1 2 #(1 2 3 (1 2 3 #&4))) > [`(,a:num ,b:num #(,c:num ,d:num ,e:num (,f:num ,g:num > ,h:num #&,i:num))) > (list a b c d e f g h i)]) > (list 1 2 1 2 3 1 2 3 4)) > > (check-equal? (:match #s(key-datum 1 2 3) > [`#s(key-datum ,a:num ,b:num ,c:num) (list a b c)]) > (list 1 2 3)) > > (check-equal? (:match #s(key-datum_0 1 2 3) > [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a b c)]) > (list 1 2 3)) > > > On Dec 29, 2013, at 6:53 PM, Alexander D. Knauth wrote: > > I got it to work for lists, vectors, and boxes, but I'm having trouble for > prefab structure types. > (by the way I renamed the rewrite function to rewrite-id and made a new > rewrite function that deals with lists, vectors, boxes, and prefab > structures.) > > Here's my new rewrite function: > > (define (rewrite pat_0) > (syntax-case pat_0 () > [pat (identifier? #'pat) (rewrite-id #'pat stx)] > [(pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx (p ...)))] > [#(pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx #(p ...)))] > [#&pat > (with-syntax ([p (rewrite #'pat)]) > (syntax/loc stx #&p))] > [#s(key-datum pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx #s(key-datum p ...)))] > [pat #'pat])) > > the problem is that I can't make key-datum a pattern. For example this > works: > > (check-equal? (:match #s(key-datum 1 2 3) > [`#s(key-datum ,a:num ,b:num ,c:num) (list a b c)]) > (list 1 2 3)) > > But this doesn't (because a, b, and c are undefined) > > (check-equal? (:match #s(key-datum_0 1 2 3) > [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a b c)]) > (list 1 2 3)) > > How do I turn the key-datum in #s(key-datum pat ...) into a syntax-case > pattern so that it recognizes all prefab structures instead of just > #s(key-datum pat ...) as opposed to #s(other-key-datum pat ...)? > > Here's the whole thing: > > #lang racket > > (require rackunit) > (require (for-syntax > (only-in lang/htdp-intermediate-lambda > string-contains?) > racket/string > racket/match)) > > (begin-for-syntax > (define (type-str->stx-type-pred type-str) > (match type-str > ["num" #'number?] > ["int" #'integer?] > ["str" #'string?] > ["sym" #'symbol?] > ["lst" #'list?] > ["vec" #'vector?] > ["bool" #'boolean?] > ["proc" #'procedure?] > [_ #f])) > > (define (split str) (string-split str ":")) > > (define (rewrite-id pat stx) > (let* ([pat-sym (syntax->datum pat)] > [pat-str (symbol->string pat-sym)]) > (if (id:type? pat-str) > (parse-pat-str pat-str stx) > pat))) > > (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_0) > (syntax-case pat_0 () > [pat (identifier? #'pat) (rewrite-id #'pat stx)] > [(pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx (p ...)))] > [#(pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx #(p ...)))] > [#&pat > (with-syntax ([p (rewrite #'pat)]) > (syntax/loc stx #&p))] > [#s(key-datum pat ...) > (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))]) > (syntax/loc stx #s(key-datum p ...)))] > [pat #'pat])) > (syntax-case stx () > [(_ pat) (rewrite #'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 c:num d:num e:num (list > f:num g:num h:num i:num))) > (list a b c d e f g h i)]) > (list 1 2 1 2 3 1 2 3 4)) > > (check-equal? (:match '(1 2 #(1 2 3 (1 2 3 #&4))) > [`(,a:num ,b:num #(,c:num ,d:num ,e:num (,f:num ,g:num > ,h:num #&,i:num))) > (list a b c d e f g h i)]) > (list 1 2 1 2 3 1 2 3 4)) > > (check-equal? (:match #s(key-datum 1 2 3) > [`#s(key-datum ,a:num ,b:num ,c:num) (list a b c)]) > (list 1 2 3)) > > ;; this doesn't work: > ; > ;(check-equal? (:match #s(key-datum_0 1 2 3) > ; [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a b c)]) > ; (list 1 2 3)) > > > On Dec 29, 2013, at 4:01 PM, Jens Axel Søgaard wrote: > > 2013/12/29 Alexander D. Knauth <alexan...@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 <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 > > > > > > > -- > -- > 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
