From 1f2241c3ce52df711d46750bc93b877cfe5198d2 Mon Sep 17 00:00:00 2001
From: AlexKnauth <alexander@knauth.org>
Date: Fri, 4 Dec 2015 23:28:59 -0500
Subject: [PATCH] refactor define-nested-lenses

to factor out handling definitions into the syntax class
---
 unstable/lens/define-nested.rkt | 35 ++++++++++++---------------------
 1 file changed, 13 insertions(+), 22 deletions(-)

diff --git a/unstable/lens/define-nested.rkt b/unstable/lens/define-nested.rkt
index 47002e8..66a69e0 100644
--- a/unstable/lens/define-nested.rkt
+++ b/unstable/lens/define-nested.rkt
@@ -21,40 +21,31 @@ begin-for-syntax
   (define -lens (update-source-location (datum->syntax #f '-lens)
                                         #:span 5))
   ;; helper syntax-class for define-nested-lenses
-  (define-syntax-class (clause base-id)
+  (define-syntax-class (clause base-id base-lens-tmp)
+    #:attributes (def)
     [pattern [suffix-id:id suffix-lens-expr:expr]
+             #:with base-lens:id base-lens-tmp
              #:do [(define-values [base-suffix-lens-id sub-range-binders]
                      (id-append #:context base-id
                                 base-id -- #'suffix-id -lens))]
-             #:with [base-suffix-lens ...]
-             (list base-suffix-lens-id)
-             #:with [suffix-lens ...]
-             (list #'suffix-lens-expr)
-             #:attr sub-range-binders
-             sub-range-binders])
+             #:with base-suffix-lens
+             base-suffix-lens-id
+             #:with def
+             (with-sub-range-binders
+              #`(define base-suffix-lens
+                  (lens-thrush base-lens suffix-lens-expr))
+              sub-range-binders)])
 
 
 (define-syntax define-nested-lenses
   (syntax-parser
     [(define-nested-lenses [base:id base-lens-expr:expr]
-       (~var clause (clause #'base))
+       (~parse base-lens:id (generate-temporary #'base))
+       (~var clause (clause #'base #'base-lens))
        ...)
-     #:with base-lens:id (generate-temporary #'base)
-     #:with [def ...]
-     (for/list ([base-suffix-lens-ids (in-list (syntax->list #'[[clause.base-suffix-lens] ... ...]))]
-                [suffix-lens-exprs (in-list (syntax->list #'[[clause.suffix-lens ...] ...]))]
-                [sub-range-binders-prop (in-list (attribute clause.sub-range-binders))])
-       (define/syntax-parse [base-suffix-lens ...] base-suffix-lens-ids)
-       (define/syntax-parse [suffix-lens ...] suffix-lens-exprs)
-       (with-sub-range-binders
-        #`(begin
-            (define base-suffix-lens
-              (lens-thrush base-lens suffix-lens))
-            ...)
-        sub-range-binders-prop))
      #'(begin
          (define base-lens base-lens-expr)
-         def
+         clause.def
          ...)]))
 
 module+ test