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