From fc6ead4ac241cde175d92e72ceaceeb1dcb29c20 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 4 Jun 2015 09:47:37 -0400 Subject: [PATCH] Improve `match` compilation of `?` and fix bugs. - 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. --- .../scribblings/reference/match.scrbl | 8 +- pkgs/racket-test/tests/match/examples.rkt | 48 ++++++++ racket/collects/racket/match/compiler.rkt | 106 ++++++++++-------- racket/collects/racket/match/parse-helper.rkt | 25 +++-- racket/collects/racket/match/parse-legacy.rkt | 7 +- racket/collects/racket/match/parse.rkt | 6 +- racket/collects/racket/match/patterns.rkt | 46 ++++---- racket/collects/racket/match/reorder.rkt | 12 +- racket/collects/racket/match/split-rows.rkt | 17 +++ 9 files changed, 183 insertions(+), 92 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/match.scrbl b/pkgs/racket-doc/scribblings/reference/match.scrbl index 8cc73da8de..73e64e23be 100644 --- a/pkgs/racket-doc/scribblings/reference/match.scrbl +++ b/pkgs/racket-doc/scribblings/reference/match.scrbl @@ -290,7 +290,8 @@ In more detail, patterns match as follows: @item{@racket[(#,(racketidfont "and") _pat ...)] --- matches if all of the @racket[_pat]s match. This pattern is often used as @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[ #:eval match-eval @@ -345,6 +346,11 @@ In more detail, patterns match as follows: @racketidfont{?}, unlike @racketidfont{and}, guarantees that @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[ #:eval match-eval (match '(1 3 5) diff --git a/pkgs/racket-test/tests/match/examples.rkt b/pkgs/racket-test/tests/match/examples.rkt index 0a5b182aa2..618744d638 100644 --- a/pkgs/racket-test/tests/match/examples.rkt +++ b/pkgs/racket-test/tests/match/examples.rkt @@ -727,6 +727,54 @@ (match (cons 1 1) [(cons a b) #:when (= a b) 1] [_ 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" (define-match-expander foo diff --git a/racket/collects/racket/match/compiler.rkt b/racket/collects/racket/match/compiler.rkt index 55e59fd3d2..21ea8e1260 100644 --- a/racket/collects/racket/match/compiler.rkt +++ b/racket/collects/racket/match/compiler.rkt @@ -15,13 +15,16 @@ (define vars-seen (make-parameter null)) (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) (for ([r ;; they need to be in the original order when they come out (reverse elems)]) (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) ;; generate a clause of kind k @@ -33,8 +36,7 @@ (map (lambda (row) (define-values (p ps) (Row-split-pats row)) - (define p* (Atom-p p)) - (make-Row (cons p* ps) + (make-Row (cons (make-Dummy #f) ps) (Row-rhs row) (Row-unmatch row) (Row-vars-seen row))) @@ -63,22 +65,13 @@ (compile-con-pat (list #'unsafe-car #'unsafe-cdr) #'pair? (lambda (p) (list (Pair-a p) (Pair-d p))))] [(eq? 'mpair k) - ; XXX These should be unsafe-mcar* when mpairs have chaperones (compile-con-pat (list #'unsafe-mcar #'unsafe-mcdr) #'mpair? (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?)] ;; vectors are handled specially ;; because each arity is like a different constructor [(eq? 'vector k) - (let ([ht (hash-on (lambda (r) + (let ([ht (hash-on (lambda (r) (length (Vector-ps (Row-first-pat r)))) rows)]) (with-syntax ([(clauses ...) (hash-map @@ -116,6 +109,7 @@ accs)] [pred (Struct-pred s)]) (compile-con-pat accs pred Struct-ps))] + [(syntax? k) (constant-pat k)] [else (error 'match-compile "bad key: ~a" k)])) @@ -148,7 +142,7 @@ (lambda (row) (define-values (p ps) (Row-split-pats row)) (define v (Var-v p)) - (define seen (Row-vars-seen row)) + (define seen (Row-vars-seen row)) ;; a new row with the rest of the patterns (cond ;; if this was a wild-card variable, don't bind @@ -158,17 +152,27 @@ (Row-vars-seen row))] ;; if we've seen this variable before, check that it's equal to ;; the one we saw - [(for/or ([e seen]) - (let ([v* (car e)] [id (cdr e)]) - (and (bound-identifier=? v v*) id))) + [(for/or ([e (in-list seen)]) + (let ([v* (car e)] [id (cdr e)]) + (and (bound-identifier=? v v*) (or id (list v v*))))) => (lambda (id) - (make-Row ps - #`(if ((match-equality-test) #,x #,id) - #,(Row-rhs row) - (fail)) - (Row-unmatch row) - seen))] + (if (identifier? id) + (make-Row ps + #`(if ((match-equality-test) #,x #,id) + #,(Row-rhs row) + (fail)) + (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 ;; list of vars we've seen [else (let ([v* (free-identifier-mapping-get @@ -200,7 +204,7 @@ [qs (Or-ps (car pats))] ;; the variables bound by this pattern - they're the same for the ;; whole list - [vars + [vars (for/list ([bv (bound-vars (car qs))] #:when (for/and ([seen-var seen]) (not (free-identifier=? bv (car seen-var))))) @@ -246,7 +250,7 @@ esc))))] ;; the And rule [(And? first) - ;; we only handle 1-row Ands + ;; we only handle 1-row Ands ;; this is all the mixture rule should give us (unless (null? (cdr block)) (error 'compile-one "And block with multiple rows: ~a" block)) @@ -290,21 +294,18 @@ (Row-vars-seen row))) #'f))))] [(Pred? first) - ;; multiple preds iff they have the identical predicate - (with-syntax ([pred? (Pred-pred first)] - [body (compile* xs - (map (lambda (row) - (define-values (_1 ps) - (Row-split-pats row)) - (make-Row ps - (Row-rhs row) - (Row-unmatch row) - (Row-vars-seen row))) - block) - esc)]) - #`(cond [(pred? #,x) body] [else (#,esc)]))] - ;; Generalized sequences... slightly tested + ;; put all the rows in the hash, indexed by their Pred pattern + ;; we use the pattern so that it can have a custom equal+hash + (define ht (hash-on (lambda (r) (Row-first-pat r)) block #:equal? #t)) + (with-syntax ([(clauses ...) + (hash-map + ht (lambda (k v) + (gen-clause (Pred-pred k) v x xs esc)))]) + #`(cond clauses ... [else (#,esc)]))] + ;; Generalized sequences... slightly tested [(GSeq? first) + (unless (null? (cdr block)) + (error 'compile-one "GSeq block with multiple rows: ~a" block)) (let* ([headss (GSeq-headss first)] [mins (GSeq-mins first)] [maxs (GSeq-maxs first)] @@ -327,6 +328,12 @@ [head-idss (for/list ([heads headss]) (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)] [head-idss* (map generate-temporaries head-idss)] [hid-args (apply append hid-argss)] @@ -368,8 +375,11 @@ (cdr vars) (list (make-Row rest-pats k (Row-unmatch (car block)) - (Row-vars-seen - (car block)))) + (append + heads-seen + tail-seen + (Row-vars-seen + (car block))))) #'fail-tail))])]) (parameterize ([current-renaming (for/fold ([ht (copy-mapping (current-renaming))]) @@ -399,8 +409,10 @@ (list (make-Row (list tail) #`tail-rhs (Row-unmatch (car block)) - (Row-vars-seen - (car block))))) + (append + heads-seen + (Row-vars-seen + (car block)))))) #'failkv))))))] [else (error 'compile "unsupported pattern: ~a\n" first)])) @@ -409,7 +421,7 @@ (if (stx-null? clauses) body (quasisyntax (let* #,clauses #,body)))) - (cond + (cond ;; if there are no rows, then just call the esc continuation [(null? rows) #`(#,esc)] ;; if we have no variables, there are no more patterns to match @@ -461,8 +473,8 @@ ;; esc [c (compile-one vars (car blocks) esc)]) ;; then compile the rest, with our name as the esc - (loop (cdr blocks) - #'f + (loop (cdr blocks) + #'f (cons #`[f #,(syntax-property #'(lambda () c) 'typechecker:called-in-tail-position #t)] diff --git a/racket/collects/racket/match/parse-helper.rkt b/racket/collects/racket/match/parse-helper.rkt index 252602d0dd..3b5508f870 100644 --- a/racket/collects/racket/match/parse-helper.rkt +++ b/racket/collects/racket/match/parse-helper.rkt @@ -37,8 +37,8 @@ (parse (quasisyntax/loc stx (quote #,e)))))] [(quote bx) (box? (syntax-e #'bx)) - (make-Box (parse (quasisyntax/loc - stx + (make-Box (parse (quasisyntax/loc + stx (quote #,(unbox (syntax-e #'bx))))))] [(quote v) (or (parse-literal (syntax-e #'v)) @@ -51,7 +51,7 @@ ;; rest : the syntax for the rest ;; pred? : recognizer for the parsed data structure (such as 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 min (and (number? count) count)) (define pat (parameterize ([match-...-nesting (add1 (match-...-nesting))]) @@ -61,7 +61,10 @@ (not min) ;; if we have a count, better generate general code (Null? rest-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)) (list min) ;; no upper bound @@ -95,7 +98,7 @@ 5)]) (cond [(equal? super #t) (values #t '())] ;; no super type exists [(equal? super #f) (values #f '())] ;; super type is unknown - [else + [else (let-values ([(complete? lineage) (get-lineage super)]) (values complete? (cons super lineage)))]))) @@ -111,12 +114,12 @@ [(not (car acc)) (cdr acc)] [else acc])]) (make-Struct pred - (syntax-property - pred + (syntax-property + pred 'disappeared-use (list struct-name)) lineage (and (checked-struct-info? v) complete?) acc - (cond [(eq? '_ (syntax-e pats)) + (cond [(eq? '_ (syntax-e pats)) (map make-Dummy acc)] [(syntax->list pats) => @@ -136,7 +139,7 @@ stx pats)]))))))) (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 ;; parse : stx -> pattern @@ -157,7 +160,7 @@ (define introducer (make-syntax-introducer)) (parameterize ([current-match-introducer introducer]) (let* ([mstx (introducer (syntax-local-introduce stx))] - [mresult (if (procedure-arity-includes? transformer 2) + [mresult (if (procedure-arity-includes? transformer 2) (transformer expander* mstx) (transformer mstx))] [result (syntax-local-introduce (introducer mresult))]) @@ -205,7 +208,7 @@ ;; (listof pat) syntax -> void ;; ps is never null ;; check that all the ps bind the same set of variables -(define (all-vars ps stx) +(define (all-vars ps stx) (let* ([first-vars (bound-vars (car ps))] [l (length ps)] [ht (make-free-identifier-mapping)]) diff --git a/racket/collects/racket/match/parse-legacy.rkt b/racket/collects/racket/match/parse-legacy.rkt index 763840f8df..522d36957b 100644 --- a/racket/collects/racket/match/parse-legacy.rkt +++ b/racket/collects/racket/match/parse-legacy.rkt @@ -40,7 +40,7 @@ (make-Box (parse (unbox (syntax-e #'bx))))] [#(es ...) (ormap ddk? (syntax->list #'(es ...))) - (make-And (list (make-Pred #'vector?) + (make-OrderedAnd (list (make-Pred #'vector?) (make-App #'vector->list (list (parse (syntax/loc stx (es ...)))))))] [#(es ...) @@ -48,8 +48,9 @@ [($ s . pats) (parse-struct disarmed-stx parse #'s #'pats)] [(? p q1 qs ...) - (make-And (cons (make-Pred #'p) - (map parse (syntax->list #'(q1 qs ...)))))] + (make-OrderedAnd (cons (make-Pred #'p) + (list (make-And + (map parse (syntax->list #'(q1 qs ...)))))))] [(? p) (make-Pred (rearm #'p))] [(= f p) diff --git a/racket/collects/racket/match/parse.rkt b/racket/collects/racket/match/parse.rkt index d881cd9b01..9804a7f853 100644 --- a/racket/collects/racket/match/parse.rkt +++ b/racket/collects/racket/match/parse.rkt @@ -38,7 +38,7 @@ (identifier? #'v) (Var (rearm #'v))] [(and p ...) - (And (map rearm+parse (syntax->list #'(p ...))))] + (OrderedAnd (map rearm+parse (syntax->list #'(p ...))))] [(or) (Not (Dummy stx))] [(or p ps ...) @@ -48,7 +48,7 @@ [(not p ...) ;; nots are conjunctions of negations (let ([ps (map (compose Not rearm+parse) (syntax->list #'(p ...)))]) - (And ps))] + (OrderedAnd ps))] [(regexp r) (trans-match #'matchable? (rearm #'(lambda (e) (regexp-match r e))) @@ -163,7 +163,7 @@ [(? p q1 qs ...) (OrderedAnd (list (Pred (rearm #'p)) - (And (map rearm+parse (syntax->list #'(q1 qs ...))))))] + (OrderedAnd (map rearm+parse (syntax->list #'(q1 qs ...))))))] [(? p) (Pred (rearm #'p))] [(app f ps ...) ;; only make a list for more than one pattern diff --git a/racket/collects/racket/match/patterns.rkt b/racket/collects/racket/match/patterns.rkt index 0cbc9c446b..196ca7d9c0 100644 --- a/racket/collects/racket/match/patterns.rkt +++ b/racket/collects/racket/match/patterns.rkt @@ -38,23 +38,35 @@ (define-struct (Box CPat) (p) #:transparent) ;; p is a pattern to match against the literal -(define-struct (Atom CPat) (p) #:transparent) -(define-struct (String Atom) () #:transparent) -(define-struct (Number Atom) () #:transparent) -(define-struct (Symbol Atom) () #:transparent) -(define-struct (Keyword Atom) () #:transparent) -(define-struct (Char Atom) () #:transparent) -(define-struct (Bytes Atom) () #:transparent) -(define-struct (Regexp Atom) () #:transparent) -(define-struct (Boolean Atom) () #:transparent) -(define-struct (Null Atom) () #:transparent) +;;(define-struct (Atom CPat) (p) #:transparent) +;(define-struct (String Atom) () #:transparent) +;; (define-struct (Number Atom) () #:transparent) +;; (define-struct (Symbol Atom) () #:transparent) +;; (define-struct (Keyword Atom) () #:transparent) +;; (define-struct (Char Atom) () #:transparent) +;; (define-struct (Bytes Atom) () #:transparent) +;; (define-struct (Regexp Atom) () #:transparent) +;; (define-struct (Boolean Atom) () #:transparent) +(define-struct (Null CPat) (p) #:transparent) ;; expr is an expression ;; ps is a list of patterns (define-struct (App Pat) (expr ps) #:transparent) ;; 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 ;; super is an identifier, or #f @@ -114,14 +126,6 @@ [(Vector? p) 'vector] [(Pair? p) 'pair] [(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] [else #f])) @@ -158,7 +162,7 @@ (bound-vars (car (Or-ps p)))] [(Box? p) (bound-vars (Box-p p))] - [(Atom? p) null] + [(Null? p) null] [(Pair? p) (merge (list (bound-vars (Pair-a p)) (bound-vars (Pair-d p))))] [(MPair? p) @@ -213,5 +217,5 @@ [rhs syntax?] [unmatch (or/c identifier? false/c)] [vars-seen (listof (cons/c identifier? - identifier?))]))) + (or/c #f identifier?)))]))) diff --git a/racket/collects/racket/match/reorder.rkt b/racket/collects/racket/match/reorder.rkt index 44cc47fa56..75e134e9ef 100644 --- a/racket/collects/racket/match/reorder.rkt +++ b/racket/collects/racket/match/reorder.rkt @@ -56,25 +56,25 @@ (define (score col) (define n (length 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)] [(andmap CPat? col) n] [(Var? c) (count-while Var? col)] [(Pair? c) (count-while Pair? col)] [(Vector? c) (count-while Vector? col)] [(Box? c) (count-while Box? col)] + [(Exact? c) (count-while Exact? col)] + [(Null? c) (count-while Null? col)] [else 0])) (define (reorder-by ps scores*) - (for/fold - ([pats null]) - ([score-ref scores*]) - (cons (list-ref ps score-ref) pats))) + (for/list ([score-ref (in-list scores*)]) + (list-ref ps score-ref))) (define (reorder-columns rows vars) (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)))) (define scores* (reverse (map car (sort scores > #:key cdr)))) (values diff --git a/racket/collects/racket/match/split-rows.rkt b/racket/collects/racket/match/split-rows.rkt index 45bafc258c..541900a8b4 100644 --- a/racket/collects/racket/match/split-rows.rkt +++ b/racket/collects/racket/match/split-rows.rkt @@ -21,6 +21,21 @@ (loop/var (cons r matched-rows) prev-mats rs)] [else (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) (if (null? rows) (reverse (cons (reverse matched-rows) prev-mats)) @@ -63,6 +78,8 @@ (loop/var (list r) acc rs)] [(Exact? p) (loop/exact (list r) acc rs)] + [(Pred? p) + (loop/pred (list r) acc rs p)] [(CPat? p) (if (Struct? p) (begin