suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Improve match compilation of ? and fix bugs.

Browse Source 
- Coalesce repeated use of the same predicate.
- Fix scoring of Exact patterns, and scoring generally.
- Use `OrderedAnd` where needed.
- Guarantee that `and` patterns match in order.
- Thread bound variable information properly in GSeq compilation.
- Warn when variables are used non-linearly with `...`
  (making this behave properly was not backwards compatible).

Closes #952, which now runs in <1ms and make it a test case.

Also add margin note about `?` patterns and multiple calls.
This commit is contained in:
Sam Tobin-Hochstadt 2015-06-04 09:47:37 -04:00
parent e1e89adf62
commit fc6ead4ac2
9 changed files with 183 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-doc/scribblings/reference/match.scrbl
View File

@ -290,7 +290,8 @@ In more detail, patterns match as follows:
@item{@racket[(#,(racketidfont "and") _pat ...)] --- matches if all @item{@racket[(#,(racketidfont "and") _pat ...)] --- matches if all
of the @racket[_pat]s match. This pattern is often used as of the @racket[_pat]s match. This pattern is often used as
@racket[(#,(racketidfont "and") _id _pat)] to bind @racket[_id] @racket[(#,(racketidfont "and") _id _pat)] to bind @racket[_id]
to the entire value that matches @racket[pat]. to the entire value that matches @racket[pat]. The @racket[_pat]s are
matched in the order that they appear.
@examples[ @examples[
#:eval match-eval #:eval match-eval
@ -345,6 +346,11 @@ In more detail, patterns match as follows:
@racketidfont{?}, unlike @racketidfont{and}, guarantees that @racketidfont{?}, unlike @racketidfont{and}, guarantees that
@racket[_expr] is matched before any of the @racket[_pat]s. @racket[_expr] is matched before any of the @racket[_pat]s.
@margin-note{The @racket[_expr] procedure may be called more than once
on identical input (although this happens only rarely),
and the order in which calls to @racket[_expr] are
made should not be relied upon.}
@examples[ @examples[
#:eval match-eval #:eval match-eval
(match '(1 3 5) (match '(1 3 5)

48
pkgs/racket-test/tests/match/examples.rkt
View File

@ -728,6 +728,54 @@
[(cons a b) #:when (= a b) 1] [(cons a b) #:when (= a b) 1]
[_ 0])) [_ 0]))
(test-case
"robby's slow example"
(define v
(let ()
(define ht (make-hash))
(define (L4e? e-exp)
(hash-set! ht e-exp (+ (hash-ref ht e-exp 0) 1))
(match e-exp
[`(,(? is-biop?) ,(? L4e?) ,(? L4e?)) #t]
[`(,_ ,(? L4e?)) #t]
[`(new-array ,(? L4e?) ,(? L4e?)) #t]
[`(new-tuple ,(? L4e?) ...) #t]
[`(aref ,(? L4e?) ,(? L4e?)) #t]
[`(aset ,(? L4e?) ,(? L4e?) ,(? L4e?)) #t]
[`(alen ,(? L4e?)) #t]
[`(print ,(? L4e?)) #t]
[`(make-closure ,(? symbol?) ,(? L4e?)) #t]
[`(closure-proc ,(? L4e?)) #t]
[`(begin ,(? L4e?) ,(? L4e?)) #t]
[`(closure-vars ,(? L4e?)) #t]
[`(let ((,(? symbol?) ,(? L4e?))) ,(? L4e?)) #t]
[`(if ,(? L4e?) ,(? L4e?) ,(? L4e?)) #t]
[`(,(? L4e?) ...) #t]
[(? L3v?) #t]
[_ #f]))
(define (is-biop? sym) (or (is-aop? sym) (is-cmp? sym)))
(define (is-aop? sym) (memq sym '(+ - *)))
(define (is-cmp? sym) (memq sym '(< <= =)))
(define (L3v? v) (or (number? v) (symbol? v)))
(list
(L4e? '(let ((less_than (make-closure :lambda_0 (new-tuple))))
(let ((L5_swap (make-closure :lambda_1 (new-tuple))))
(let ((L5_sort_helper (new-tuple 0)))
(begin
(aset L5_sort_helper 0 (make-closure :lambda_2 (new-tuple L5_sort_helper L5_swap)))
(let ((L5_sort (new-tuple 0)))
(begin
(aset L5_sort 0 (make-closure :lambda_3 (new-tuple L5_sort_helper L5_sort)))
(print (let ((f (aref L5_sort 0)))
((closure-proc f)
(closure-vars f)
(new-tuple 3 1 9 4 5 6 2 8 7 10)
less_than))))))))))
(apply max (hash-values ht)))))
(check-true (car v))
(check < (cadr v) 50))
(test-case "syntax-local-match-introduce" (test-case "syntax-local-match-introduce"
(define-match-expander foo (define-match-expander foo
(lambda (stx) (syntax-local-match-introduce #'x))) (lambda (stx) (syntax-local-match-introduce #'x)))

92
racket/collects/racket/match/compiler.rkt
View File

@ -15,13 +15,16 @@
(define vars-seen (make-parameter null)) (define vars-seen (make-parameter null))
(define (hash-on f elems #:equal? [eql #t]) (define (hash-on f elems #:equal? [eql #t])
(define ht (if eql (make-hash) (make-hasheq))) (define-values (ht ref set!)
(case eql
[(#t) (values (make-hash) hash-ref hash-set!)]
[(#f) (values (make-hasheq) hash-ref hash-set!)]))
;; put all the elements e in the ht, indexed by (f e) ;; put all the elements e in the ht, indexed by (f e)
(for ([r (for ([r
;; they need to be in the original order when they come out ;; they need to be in the original order when they come out
(reverse elems)]) (reverse elems)])
(define k (f r)) (define k (f r))
(hash-set! ht k (cons r (hash-ref ht k (lambda () null))))) (set! ht k (cons r (ref ht k (lambda () null)))))
ht) ht)
;; generate a clause of kind k ;; generate a clause of kind k
@ -33,8 +36,7 @@
(map (lambda (row) (map (lambda (row)
(define-values (p ps) (define-values (p ps)
(Row-split-pats row)) (Row-split-pats row))
(define p* (Atom-p p)) (make-Row (cons (make-Dummy #f) ps)
(make-Row (cons p* ps)
(Row-rhs row) (Row-rhs row)
(Row-unmatch row) (Row-unmatch row)
(Row-vars-seen row))) (Row-vars-seen row)))
@ -63,17 +65,8 @@
(compile-con-pat (list #'unsafe-car #'unsafe-cdr) #'pair? (compile-con-pat (list #'unsafe-car #'unsafe-cdr) #'pair?
(lambda (p) (list (Pair-a p) (Pair-d p))))] (lambda (p) (list (Pair-a p) (Pair-d p))))]
[(eq? 'mpair k) [(eq? 'mpair k)
; XXX These should be unsafe-mcar* when mpairs have chaperones
(compile-con-pat (list #'unsafe-mcar #'unsafe-mcdr) #'mpair? (compile-con-pat (list #'unsafe-mcar #'unsafe-mcdr) #'mpair?
(lambda (p) (list (MPair-a p) (MPair-d p))))] (lambda (p) (list (MPair-a p) (MPair-d p))))]
[(eq? 'string k) (constant-pat #'string?)]
[(eq? 'number k) (constant-pat #'number?)]
[(eq? 'symbol k) (constant-pat #'symbol?)]
[(eq? 'keyword k) (constant-pat #'keyword?)]
[(eq? 'char k) (constant-pat #'char?)]
[(eq? 'bytes k) (constant-pat #'bytes?)]
[(eq? 'regexp k) (constant-pat #'regexp?)]
[(eq? 'boolean k) (constant-pat #'boolean?)]
[(eq? 'null k) (constant-pat #'null?)] [(eq? 'null k) (constant-pat #'null?)]
;; vectors are handled specially ;; vectors are handled specially
;; because each arity is like a different constructor ;; because each arity is like a different constructor
@ -116,6 +109,7 @@
accs)] accs)]
[pred (Struct-pred s)]) [pred (Struct-pred s)])
(compile-con-pat accs pred Struct-ps))] (compile-con-pat accs pred Struct-ps))]
[(syntax? k) (constant-pat k)]
[else (error 'match-compile "bad key: ~a" k)])) [else (error 'match-compile "bad key: ~a" k)]))
@ -158,17 +152,27 @@
(Row-vars-seen row))] (Row-vars-seen row))]
;; if we've seen this variable before, check that it's equal to ;; if we've seen this variable before, check that it's equal to
;; the one we saw ;; the one we saw
[(for/or ([e seen]) [(for/or ([e (in-list seen)])
(let ([v* (car e)] [id (cdr e)]) (let ([v* (car e)] [id (cdr e)])
(and (bound-identifier=? v v*) id))) (and (bound-identifier=? v v*) (or id (list v v*)))))
=> =>
(lambda (id) (lambda (id)
(make-Row ps (if (identifier? id)
#`(if ((match-equality-test) #,x #,id) (make-Row ps
#,(Row-rhs row) #`(if ((match-equality-test) #,x #,id)
(fail)) #,(Row-rhs row)
(Row-unmatch row) (fail))
seen))] (Row-unmatch row)
seen)
(begin
(log-error "non-linear pattern used in `match` with ... at ~a and ~a"
(car id) (cadr id))
(let ([v* (free-identifier-mapping-get
(current-renaming) v (lambda () v))])
(make-Row ps
#`(let ([#,v* #,x]) #,(Row-rhs row))
(Row-unmatch row)
(cons (cons v x) (Row-vars-seen row)))))))]
;; otherwise, bind the matched variable to x, and add it to the ;; otherwise, bind the matched variable to x, and add it to the
;; list of vars we've seen ;; list of vars we've seen
[else (let ([v* (free-identifier-mapping-get [else (let ([v* (free-identifier-mapping-get
@ -290,21 +294,18 @@
(Row-vars-seen row))) (Row-vars-seen row)))
#'f))))] #'f))))]
[(Pred? first) [(Pred? first)
;; multiple preds iff they have the identical predicate ;; put all the rows in the hash, indexed by their Pred pattern
(with-syntax ([pred? (Pred-pred first)] ;; we use the pattern so that it can have a custom equal+hash
[body (compile* xs (define ht (hash-on (lambda (r) (Row-first-pat r)) block #:equal? #t))
(map (lambda (row) (with-syntax ([(clauses ...)
(define-values (_1 ps) (hash-map
(Row-split-pats row)) ht (lambda (k v)
(make-Row ps (gen-clause (Pred-pred k) v x xs esc)))])
(Row-rhs row) #`(cond clauses ... [else (#,esc)]))]
(Row-unmatch row) ;; Generalized sequences... slightly tested
(Row-vars-seen row)))
block)
esc)])
#`(cond [(pred? #,x) body] [else (#,esc)]))]
;; Generalized sequences... slightly tested
[(GSeq? first) [(GSeq? first)
(unless (null? (cdr block))
(error 'compile-one "GSeq block with multiple rows: ~a" block))
(let* ([headss (GSeq-headss first)] (let* ([headss (GSeq-headss first)]
[mins (GSeq-mins first)] [mins (GSeq-mins first)]
[maxs (GSeq-maxs first)] [maxs (GSeq-maxs first)]
@ -327,6 +328,12 @@
[head-idss [head-idss
(for/list ([heads headss]) (for/list ([heads headss])
(apply append (map bound-vars heads)))] (apply append (map bound-vars heads)))]
[heads-seen
(map (lambda (x) (cons x #f))
(apply append (map bound-vars heads)))]
[tail-seen
(map (lambda (x) (cons x x))
(bound-vars tail))]
[hid-argss (map generate-temporaries head-idss)] [hid-argss (map generate-temporaries head-idss)]
[head-idss* (map generate-temporaries head-idss)] [head-idss* (map generate-temporaries head-idss)]
[hid-args (apply append hid-argss)] [hid-args (apply append hid-argss)]
@ -368,8 +375,11 @@
(cdr vars) (cdr vars)
(list (make-Row rest-pats k (list (make-Row rest-pats k
(Row-unmatch (car block)) (Row-unmatch (car block))
(Row-vars-seen (append
(car block)))) heads-seen
tail-seen
(Row-vars-seen
(car block)))))
#'fail-tail))])]) #'fail-tail))])])
(parameterize ([current-renaming (parameterize ([current-renaming
(for/fold ([ht (copy-mapping (current-renaming))]) (for/fold ([ht (copy-mapping (current-renaming))])
@ -399,8 +409,10 @@
(list (make-Row (list tail) (list (make-Row (list tail)
#`tail-rhs #`tail-rhs
(Row-unmatch (car block)) (Row-unmatch (car block))
(Row-vars-seen (append
(car block))))) heads-seen
(Row-vars-seen
(car block))))))
#'failkv))))))] #'failkv))))))]
[else (error 'compile "unsupported pattern: ~a\n" first)])) [else (error 'compile "unsupported pattern: ~a\n" first)]))

9
racket/collects/racket/match/parse-helper.rkt
View File

@ -51,7 +51,7 @@
;; rest : the syntax for the rest ;; rest : the syntax for the rest
;; pred? : recognizer for the parsed data structure (such as list?) ;; pred? : recognizer for the parsed data structure (such as list?)
;; to-list: function to convert the value to a list ;; to-list: function to convert the value to a list
(define (dd-parse parse p dd rest pred? #:to-list [to-list #'values] #:mutable [mutable? #f]) (define (dd-parse parse p dd rest pred? #:to-list [to-list #f] #:mutable [mutable? #f])
(define count (ddk? dd)) (define count (ddk? dd))
(define min (and (number? count) count)) (define min (and (number? count) count))
(define pat (parameterize ([match-...-nesting (add1 (match-...-nesting))]) (define pat (parameterize ([match-...-nesting (add1 (match-...-nesting))])
@ -61,7 +61,10 @@
(not min) ;; if we have a count, better generate general code (not min) ;; if we have a count, better generate general code
(Null? rest-pat) (Null? rest-pat)
(or (Var? pat) (Dummy? pat))) (or (Var? pat) (Dummy? pat)))
(make-And (list (make-Pred pred?) (make-App to-list (list pat))))] (make-OrderedAnd (list (make-Pred pred?)
(if to-list
(make-App to-list (list pat))
pat)))]
[else (make-GSeq (list (list pat)) [else (make-GSeq (list (list pat))
(list min) (list min)
;; no upper bound ;; no upper bound
@ -136,7 +139,7 @@
stx pats)]))))))) stx pats)])))))))
(define (trans-match pred transformer pat) (define (trans-match pred transformer pat)
(make-And (list (make-Pred pred) (make-App transformer (list pat))))) (make-OrderedAnd (list (make-Pred pred) (make-App transformer (list pat)))))
;; transform a match-expander application ;; transform a match-expander application
;; parse : stx -> pattern ;; parse : stx -> pattern

7
racket/collects/racket/match/parse-legacy.rkt
View File

@ -40,7 +40,7 @@
(make-Box (parse (unbox (syntax-e #'bx))))] (make-Box (parse (unbox (syntax-e #'bx))))]
[#(es ...) [#(es ...)
(ormap ddk? (syntax->list #'(es ...))) (ormap ddk? (syntax->list #'(es ...)))
(make-And (list (make-Pred #'vector?) (make-OrderedAnd (list (make-Pred #'vector?)
(make-App #'vector->list (make-App #'vector->list
(list (parse (syntax/loc stx (es ...)))))))] (list (parse (syntax/loc stx (es ...)))))))]
[#(es ...) [#(es ...)
@ -48,8 +48,9 @@
[($ s . pats) [($ s . pats)
(parse-struct disarmed-stx parse #'s #'pats)] (parse-struct disarmed-stx parse #'s #'pats)]
[(? p q1 qs ...) [(? p q1 qs ...)
(make-And (cons (make-Pred #'p) (make-OrderedAnd (cons (make-Pred #'p)
(map parse (syntax->list #'(q1 qs ...)))))] (list (make-And
(map parse (syntax->list #'(q1 qs ...)))))))]
[(? p) [(? p)
(make-Pred (rearm #'p))] (make-Pred (rearm #'p))]
[(= f p) [(= f p)

6
racket/collects/racket/match/parse.rkt
View File

@ -38,7 +38,7 @@
(identifier? #'v) (identifier? #'v)
(Var (rearm #'v))] (Var (rearm #'v))]
[(and p ...) [(and p ...)
(And (map rearm+parse (syntax->list #'(p ...))))] (OrderedAnd (map rearm+parse (syntax->list #'(p ...))))]
[(or) [(or)
(Not (Dummy stx))] (Not (Dummy stx))]
[(or p ps ...) [(or p ps ...)
@ -48,7 +48,7 @@
[(not p ...) [(not p ...)
;; nots are conjunctions of negations ;; nots are conjunctions of negations
(let ([ps (map (compose Not rearm+parse) (syntax->list #'(p ...)))]) (let ([ps (map (compose Not rearm+parse) (syntax->list #'(p ...)))])
(And ps))] (OrderedAnd ps))]
[(regexp r) [(regexp r)
(trans-match #'matchable? (trans-match #'matchable?
(rearm #'(lambda (e) (regexp-match r e))) (rearm #'(lambda (e) (regexp-match r e)))
@ -163,7 +163,7 @@
[(? p q1 qs ...) [(? p q1 qs ...)
(OrderedAnd (OrderedAnd
(list (Pred (rearm #'p)) (list (Pred (rearm #'p))
(And (map rearm+parse (syntax->list #'(q1 qs ...))))))] (OrderedAnd (map rearm+parse (syntax->list #'(q1 qs ...))))))]
[(? p) [(? p)
(Pred (rearm #'p))] (Pred (rearm #'p))]
[(app f ps ...) ;; only make a list for more than one pattern [(app f ps ...) ;; only make a list for more than one pattern

46
racket/collects/racket/match/patterns.rkt
View File

@ -38,23 +38,35 @@
(define-struct (Box CPat) (p) #:transparent) (define-struct (Box CPat) (p) #:transparent)
;; p is a pattern to match against the literal ;; p is a pattern to match against the literal
(define-struct (Atom CPat) (p) #:transparent) ;;(define-struct (Atom CPat) (p) #:transparent)
(define-struct (String Atom) () #:transparent) ;(define-struct (String Atom) () #:transparent)
(define-struct (Number Atom) () #:transparent) ;; (define-struct (Number Atom) () #:transparent)
(define-struct (Symbol Atom) () #:transparent) ;; (define-struct (Symbol Atom) () #:transparent)
(define-struct (Keyword Atom) () #:transparent) ;; (define-struct (Keyword Atom) () #:transparent)
(define-struct (Char Atom) () #:transparent) ;; (define-struct (Char Atom) () #:transparent)
(define-struct (Bytes Atom) () #:transparent) ;; (define-struct (Bytes Atom) () #:transparent)
(define-struct (Regexp Atom) () #:transparent) ;; (define-struct (Regexp Atom) () #:transparent)
(define-struct (Boolean Atom) () #:transparent) ;; (define-struct (Boolean Atom) () #:transparent)
(define-struct (Null Atom) () #:transparent) (define-struct (Null CPat) (p) #:transparent)
;; expr is an expression ;; expr is an expression
;; ps is a list of patterns ;; ps is a list of patterns
(define-struct (App Pat) (expr ps) #:transparent) (define-struct (App Pat) (expr ps) #:transparent)
;; pred is an expression ;; pred is an expression
(define-struct (Pred Pat) (pred) #:transparent) (define-struct (Pred Pat) (pred) #:transparent
#:property prop:equal+hash
(list (lambda (a b e?)
(and (identifier? (Pred-pred a)) (identifier? (Pred-pred b))
(free-identifier=? (Pred-pred a) (Pred-pred b))))
(lambda (v r)
(if (identifier? (Pred-pred v))
(r (syntax-e (Pred-pred v)))
(r (Pred-pred v))))
(lambda (v r)
(if (identifier? (Pred-pred v))
(r (syntax-e (Pred-pred v)))
(r (Pred-pred v))))))
;; pred is an identifier ;; pred is an identifier
;; super is an identifier, or #f ;; super is an identifier, or #f
@ -114,14 +126,6 @@
[(Vector? p) 'vector] [(Vector? p) 'vector]
[(Pair? p) 'pair] [(Pair? p) 'pair]
[(MPair? p) 'mpair] [(MPair? p) 'mpair]
[(String? p) 'string]
[(Symbol? p) 'symbol]
[(Number? p) 'number]
[(Bytes? p) 'bytes]
[(Char? p) 'char]
[(Regexp? p) 'regexp]
[(Keyword? p) 'keyword]
[(Boolean? p) 'boolean]
[(Null? p) 'null] [(Null? p) 'null]
[else #f])) [else #f]))
@ -158,7 +162,7 @@
(bound-vars (car (Or-ps p)))] (bound-vars (car (Or-ps p)))]
[(Box? p) [(Box? p)
(bound-vars (Box-p p))] (bound-vars (Box-p p))]
[(Atom? p) null] [(Null? p) null]
[(Pair? p) [(Pair? p)
(merge (list (bound-vars (Pair-a p)) (bound-vars (Pair-d p))))] (merge (list (bound-vars (Pair-a p)) (bound-vars (Pair-d p))))]
[(MPair? p) [(MPair? p)
@ -213,5 +217,5 @@
[rhs syntax?] [rhs syntax?]
[unmatch (or/c identifier? false/c)] [unmatch (or/c identifier? false/c)]
[vars-seen (listof (cons/c identifier? [vars-seen (listof (cons/c identifier?
identifier?))]))) (or/c #f identifier?)))])))

12
racket/collects/racket/match/reorder.rkt
View File

@ -56,25 +56,25 @@
(define (score col) (define (score col)
(define n (length col)) (define n (length col))
(define c (car col)) (define c (car col))
(define preds (list Var? Pair? Null?)) (define preds (list Var? Pair? Null? Exact?))
(cond [(or-all? preds col) (add1 n)] (cond [(or-all? preds col) (add1 n)]
[(andmap CPat? col) n] [(andmap CPat? col) n]
[(Var? c) (count-while Var? col)] [(Var? c) (count-while Var? col)]
[(Pair? c) (count-while Pair? col)] [(Pair? c) (count-while Pair? col)]
[(Vector? c) (count-while Vector? col)] [(Vector? c) (count-while Vector? col)]
[(Box? c) (count-while Box? col)] [(Box? c) (count-while Box? col)]
[(Exact? c) (count-while Exact? col)]
[(Null? c) (count-while Null? col)]
[else 0])) [else 0]))
(define (reorder-by ps scores*) (define (reorder-by ps scores*)
(for/fold (for/list ([score-ref (in-list scores*)])
([pats null]) (list-ref ps score-ref)))
([score-ref scores*])
(cons (list-ref ps score-ref) pats)))
(define (reorder-columns rows vars) (define (reorder-columns rows vars)
(define scores (for/list ([i (in-naturals)] (define scores (for/list ([i (in-naturals)]
[column (in-par (map (compose Row-pats) rows))]) [column (in-par (map Row-pats rows))])
(cons i (score column)))) (cons i (score column))))
(define scores* (reverse (map car (sort scores > #:key cdr)))) (define scores* (reverse (map car (sort scores > #:key cdr))))
(values (values

17
racket/collects/racket/match/split-rows.rkt
View File

@ -21,6 +21,21 @@
(loop/var (cons r matched-rows) prev-mats rs)] (loop/var (cons r matched-rows) prev-mats rs)]
[else [else
(split-rows rows (cons (reverse matched-rows) prev-mats))])))) (split-rows rows (cons (reverse matched-rows) prev-mats))]))))
(define (loop/pred matched-rows prev-mats rows orig)
(if (null? rows)
(reverse (cons (reverse matched-rows) prev-mats))
(let* ([r (car rows)]
[p (Row-first-pat r)]
[rs (cdr rows)])
(cond [(Row-unmatch r)
(split-rows rows (cons (reverse matched-rows) prev-mats))]
[(and (Pred? p) (equal? p orig))
;; use the custom equality on Pred structs
(loop/pred (cons r matched-rows) prev-mats rs orig)]
[else
(split-rows rows (cons (reverse matched-rows) prev-mats))]))))
(define (loop/con matched-rows prev-mats struct-key rows) (define (loop/con matched-rows prev-mats struct-key rows)
(if (null? rows) (if (null? rows)
(reverse (cons (reverse matched-rows) prev-mats)) (reverse (cons (reverse matched-rows) prev-mats))
@ -63,6 +78,8 @@
(loop/var (list r) acc rs)] (loop/var (list r) acc rs)]
[(Exact? p) [(Exact? p)
(loop/exact (list r) acc rs)] (loop/exact (list r) acc rs)]
[(Pred? p)
(loop/pred (list r) acc rs p)]
[(CPat? p) [(CPat? p)
(if (Struct? p) (if (Struct? p)
(begin (begin