<html><body style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space; "><div>I got it to work for prefab structures. Is there anything else I should put in?</div><div><br></div><div><div><font class="Apple-style-span" face="'Courier New'"><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'">(define (rewrite pat_0)</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (syntax-case pat_0 ()</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> [pat (identifier? #'pat) (rewrite-id #'pat stx)]</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> [(pat ...)</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx (p ...)))]</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> [#(pat ...)</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #(p ...)))]</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> [#&pat</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([p (rewrite #'pat)])</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #&p))]</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> [pat (prefab-struct-key (syntax-e #'pat))</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (let ([key-datum (prefab-struct-key (syntax-e #'pat))])</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (match (struct->vector (syntax-e #'pat))</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> [(vector struct:key-datum subpats ...)</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> (datum->syntax stx (apply make-prefab-struct key-datum (map rewrite subpats)))]))]</font></div><div style="font-family: Helvetica; "><font class="Apple-style-span" face="'Courier New'"> [pat #'pat]))</font></div></font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #s(key-datum 1 2 3)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [`#s(key-datum ,a:num ,b:num ,c:num) (list a b c)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 3))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #s(key-datum_0 1 2 3)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a b c)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 3))</font></div></div><div><br></div><div>The whole thing is here:</div><div>(by the way I also made it so that something:something-else:num works as a pattern with the name something:something-else.)</div><div><br></div><div><div><font class="Apple-style-span" face="'Courier New'">#lang racket</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(require rackunit)</font></div><div><font class="Apple-style-span" face="'Courier New'">(require (for-syntax</font></div><div><font class="Apple-style-span" face="'Courier New'"> (only-in lang/htdp-intermediate-lambda</font></div><div><font class="Apple-style-span" face="'Courier New'"> string-contains?)</font></div><div><font class="Apple-style-span" face="'Courier New'"> racket/list</font></div><div><font class="Apple-style-span" face="'Courier New'"> racket/string</font></div><div><font class="Apple-style-span" face="'Courier New'"> racket/match))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(begin-for-syntax</font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (type-str->stx-type-pred type-str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (match type-str</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["num" #'number?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["int" #'integer?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["str" #'string?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["sym" #'symbol?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["lst" #'list?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["vec" #'vector?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["bool" #'boolean?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["proc" #'procedure?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [_ #f]))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (split str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (string-split str ":"))</font></div><div><font class="Apple-style-span" face="'Courier New'"> </font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (rewrite-id pat stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (let* ([pat-sym (syntax->datum pat)]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat-str (symbol->string pat-sym)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (if (id:type? pat-str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (parse-pat-str pat-str stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> pat)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> </font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (parse-pat-str pat-str stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (match (split pat-str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(list pat-name-strs ... type-str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([type-pred (type-str->stx-type-pred type-str)]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat-name (datum->syntax stx (string->symbol (string-join pat-name-strs ":")))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> #'(? type-pred pat-name))]))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (id:type? str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (and (string-contains? ":" str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (<= 2 (length (split str)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (type-str->stx-type-pred (last (split str)))))</font></div><div><font class="Apple-style-span" face="'Courier New'"> )</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(define-match-expander :pat</font></div><div><font class="Apple-style-span" face="'Courier New'"> (lambda (stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (rewrite pat_0)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax-case pat_0 ()</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat (identifier? #'pat) (rewrite-id #'pat stx)]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(pat ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx (p ...)))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [#(pat ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #(p ...)))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [#&pat</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([p (rewrite #'pat)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #&p))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat (prefab-struct-key (syntax-e #'pat))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (let ([key-datum (prefab-struct-key (syntax-e #'pat))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (match (struct->vector (syntax-e #'pat))</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(vector struct:key-datum subpats ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (datum->syntax stx (apply make-prefab-struct key-datum (map rewrite subpats)))]))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat #'pat]))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax-case stx ()</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(_ pat) (rewrite #'pat)])))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(define-syntax (:match stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax-case stx ()</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(:match val-expr [pat . more] ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(new-pat ...) (for/list ([pat-stx (in-list (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (datum->syntax pat-stx `(:pat ,(syntax->datum pat-stx))))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> #'(match val-expr [new-pat . more] ...))]))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 1 [n:num n]) 1)</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [n:num n] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match "string" [s:str s]) "string")</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [s:str s] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match (list 1 2 3) [l:lst l]) (list 1 2 3))</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [l:lst l] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match (vector 1 2 3) [v:vec v]) (vector 1 2 3))</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [v:vec v] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #t [b:bool b]) #t)</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #f [b:bool b]) #f)</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [b:bool b] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [l l]) 'x)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match '(2 x "foo" (3 4)) [(list n s f l) (list n s f l)]) '(2 x "foo" (3 4)))</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)]) '(42 x))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match (list 1 "2" '|3|)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(list a:1:num b:2:str c:3:sym)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list a:1 (string->number b:2) (string->number (symbol->string c:3)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 3))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(list a:num b:num (vector c:num d:num e:num (list f:num g:num h:num i:num)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list a b c d e f g h i)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 1 2 3 1 2 3 4))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match '(1 2 #(1 2 3 (1 2 3 #&4)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> [`(,a:num ,b:num #(,c:num ,d:num ,e:num (,f:num ,g:num ,h:num #&,i:num)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list a b c d e f g h i)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 1 2 3 1 2 3 4))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #s(key-datum 1 2 3)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [`#s(key-datum ,a:num ,b:num ,c:num) (list a b c)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 3))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #s(key-datum_0 1 2 3)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a b c)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 3))</font></div></div><div><br></div><br><div><div>On Dec 29, 2013, at 6:53 PM, Alexander D. Knauth wrote:</div><br class="Apple-interchange-newline"><blockquote type="cite"><div style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space; "><div>I got it to work for lists, vectors, and boxes, but I'm having trouble for prefab structure types. </div><div>(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.)</div><div><br></div><div>Here's my new rewrite function:</div><div><br></div><div><div><font class="Apple-style-span" face="'Courier New'">(define (rewrite pat_0)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax-case pat_0 ()</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat (identifier? #'pat) (rewrite-id #'pat stx)]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(pat ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx (p ...)))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [#(pat ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #(p ...)))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [#&pat</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([p (rewrite #'pat)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #&p))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [#s(key-datum pat ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #s(key-datum p ...)))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat #'pat]))</font></div></div><div><br></div><div>the problem is that I can't make key-datum a pattern. For example this works:</div><div><br></div><div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #s(key-datum 1 2 3)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [`#s(key-datum ,a:num ,b:num ,c:num) (list a b c)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 3))</font></div></div><div><br></div><div>But this doesn't (because a, b, and c are undefined)</div><div><br></div><div><div><span class="Apple-style-span" style="font-family: 'Courier New'; ">(check-equal? (:match #s(key-datum_0 1 2 3)</span></div><div><font class="Apple-style-span" face="'Courier New'"> [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a b c)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 3))</font></div></div><div><br></div><div>How do I turn the key-datum in <span class="Apple-style-span" style="font-family: 'Courier New'; ">#s(key-datum pat ...)</span> 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 ...)? </div><div><br></div><div>Here's the whole thing:</div><div><br></div><div><div><font class="Apple-style-span" face="'Courier New'">#lang racket</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(require rackunit)</font></div><div><font class="Apple-style-span" face="'Courier New'">(require (for-syntax</font></div><div><font class="Apple-style-span" face="'Courier New'"> (only-in lang/htdp-intermediate-lambda</font></div><div><font class="Apple-style-span" face="'Courier New'"> string-contains?)</font></div><div><font class="Apple-style-span" face="'Courier New'"> racket/string</font></div><div><font class="Apple-style-span" face="'Courier New'"> racket/match))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(begin-for-syntax</font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (type-str->stx-type-pred type-str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (match type-str</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["num" #'number?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["int" #'integer?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["str" #'string?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["sym" #'symbol?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["lst" #'list?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["vec" #'vector?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["bool" #'boolean?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> ["proc" #'procedure?]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [_ #f]))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (split str) (string-split str ":"))</font></div><div><font class="Apple-style-span" face="'Courier New'"> </font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (rewrite-id pat stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (let* ([pat-sym (syntax->datum pat)]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat-str (symbol->string pat-sym)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (if (id:type? pat-str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (parse-pat-str pat-str stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> pat)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> </font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (parse-pat-str pat-str stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (match (split pat-str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(list pat-name-str type-str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([type-pred (type-str->stx-type-pred type-str)]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat-name (datum->syntax stx (string->symbol pat-name-str))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> #'(? type-pred pat-name))]))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (id:type? str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (and (string-contains? ":" str)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (= 2 (length (split str)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (type-str->stx-type-pred (cadr (split str)))))</font></div><div><font class="Apple-style-span" face="'Courier New'"> )</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(define-match-expander :pat</font></div><div><font class="Apple-style-span" face="'Courier New'"> (lambda (stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (define (rewrite pat_0)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax-case pat_0 ()</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat (identifier? #'pat) (rewrite-id #'pat stx)]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(pat ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx (p ...)))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [#(pat ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #(p ...)))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [#&pat</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([p (rewrite #'pat)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #&p))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [#s(key-datum pat ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax/loc stx #s(key-datum p ...)))]</font></div><div><font class="Apple-style-span" face="'Courier New'"> [pat #'pat]))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax-case stx ()</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(_ pat) (rewrite #'pat)])))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(define-syntax (:match stx)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (syntax-case stx ()</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(:match val-expr [pat . more] ...)</font></div><div><font class="Apple-style-span" face="'Courier New'"> (with-syntax ([(new-pat ...) (for/list ([pat-stx (in-list (syntax->list #'(pat ...)))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (datum->syntax pat-stx `(:pat ,(syntax->datum pat-stx))))])</font></div><div><font class="Apple-style-span" face="'Courier New'"> #'(match val-expr [new-pat . more] ...))]))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 1 [n:num n]) 1)</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [n:num n] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match "string" [s:str s]) "string")</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [s:str s] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match (list 1 2 3) [l:lst l]) (list 1 2 3))</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [l:lst l] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match (vector 1 2 3) [v:vec v]) (vector 1 2 3))</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [v:vec v] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #t [b:bool b]) #t)</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #f [b:bool b]) #f)</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [b:bool b] [_ 2]) 2)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match 'x [l l]) 'x)</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match '(2 x "foo" (3 4)) [(list n s f l) (list n s f l)]) '(2 x "foo" (3 4)))</font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)]) '(42 x))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> [(list a:num b:num (vector c:num d:num e:num (list f:num g:num h:num i:num)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list a b c d e f g h i)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 1 2 3 1 2 3 4))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match '(1 2 #(1 2 3 (1 2 3 #&4)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> [`(,a:num ,b:num #(,c:num ,d:num ,e:num (,f:num ,g:num ,h:num #&,i:num)))</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list a b c d e f g h i)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 1 2 3 1 2 3 4))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">(check-equal? (:match #s(key-datum 1 2 3)</font></div><div><font class="Apple-style-span" face="'Courier New'"> [`#s(key-datum ,a:num ,b:num ,c:num) (list a b c)])</font></div><div><font class="Apple-style-span" face="'Courier New'"> (list 1 2 3))</font></div><div><font class="Apple-style-span" face="'Courier New'"><br></font></div><div><font class="Apple-style-span" face="'Courier New'">;; this doesn't work:</font></div><div><font class="Apple-style-span" face="'Courier New'">;</font></div><div><font class="Apple-style-span" face="'Courier New'">;(check-equal? (:match #s(key-datum_0 1 2 3)</font></div><div><font class="Apple-style-span" face="'Courier New'">; [`#s(key-datum_0 ,a:num ,b:num ,c:num) (list a b c)])</font></div><div><font class="Apple-style-span" face="'Courier New'">; (list 1 2 3))</font></div></div><div><br></div><br><div><div>On Dec 29, 2013, at 4:01 PM, Jens Axel Søgaard wrote:</div><br class="Apple-interchange-newline"><blockquote type="cite"><div>2013/12/29 Alexander D. Knauth <<a href="mailto:alexander@knauth.org">alexander@knauth.org</a>>:<br><blockquote type="cite">I was seeing if it would work with nested patterns and quasiquoted patterns<br></blockquote><blockquote type="cite">and it didn't, so I had to change the rewrite function and use (vector?<br></blockquote><blockquote type="cite">(syntax-e pat)) to check for a vector written like `#(,a:num ,b:num ,c:num).<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">like this:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (define (rewrite pat)<br></blockquote><blockquote type="cite"> (cond [(identifier? pat) (let* ([pat-sym (syntax->datum pat)]<br></blockquote><blockquote type="cite"> [pat-str (symbol->string pat-sym)])<br></blockquote><blockquote type="cite"> (if (id:type? pat-str)<br></blockquote><blockquote type="cite"> (parse-pat-str pat-str stx)<br></blockquote><blockquote type="cite"> pat))]<br></blockquote><blockquote type="cite"> [(syntax->list pat) (datum->syntax pat (map rewrite (syntax->list<br></blockquote><blockquote type="cite">pat)))]<br></blockquote><blockquote type="cite"> [(vector? (syntax-e pat)) (datum->syntax pat (vector-map rewrite<br></blockquote><blockquote type="cite">(syntax-e pat)))]<br></blockquote><blockquote type="cite"> [else (print pat) (newline) (error "I don't know what to do.<br></blockquote><blockquote type="cite">given:" pat)]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">For the vector thing, I had to put a special clause in that did a vector-map<br></blockquote><blockquote type="cite">instead of a map.<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">Is there any other stuff (like the #(1 2 3) notation for vectors) that I<br></blockquote><blockquote type="cite">should be worried about,<br></blockquote><br>There are boxes and prefab structures. See the list here:<br><br><a href="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">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</a><br><br><blockquote type="cite">... or is there another way to write the rewrite<br></blockquote><blockquote type="cite">function to handle stuff like this that wouldn't require a cond case for<br></blockquote><blockquote type="cite">every type of data that pat could be?<br></blockquote><br>I don't see a way around it.<br><br>/Jens Axel<br><br><br><br><blockquote type="cite"><br></blockquote><blockquote type="cite">The whole thing is here:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">#lang racket<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(require rackunit)<br></blockquote><blockquote type="cite">(require (for-syntax<br></blockquote><blockquote type="cite"> (only-in lang/htdp-intermediate-lambda<br></blockquote><blockquote type="cite"> string-contains?)<br></blockquote><blockquote type="cite"> racket/string<br></blockquote><blockquote type="cite"> racket/match<br></blockquote><blockquote type="cite"> racket/vector))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(begin-for-syntax<br></blockquote><blockquote type="cite"> (define (type-str->stx-type-pred type-str)<br></blockquote><blockquote type="cite"> (match type-str<br></blockquote><blockquote type="cite"> ["num" #'number?]<br></blockquote><blockquote type="cite"> ["str" #'string?]<br></blockquote><blockquote type="cite"> ["sym" #'symbol?]<br></blockquote><blockquote type="cite"> ["lst" #'list?]<br></blockquote><blockquote type="cite"> ["vec" #'vector?]<br></blockquote><blockquote type="cite"> ["bool" #'boolean?]<br></blockquote><blockquote type="cite"> ["proc" #'procedure?]<br></blockquote><blockquote type="cite"> [_ #f]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (define (split str) (string-split str ":"))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (define (parse-pat-str pat-str stx)<br></blockquote><blockquote type="cite"> (match (split pat-str)<br></blockquote><blockquote type="cite"> [(list pat-name-str type-str)<br></blockquote><blockquote type="cite"> (with-syntax ([type-pred (type-str->stx-type-pred type-str)]<br></blockquote><blockquote type="cite"> [pat-name (datum->syntax stx (string->symbol<br></blockquote><blockquote type="cite">pat-name-str))])<br></blockquote><blockquote type="cite"> #'(? type-pred pat-name))]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (define (id:type? str)<br></blockquote><blockquote type="cite"> (and (string-contains? ":" str)<br></blockquote><blockquote type="cite"> (= 2 (length (split str)))<br></blockquote><blockquote type="cite"> (type-str->stx-type-pred (cadr (split str)))))<br></blockquote><blockquote type="cite"> )<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-match-expander :pat<br></blockquote><blockquote type="cite"> (lambda (stx)<br></blockquote><blockquote type="cite"> (define (rewrite pat)<br></blockquote><blockquote type="cite"> (cond [(identifier? pat) (let* ([pat-sym (syntax->datum pat)]<br></blockquote><blockquote type="cite"> [pat-str (symbol->string pat-sym)])<br></blockquote><blockquote type="cite"> (if (id:type? pat-str)<br></blockquote><blockquote type="cite"> (parse-pat-str pat-str stx)<br></blockquote><blockquote type="cite"> pat))]<br></blockquote><blockquote type="cite"> [(syntax->list pat) (datum->syntax pat (map rewrite (syntax->list<br></blockquote><blockquote type="cite">pat)))]<br></blockquote><blockquote type="cite"> [(vector? (syntax-e pat)) (datum->syntax pat (vector-map rewrite<br></blockquote><blockquote type="cite">(syntax-e pat)))]<br></blockquote><blockquote type="cite"> [else (print pat) (newline) (error "I don't know what to do.<br></blockquote><blockquote type="cite">given:" pat)]))<br></blockquote><blockquote type="cite"> (syntax-case stx ()<br></blockquote><blockquote type="cite"> [(_ pat) (identifier? #'pat) (rewrite #'pat)]<br></blockquote><blockquote type="cite"> [(_ (pat ...))<br></blockquote><blockquote type="cite"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])<br></blockquote><blockquote type="cite"> (syntax/loc stx (p ...)))]<br></blockquote><blockquote type="cite"> [(_ pat) #'pat])))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-syntax (:match stx)<br></blockquote><blockquote type="cite"> (syntax-case stx ()<br></blockquote><blockquote type="cite"> [(:match val-expr [pat . more] ...)<br></blockquote><blockquote type="cite"> (with-syntax ([(new-pat ...) (for/list ([pat-stx (in-list (syntax->list<br></blockquote><blockquote type="cite">#'(pat ...)))])<br></blockquote><blockquote type="cite"> (datum->syntax pat-stx `(:pat<br></blockquote><blockquote type="cite">,(syntax->datum pat-stx))))])<br></blockquote><blockquote type="cite"> #'(match val-expr [new-pat . more] ...))]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match 1 [n:num n]) 1)<br></blockquote><blockquote type="cite">(check-equal? (:match 'x [n:num n] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match "string" [s:str s]) "string")<br></blockquote><blockquote type="cite">(check-equal? (:match 'x [s:str s] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match (list 1 2 3) [l:lst l]) (list 1 2 3))<br></blockquote><blockquote type="cite">(check-equal? (:match 'x [l:lst l] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match (vector 1 2 3) [v:vec v]) (vector 1 2 3))<br></blockquote><blockquote type="cite">(check-equal? (:match 'x [v:vec v] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match #t [b:bool b]) #t)<br></blockquote><blockquote type="cite">(check-equal? (:match #f [b:bool b]) #f)<br></blockquote><blockquote type="cite">(check-equal? (:match 'x [b:bool b] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match 'x [l l]) 'x)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match '(2 x "foo" (3 4)) [(list n s f l) (list n s f l)])<br></blockquote><blockquote type="cite">'(2 x "foo" (3 4)))<br></blockquote><blockquote type="cite">(check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)]) '(42 x))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4)))<br></blockquote><blockquote type="cite"> [(list a:num b:num (vector a:num b:num c:num (list<br></blockquote><blockquote type="cite">a:num b:num c:num d:num)))<br></blockquote><blockquote type="cite"> (list a b c d)])<br></blockquote><blockquote type="cite"> (list 1 2 3 4))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match '(1 2 #(1 2 3 (1 2 3 4)))<br></blockquote><blockquote type="cite"> [`(,a:num ,b:num #(,a:num ,b:num ,c:num (,a:num ,b:num<br></blockquote><blockquote type="cite">,c:num ,d:num)))<br></blockquote><blockquote type="cite"> (list a b c d)])<br></blockquote><blockquote type="cite"> (list 1 2 3 4))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">On Dec 29, 2013, at 12:04 PM, Alexander D. Knauth wrote:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">I'm not really sure why this works either, but try this:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-syntax (:match stx)<br></blockquote><blockquote type="cite"> (syntax-case stx ()<br></blockquote><blockquote type="cite"> [(:match val-expr [pat . more] ...)<br></blockquote><blockquote type="cite"> (with-syntax ([(new-pat ...) (for/list ([pat-stx (in-list (syntax->list<br></blockquote><blockquote type="cite">#'(pat ...)))])<br></blockquote><blockquote type="cite"> (datum->syntax pat-stx `(:pat<br></blockquote><blockquote type="cite">,(syntax->datum pat-stx))))])<br></blockquote><blockquote type="cite"> #'(match val-expr [new-pat . more] ...))]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (:match '(42 x) [(list n:num s:sym) (list n s)])<br></blockquote><blockquote type="cite"> (match '(42 x) [(:pat (list n:num s:sym)) (list n s)]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">On Dec 29, 2013, at 8:54 AM, Jens Axel Søgaard wrote:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">Hi Alexander,<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">I extended your example to allow other patterns than symbols inside :pat.<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(match '(42 x) [(:pat (list n:num s:sym)) (list n s)])<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (list 42 x)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">This works fine. I now want to "hide" the :pat, that is I want to write:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (:match '(42 x) [(list n:num s:sym) (list n s)])<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">Since the syntax of match is: (match val-expr clause ...) and each clause<br></blockquote><blockquote type="cite">has the form [pat . more] we can rewrite pat to [(:pat pat) . more].<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">So I tried this:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (define-syntax (:match stx)<br></blockquote><blockquote type="cite"> (syntax-case stx ()<br></blockquote><blockquote type="cite"> [(_ val-expr [pat . more] ...)<br></blockquote><blockquote type="cite"> #'(match val-expr [(:pat pat) . more] ...)]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">This doesn't work however. I am tempted to consider this a bug in match,<br></blockquote><blockquote type="cite">but I am not sure.<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">#lang racket<br></blockquote><blockquote type="cite">(require (for-syntax (only-in lang/htdp-intermediate-lambda<br></blockquote><blockquote type="cite">string-contains?)<br></blockquote><blockquote type="cite"> racket/string<br></blockquote><blockquote type="cite"> racket/match)<br></blockquote><blockquote type="cite"> rackunit)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(begin-for-syntax<br></blockquote><blockquote type="cite"> (define (type-str->stx-type-pred type-str)<br></blockquote><blockquote type="cite"> (match type-str<br></blockquote><blockquote type="cite"> ["num" #'number?]<br></blockquote><blockquote type="cite"> ["str" #'string?]<br></blockquote><blockquote type="cite"> ["sym" #'symbol?]<br></blockquote><blockquote type="cite"> ["lst" #'list?]<br></blockquote><blockquote type="cite"> [_ #f]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (define (split str) (string-split str ":"))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (define (parse-pat-str pat-str stx)<br></blockquote><blockquote type="cite"> (match (split pat-str)<br></blockquote><blockquote type="cite"> [(list pat-name-str type-str)<br></blockquote><blockquote type="cite"> (with-syntax ([type-pred (type-str->stx-type-pred type-str)]<br></blockquote><blockquote type="cite"> [pat-name (datum->syntax stx (string->symbol<br></blockquote><blockquote type="cite">pat-name-str))])<br></blockquote><blockquote type="cite"> #'(? type-pred pat-name))]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (define (id:type? str)<br></blockquote><blockquote type="cite"> (and (string-contains? ":" str)<br></blockquote><blockquote type="cite"> (type-str->stx-type-pred (cadr (split str))))))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-match-expander :pat<br></blockquote><blockquote type="cite"> (lambda (stx)<br></blockquote><blockquote type="cite"> (define (rewrite pat)<br></blockquote><blockquote type="cite"> (let* ([pat-sym (syntax->datum pat)]<br></blockquote><blockquote type="cite"> [pat-str (symbol->string pat-sym)])<br></blockquote><blockquote type="cite"> (if (id:type? pat-str)<br></blockquote><blockquote type="cite"> (parse-pat-str pat-str stx)<br></blockquote><blockquote type="cite"> pat)))<br></blockquote><blockquote type="cite"> (syntax-case stx ()<br></blockquote><blockquote type="cite"> [(_ pat) (identifier? #'pat) (rewrite #'pat)]<br></blockquote><blockquote type="cite"> [(_ (pat ...))<br></blockquote><blockquote type="cite"> (with-syntax ([(p ...) (map rewrite (syntax->list #'(pat ...)))])<br></blockquote><blockquote type="cite"> (syntax/loc stx (p ...)))]<br></blockquote><blockquote type="cite"> [(_ pat) #'pat])))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-syntax (:match stx)<br></blockquote><blockquote type="cite"> (syntax-case stx ()<br></blockquote><blockquote type="cite"> [(_ val-expr [pat . more] ...)<br></blockquote><blockquote type="cite"> #'(match val-expr [(:pat pat) . more] ...)]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 1 [(:pat n:num) n]) 1)<br></blockquote><blockquote type="cite">(check-equal? (match 'x [(:pat n:num) n] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match "string" [(:pat s:str) s]) "string")<br></blockquote><blockquote type="cite">(check-equal? (match 'x [(:pat s:str) s] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match (list 1 2 3) [(:pat l:lst) l]) (list 1 2 3))<br></blockquote><blockquote type="cite">(check-equal? (match 'x [(:pat l:lst) l] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 'x [(:pat l) l]) 'x)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match '(2 x "foo" (3 4)) [(:pat (list n s f l)) (list n<br></blockquote><blockquote type="cite">s f l)]) '(2 x "foo" (3 4)))<br></blockquote><blockquote type="cite">(check-equal? (match '(42 x) [(:pat (list n:num s:sym)) (list n s)]) '(42<br></blockquote><blockquote type="cite">x))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(match '(42 x) [(:pat (list n:num s:sym)) (list n s)])<br></blockquote><blockquote type="cite">; (:match '(42 x) [(list n:num s:sym) (list n s)])<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">2013/12/28 Alexander D.Knauth <<a href="mailto:alexander@knauth.org">alexander@knauth.org</a>>:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">I just wrote a match-expander that does something like that:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 1 [(my-pat n:num) n]) 1)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 'x [(my-pat n:num) n] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">like this:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">#lang racket<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(require rackunit)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(require (for-syntax<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (only-in lang/htdp-intermediate-lambda<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> string-contains?)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> racket/string<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> racket/match))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-match-expander my-pat<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (lambda (stx)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (syntax-case stx ()<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> [(my-pat pat)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (let* ([pat-sym (syntax->datum #'pat)]<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> [pat-str (symbol->string pat-sym)])<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (cond [(not (string-contains? ":" pat-str))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> #'pat]<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> [else<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (parse-pat-str pat-str stx)]))])))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-for-syntax (parse-pat-str pat-str stx)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (let ([split-pat (string-split pat-str ":")])<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (match split-pat<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> [(list pat-name-str type-str)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (with-syntax ([type-pred (type-str->stx-type-pred type-str)]<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> [pat-name (datum->syntax stx (string->symbol<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">pat-name-str))])<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> #'(? type-pred pat-name))])))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-for-syntax (type-str->stx-type-pred type-str)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (match type-str<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> ["num" #'number?]<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> ["str" #'string?]<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> ["lst" #'list?]))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 1 [(my-pat n:num) n]) 1)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 'x [(my-pat n:num) n] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match "string" [(my-pat s:str) s]) "string")<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 'x [(my-pat s:str) s] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match (list 1 2 3) [(my-pat l:lst) l]) (list 1 2 3))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 'x [(my-pat l:lst) l] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">On Dec 26, 2013, at 2:45 PM, Jens Axel Søgaard wrote:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">The match pattern (? number? n) matches number and<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">binds it to n.<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(match 1 [(? number? n) n])<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> 1<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">I'd like to write (match 1 [n:num n]) instead.<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">Since there is no define-identifier-match-expander I have<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">tried to make (match 1 [(n:num) n]) work. I need a hint.<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">Here is a non-working attempt:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(define-match-expander n:num<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(λ(stx)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (syntax-case stx ()<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> [(id)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> (with-syntax ([n (syntax/loc #'id n)])<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"> #'(? number? n))])))<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 1 [(n:num) n]) 1)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">(check-equal? (match 'x [(n:num) n] [_ 2]) 2)<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">/Jens Axel<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">--<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">Jens Axel Søgaard<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">____________________<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">Racket Users list:<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><a href="http://lists.racket-lang.org/users">http://lists.racket-lang.org/users</a><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">--<br></blockquote><blockquote type="cite">--<br></blockquote><blockquote type="cite">Jens Axel Søgaard<br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite">____________________<br></blockquote><blockquote type="cite"> Racket Users list:<br></blockquote><blockquote type="cite"> <a href="http://lists.racket-lang.org/users">http://lists.racket-lang.org/users</a><br></blockquote><blockquote type="cite"><br></blockquote><blockquote type="cite"><br></blockquote><br><br><br>-- <br>--<br>Jens Axel Søgaard<br></div></blockquote></div><br></div>____________________<br> Racket Users list:<br> <a href="http://lists.racket-lang.org/users">http://lists.racket-lang.org/users</a><br></blockquote></div><br></body></html>