From b22ed84bdb5f403f22345cf0b4ee919464c99b51 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonyg@leastfixedpoint.com>
Date: Tue, 8 Jun 2021 09:30:29 +0200
Subject: [PATCH] Minor refactoring

---
 syndicate/pattern.rkt | 68 +++++++++++++++++++++----------------------
 1 file changed, 34 insertions(+), 34 deletions(-)

diff --git a/syndicate/pattern.rkt b/syndicate/pattern.rkt
index d54d008..e3783a6 100644
--- a/syndicate/pattern.rkt
+++ b/syndicate/pattern.rkt
@@ -186,49 +186,49 @@
        #`(Pattern-DLit (DLit other))]))
 
   (define (analyse-pattern-bindings stx)
-    (define disarmed-stx (syntax-disarm stx orig-insp))
-    (syntax-case disarmed-stx ($ quasiquote unquote quote)
-      [(ctor args ...)
-       (constructor-registered? #'ctor)
-       ((free-id-table-ref preserves-pattern-registry #'ctor) 'bindings disarmed-stx)]
+    (let walk ((stx stx))
+      (define disarmed-stx (syntax-disarm stx orig-insp))
+      (syntax-case disarmed-stx ($ quasiquote unquote quote)
+        [(ctor args ...)
+         (constructor-registered? #'ctor)
+         ((free-id-table-ref preserves-pattern-registry #'ctor) 'bindings disarmed-stx)]
 
-      [(expander args ...)
-       (pattern-expander-id? #'expander)
-       (pattern-expander-transform disarmed-stx
-                                   (lambda (result)
-                                     (analyse-pattern-bindings (syntax-rearm result stx))))]
+        [(expander args ...)
+         (pattern-expander-id? #'expander)
+         (pattern-expander-transform disarmed-stx
+                                     (lambda (result) (walk (syntax-rearm result stx))))]
 
-      ;; Extremely limited support for quasiquoting and quoting
-      [(quasiquote (unquote p)) (analyse-pattern-bindings #'p)]
-      [(quasiquote (p ...)) (analyse-pattern-bindings #'(list (quasiquote p) ...))]
-      [(quasiquote _p) '()]
-      [(quote _p) '()]
+        ;; Extremely limited support for quasiquoting and quoting
+        [(quasiquote (unquote p)) (walk #'p)]
+        [(quasiquote (p ...)) (walk #'(list (quasiquote p) ...))]
+        [(quasiquote _p) '()]
+        [(quote _p) '()]
 
-      [(ctor piece ...)
-       (struct-info? (id-value #'ctor))
-       (append-map analyse-pattern-bindings (syntax->list #'(piece ...)))]
+        [(ctor piece ...)
+         (struct-info? (id-value #'ctor))
+         (append-map walk (syntax->list #'(piece ...)))]
 
-      [(list-stx piece ...)
-       (list-id? #'list-stx)
-       (append-map analyse-pattern-bindings (syntax->list #'(piece ...)))]
+        [(list-stx piece ...)
+         (list-id? #'list-stx)
+         (append-map walk (syntax->list #'(piece ...)))]
 
-      [(hash-stx piece ...)
-       (hash-or-hasheqv-id? #'hash-stx)
-       (append-map-pairs (lambda (_k v) (analyse-pattern-bindings v)) (syntax->list #'(piece ...)))]
+        [(hash-stx piece ...)
+         (hash-or-hasheqv-id? #'hash-stx)
+         (append-map-pairs (lambda (_k v) (walk v)) (syntax->list #'(piece ...)))]
 
-      [id
-       (dollar-id? #'id)
-       (list (undollar #'id))]
+        [id
+         (dollar-id? #'id)
+         (list (undollar #'id))]
 
-      [($ id p)
-       (cons #'id (analyse-pattern-bindings #'p))]
+        [($ id p)
+         (cons #'id (walk #'p))]
 
-      [id
-       (discard-id? #'id)
-       '()]
+        [id
+         (discard-id? #'id)
+         '()]
 
-      [other
-       '()]))
+        [other
+         '()])))
 
   (define (analyse-template stx)
     (syntax-case stx ($ quasiquote unquote quote)