From bd9368d889c33c44474d437ce43c29ed35c1f164 Mon Sep 17 00:00:00 2001
From: Noel Welsh <noel@racket-lang.org>
Date: Wed, 1 Dec 2010 15:27:21 +0000
Subject: [PATCH] Refactor code for defining sequences on vector like data
 types. Expose useful building blocks for constructing user defined sequences
 on vector like types (e.g. flvector, f64vector, etc.)

---
 collects/racket/private/for-base.rkt   | 125 +++++++++++
 collects/racket/private/for-vector.rkt | 207 ++++++++++++++++++
 collects/racket/private/for.rkt        | 280 +------------------------
 3 files changed, 341 insertions(+), 271 deletions(-)
 create mode 100644 collects/racket/private/for-base.rkt
 create mode 100644 collects/racket/private/for-vector.rkt

diff --git a/collects/racket/private/for-base.rkt b/collects/racket/private/for-base.rkt
new file mode 100644
index 0000000000..e070cd5ca9
--- /dev/null
+++ b/collects/racket/private/for-base.rkt
@@ -0,0 +1,125 @@
+(module for-base '#%kernel
+
+  (#%require "more-scheme.rkt"
+             "misc.rkt"
+             "define.rkt"
+             "letstx-scheme.rkt"
+             '#%unsafe
+             (for-syntax '#%kernel
+                         "stx.rkt"
+                         "qqstx.rkt"
+                         "define.rkt"
+                         "small-scheme.rkt"
+                         "stxcase-scheme.rkt"))
+
+  (#%provide struct:do-sequence
+             make-do-sequence
+             do-sequence?
+             do-sequence-ref
+             do-sequence-set!
+
+             :do-in
+             
+             prop:sequence
+
+             define-sequence-syntax
+
+             sequence?
+             :sequence?
+             :sequence-ref
+
+             (for-syntax struct:sequence-transformer
+                         make-sequence-transformer
+                         sequence-transformer?
+                         sequence-transformer-ref
+                         sequence-transformer-set!
+                         
+                         create-sequence-transformer))
+  
+  (begin-for-syntax
+    (define-values (struct:sequence-transformer
+                    make-sequence-transformer
+                    sequence-transformer?
+                    sequence-transformer-ref
+                    sequence-transformer-set!)
+      (make-struct-type 'sequence-transformer #f
+                        3 0 #f
+                        null (current-inspector)
+                        0))
+
+    (define (create-sequence-transformer proc1 proc2 cert)
+      (unless (and (procedure? proc1)
+                   (or (procedure-arity-includes? proc1 1)
+                       (procedure-arity-includes? proc1 0)))
+        (raise-type-error 'define-sequence-syntax
+                          "procedure (arity 0 or 1)"
+                          0
+                          proc1 proc2))
+      (unless (and (procedure? proc2)
+                   (procedure-arity-includes? proc2 1))
+        (raise-type-error 'define-sequence-syntax
+                          "procedure (arity 1)"
+                          1
+                          proc1 proc2))
+      (make-sequence-transformer
+       (if (procedure-arity-includes? proc1 0)
+         (lambda (stx)
+           (if (identifier? stx)
+             (proc1)
+             (datum->syntax stx
+                            #`(#,(proc1) . #,(cdr (syntax-e stx)))
+                            stx
+                            stx)))
+         proc1)
+       proc2
+       cert))
+    )
+
+  (define-syntax (:do-in stx)
+    (raise-syntax-error #f
+      "illegal outside of a loop or comprehension binding" stx))
+  
+  (define-values (struct:do-sequence
+                  make-do-sequence
+                  do-sequence?
+                  do-sequence-ref
+                  do-sequence-set!)
+    (make-struct-type 'sequence #f 1 0 #f))
+
+  (define-values (prop:sequence :sequence? :sequence-ref)
+    (make-struct-type-property
+     'sequence
+     (lambda (v sinfo)
+       (unless (and (procedure? v) (procedure-arity-includes? v 1))
+         (raise-type-error 'sequence-property-guard "procedure (arity 1)" v))
+       (lambda (self)
+         (let ([s (v self)])
+           (unless (sequence? s)
+             (raise-mismatch-error
+              'sequence-generate
+              "procedure (value of prop:sequence) produced a non-sequence: "
+              s))
+           s)))))
+
+  (define-syntax define-sequence-syntax
+    (syntax-rules ()
+      [(_ id expr-transformer-expr clause-transformer-expr)
+       (define-syntax id
+         (create-sequence-transformer expr-transformer-expr
+                                      clause-transformer-expr
+                                      (syntax-local-certifier #f)))]))
+
+  (define (sequence? v)
+    (or (do-sequence? v)
+        (list? v)
+        (mpair? v)
+        (vector? v)
+        (string? v)
+        (bytes? v)
+        (input-port? v)
+        (hash? v)
+        (and (:sequence? v) (not (struct-type? v)))))
+  
+  )
+
+  
\ No newline at end of file
diff --git a/collects/racket/private/for-vector.rkt b/collects/racket/private/for-vector.rkt
new file mode 100644
index 0000000000..406363b45c
--- /dev/null
+++ b/collects/racket/private/for-vector.rkt
@@ -0,0 +1,207 @@
+;; Comprehensions for vector like data types
+(module for-vector '#%kernel
+
+  (#%require "more-scheme.rkt"
+             "misc.rkt"
+             "define.rkt"
+             "letstx-scheme.rkt"
+             "for-base.rkt"
+             '#%unsafe
+             (for-syntax '#%kernel
+                         "stx.rkt"
+                         "qqstx.rkt"
+                         "define.rkt"
+                         "small-scheme.rkt"
+                         "stxcase-scheme.rkt"))
+
+  (#%provide in-vector
+             in-string
+             in-bytes
+             
+             :vector-gen
+             :string-gen
+             :bytes-gen
+
+             *in-vector
+             *in-string
+             *in-bytes
+
+             define-in-vector-like
+             define-:vector-like-gen
+
+             (for-syntax make-in-vector-like))
+
+  ;; (: check-ranges (Symbol Natural Natural Integer -> Void))
+  (define (check-ranges who start stop step)
+    (unless (exact-nonnegative-integer? start) (raise-type-error who "exact non-negative integer" start))
+    (unless (exact-nonnegative-integer? stop) (raise-type-error who "exact non-negative integer or #f" stop))
+    (unless (and (exact-integer? step) (not (zero? step)))
+      (raise-type-error who "exact non-zero integer" step))
+    (when (and (< start stop) (< step 0))
+      (raise-mismatch-error who (format "start: ~a less than stop: ~a but given negative step: "
+                                        start stop)
+                            step))
+    (when (and (< stop start) (> step 0))
+      (raise-mismatch-error who (format "start: ~a more than stop: ~a but given positive step: "
+                                        start stop)
+                            step)))
+
+  (define-syntax define-in-vector-like
+    (syntax-rules ()
+      [(define-in-vector-like in-vector-name
+         type-name-str vector?-id vector-length-id :vector-gen-id)
+       (define in-vector-name
+        (case-lambda
+          [(v) (in-vector-name v 0 #f 1)]
+          [(v start) (in-vector-name v start #f 1)]
+          [(v start stop) (in-vector-name v start stop 1)]
+          [(v start stop step)
+           (unless (vector?-id v) (raise-type-error (quote in-vector-name) type-name-str v))
+           (let ([stop (or stop (vector-length-id v))])
+             (check-ranges (quote in-vector-name) start stop step)
+             (make-do-sequence (lambda () (:vector-gen-id v start stop step))))]))]))
+
+  (define-syntax define-:vector-like-gen
+    (syntax-rules ()
+      [(define-:vector-like-gen :vector-like-name unsafe-vector-ref-id)
+       (define (:vector-like-name v start stop step)
+         (values
+          ;; pos->element
+          (lambda (i) (unsafe-vector-ref-id v i))
+          ;; next-pos
+          ;; Minor optimisation.  I assume add1 is faster than \x.x+1
+          (if (= step 1) add1 (lambda (i) (+ i step)))
+          ;; initial pos
+          start
+          ;; continue?
+          (if (> step 0)
+              (lambda (i) (< i stop))
+              (lambda (i) (> i stop)))
+          void
+          void))]))
+
+  (define-for-syntax (make-in-vector-like vector?-id
+                                          unsafe-vector-length-id
+                                          in-vector-id
+                                          unsafe-vector-ref-id)
+     (define (in-vector-like stx)
+       (with-syntax ([vector? vector?-id]
+                     [in-vector in-vector-id]
+                     [unsafe-vector-length unsafe-vector-length-id]
+                     [unsafe-vector-ref unsafe-vector-ref-id])
+         (syntax-case stx ()
+           ;; Fast case
+           [[(id) (_ vec-expr)]
+            #'[(id)
+               (:do-in
+                ;;outer bindings
+                ([(vec len) (let ([vec vec-expr])
+                              (unless (vector? vec)
+                                (in-vector vec))
+                              (values vec (unsafe-vector-length vec)))])
+                ;; outer check
+                #f
+                ;; loop bindings
+                ([pos 0])
+                ;; pos check
+                (pos . unsafe-fx< . len)
+                ;; inner bindings
+                ([(id) (unsafe-vector-ref vec pos)])
+                ;; pre guard
+                #t
+                ;; post guard
+                #t
+                ;; loop args
+                ((unsafe-fx+ 1 pos)))]]
+           ;; General case
+           [((id) (_ vec-expr start))
+            (in-vector-like (syntax ((id) (_ vec-expr start #f 1))))]
+           [((id) (_ vec-expr start stop))
+            (in-vector-like (syntax ((id) (_ vec-expr start stop 1))))]
+           [((id) (_ vec-expr start stop step))
+            (let ([all-fx? (memq (syntax-e #'step) '(1 -1))])
+              #`[(id)
+                 (:do-in
+                  ;; Outer bindings
+                  ;; Prevent multiple evaluation
+                  ([(v* stop*) (let ([vec vec-expr]
+                                     [stop* stop])
+                                 (if (and (not stop*) (vector? vec))
+                                     (values vec (unsafe-vector-length vec))
+                                     (values vec stop*)))]
+                   [(start*) start]
+                   [(step*) step])
+                  ;; Outer check
+                  (when (or (not (vector? v*))
+                            (not (exact-integer? start*))
+                            (not (exact-integer? stop*))
+                            (not (exact-integer? step*))
+                            (zero? step*)
+                            (and (< start* stop*) (< step* 0))
+                            (and (> start* stop*) (> step* 0)))
+                    ;; Let in-vector report the error
+                    (in-vector v* start* stop* step*))
+                  ;; Loop bindings
+                  ([idx start*])
+                  ;; Pos guard
+                  #,(cond
+                     [(not (number? (syntax-e #'step)))
+                      #`(if (step* . >= . 0) (< idx stop*) (> idx stop*))]
+                     [((syntax-e #'step) . >= . 0)
+                      (if all-fx?
+                          #'(unsafe-fx< idx stop*)
+                          #'(< idx stop*))]
+                     [else
+                      (if all-fx?
+                          #'(unsafe-fx> idx stop*)
+                          #'(> idx stop*))])
+                  ;; Inner bindings
+                  ([(id) (unsafe-vector-ref v* idx)])
+                  ;; Pre guard
+                  #t
+                  ;; Post guard
+                  #t
+                  ;; Loop args
+                  ((#,(if all-fx? #'unsafe-fx+ #'+) idx step)))])]
+           [_ #f])))
+          in-vector-like)
+
+  (define-:vector-like-gen :vector-gen unsafe-vector-ref)
+  
+  (define-in-vector-like in-vector
+    "vector" vector? vector-length :vector-gen)
+
+
+  (define-:vector-like-gen :string-gen unsafe-string-ref)
+  
+  (define-in-vector-like in-string
+    "string" string? string-length :string-gen)
+
+
+  (define-:vector-like-gen :bytes-gen unsafe-bytes-ref)
+  
+  (define-in-vector-like in-bytes
+    "bytes" bytes? bytes-length :bytes-gen)
+
+  (define-sequence-syntax *in-vector
+    (lambda () #'in-vector)
+    (make-in-vector-like #'vector?
+                         #'unsafe-vector-length
+                         #'in-vector
+                         #'unsafe-vector-ref))
+
+  (define-sequence-syntax *in-string
+    (lambda () #'in-string)
+    (make-in-vector-like #'string?
+                         #'string-length
+                         #'in-string
+                         #'string-ref))
+
+  (define-sequence-syntax *in-bytes
+    (lambda () #'in-bytes)
+    (make-in-vector-like #'bytes?
+                         #'bytes-length
+                         #'in-bytes
+                         #'bytes-ref))
+  
+  )
\ No newline at end of file
diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt
index d07264c571..f1941474ed 100644
--- a/collects/racket/private/for.rkt
+++ b/collects/racket/private/for.rkt
@@ -4,6 +4,8 @@
              "misc.rkt"
              "define.rkt"
              "letstx-scheme.rkt"
+             "for-base.rkt"
+             "for-vector.rkt"
              '#%unsafe
              (for-syntax '#%kernel
                          "stx.rkt"
@@ -65,47 +67,12 @@
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; sequence transformers:
 
+  ;; Mostly defined in for-base.rkt
+
   (begin-for-syntax
-    (define-values (struct:sequence-transformer
-                    make-sequence-transformer
-                    sequence-transformer?
-                    sequence-transformer-ref
-                    sequence-transformer-set!)
-      (make-struct-type 'sequence-transformer #f
-                        3 0 #f
-                        null (current-inspector)
-                        0))
+   (define cert-key (gensym 'for-cert))
 
-    (define (create-sequence-transformer proc1 proc2 cert)
-      (unless (and (procedure? proc1)
-                   (or (procedure-arity-includes? proc1 1)
-                       (procedure-arity-includes? proc1 0)))
-        (raise-type-error 'define-sequence-syntax
-                          "procedure (arity 0 or 1)"
-                          0
-                          proc1 proc2))
-      (unless (and (procedure? proc2)
-                   (procedure-arity-includes? proc2 1))
-        (raise-type-error 'define-sequence-syntax
-                          "procedure (arity 1)"
-                          1
-                          proc1 proc2))
-      (make-sequence-transformer
-       (if (procedure-arity-includes? proc1 0)
-         (lambda (stx)
-           (if (identifier? stx)
-             (proc1)
-             (datum->syntax stx
-                            #`(#,(proc1) . #,(cdr (syntax-e stx)))
-                            stx
-                            stx)))
-         proc1)
-       proc2
-       cert))
-
-    (define cert-key (gensym 'for-cert))
-
-    (define (certify-clause src-stx clause certifier introducer)
+   (define (certify-clause src-stx clause certifier introducer)
       ;; This is slightly painful. The expansion into `:do-in' involves a lot
       ;; of pieces that are no treated as sub-expressions. We have to push the
       ;; certificates down to all the relevant identifiers and expressions:
@@ -148,7 +115,7 @@
          ;; ill-formed clause...
          clause]))
 
-    (define (expand-clause orig-stx clause)
+       (define (expand-clause orig-stx clause)
       (let eloop ([use-transformer? #t])
         (syntax-case clause (values in-parallel stop-before stop-after :do-in)
           [[(id ...) rhs]
@@ -280,53 +247,10 @@
            (raise-syntax-error #f
              "bad sequence binding clause" orig-stx clause)]))))
 
-  (define-syntax (:do-in stx)
-    (raise-syntax-error #f
-      "illegal outside of a loop or comprehension binding" stx))
-
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;  sequences
 
-  (define-values (struct:do-sequence
-                  make-do-sequence
-                  do-sequence?
-                  do-sequence-ref
-                  do-sequence-set!)
-    (make-struct-type 'sequence #f 1 0 #f))
-
-  (define-values (prop:sequence :sequence? :sequence-ref)
-    (make-struct-type-property
-     'sequence
-     (lambda (v sinfo)
-       (unless (and (procedure? v) (procedure-arity-includes? v 1))
-         (raise-type-error 'sequence-property-guard "procedure (arity 1)" v))
-       (lambda (self)
-         (let ([s (v self)])
-           (unless (sequence? s)
-             (raise-mismatch-error
-              'sequence-generate
-              "procedure (value of prop:sequence) produced a non-sequence: "
-              s))
-           s)))))
-
-  (define-syntax define-sequence-syntax
-    (syntax-rules ()
-      [(_ id expr-transformer-expr clause-transformer-expr)
-       (define-syntax id
-         (create-sequence-transformer expr-transformer-expr
-                                      clause-transformer-expr
-                                      (syntax-local-certifier #f)))]))
-
-  (define (sequence? v)
-    (or (do-sequence? v)
-        (list? v)
-        (mpair? v)
-        (vector? v)
-        (string? v)
-        (bytes? v)
-        (input-port? v)
-        (hash? v)
-        (and (:sequence? v) (not (struct-type? v)))))
+  ;; Also see for-base.rkt
 
   (define (make-sequence who v)
     (cond
@@ -347,7 +271,7 @@
                           who)
                       v)
               (current-continuation-marks)))]))
-
+  
   (define in-range
     (case-lambda
       [(b) (in-range 0 b 1)]
@@ -392,85 +316,6 @@
   (define (:mlist-gen l)
     (values mcar mcdr l mpair? void void))
 
-  (define (check-ranges who start stop step)
-    (unless (exact-nonnegative-integer? start) (raise-type-error who "exact non-negative integer" start))
-    (unless (exact-nonnegative-integer? stop) (raise-type-error who "exact non-negative integer or #f" stop))
-    (unless (and (exact-integer? step) (not (zero? step)))
-      (raise-type-error who "exact non-zero integer" step))
-    (when (and (< start stop) (< step 0))
-      (raise-mismatch-error who (format "start: ~a less than stop: ~a but given negative step: "
-                                        start stop)
-                            step))
-    (when (and (< stop start) (> step 0))
-      (raise-mismatch-error who (format "start: ~a more than stop: ~a but given positive step: "
-                                        start stop)
-                            step)))
-
-  (define in-vector
-    (case-lambda
-     [(v) (in-vector v 0 #f 1)]
-     [(v start) (in-vector v start #f 1)]
-     [(v start stop) (in-vector v start stop 1)]
-     [(v start stop step)
-      (unless (vector? v) (raise-type-error 'in-vector "vector" v))
-      (let ([stop (or stop (vector-length v))])
-        (check-ranges 'in-vector start stop step)
-        (make-do-sequence (lambda () (:vector-gen v start stop step))))]))
-
-  (define (:vector-gen v start stop step)
-    (values
-     ;; pos->element
-     (lambda (i) (unsafe-vector-ref v i))
-     ;; next-pos
-     ;; Minor optimisation.  I assume add1 is faster than \x.x+1
-     (if (= step 1) add1 (lambda (i) (+ i step)))
-     ;; initial pos
-     start
-     ;; continue?
-     (if (> step 0)
-         (lambda (i) (< i stop))
-         (lambda (i) (> i stop)))
-     void
-     void))
-
-  (define in-string
-    (case-lambda
-     [(l) (in-string l 0 #f 1)]
-     [(l start) (in-string l start #f 1)]
-     [(l start stop) (in-string l start stop 1)]
-     [(l start stop step)
-      (unless (string? l) (raise-type-error 'in-string "string" l))
-      (let ([stop (or stop (string-length l))])
-        (check-ranges 'in-string start stop step)
-        (make-do-sequence (lambda () (:string-gen l start stop step))))]))
-
-  (define (:string-gen v start stop step)
-    (values (lambda (i) (string-ref v i))
-            (if (= step 1) add1 (lambda (x) (+ x step)))
-            start
-            (lambda (i) (< i stop))
-            void
-            void))
-
-  (define in-bytes
-    (case-lambda
-     [(l) (in-bytes l 0 #f 1)]
-     [(l start) (in-bytes l start #f 1)]
-     [(l start stop) (in-bytes l start stop 1)]
-     [(l start stop step)
-      (unless (bytes? l) (raise-type-error 'in-bytes "bytes" l))
-      (let ([stop (or stop (bytes-length l))])
-        (check-ranges 'in-bytes start stop step)
-        (make-do-sequence (lambda () (:bytes-gen l start stop step))))]))
-
-  (define (:bytes-gen v start stop step)
-    (values (lambda (i) (bytes-ref v i))
-            (if (= step 1) add1 (lambda (x) (+ x step)))
-            start
-            (lambda (i) (< i stop))
-            void
-            void))
-
   (define (in-input-port-bytes p)
     (unless (input-port? p)
       (raise-type-error 'in-input-port-bytes "input-port" p))
@@ -1147,113 +992,6 @@
              ((mcdr lst)))]]
         [_ #f])))
 
-  (define-for-syntax (vector-like-gen vector?-id
-                                      unsafe-vector-length-id
-                                      in-vector-id
-                                      unsafe-vector-ref-id)
-     (define (in-vector-like stx)
-       (with-syntax ([vector? vector?-id]
-                     [in-vector in-vector-id]
-                     [unsafe-vector-length unsafe-vector-length-id]
-                     [unsafe-vector-ref unsafe-vector-ref-id])
-         (syntax-case stx ()
-           ;; Fast case
-           [[(id) (_ vec-expr)]
-            #'[(id)
-               (:do-in
-                ;;outer bindings
-                ([(vec len) (let ([vec vec-expr])
-                              (unless (vector? vec)
-                                (in-vector vec))
-                              (values vec (unsafe-vector-length vec)))])
-                ;; outer check
-                #f
-                ;; loop bindings
-                ([pos 0])
-                ;; pos check
-                (pos . unsafe-fx< . len)
-                ;; inner bindings
-                ([(id) (unsafe-vector-ref vec pos)])
-                ;; pre guard
-                #t
-                ;; post guard
-                #t
-                ;; loop args
-                ((unsafe-fx+ 1 pos)))]]
-           ;; General case
-           [((id) (_ vec-expr start))
-            (in-vector-like (syntax ((id) (_ vec-expr start #f 1))))]
-           [((id) (_ vec-expr start stop))
-            (in-vector-like (syntax ((id) (_ vec-expr start stop 1))))]
-           [((id) (_ vec-expr start stop step))
-            (let ([all-fx? (memq (syntax-e #'step) '(1 -1))])
-              #`[(id)
-                 (:do-in
-                  ;; Outer bindings
-                  ;; Prevent multiple evaluation
-                  ([(v* stop*) (let ([vec vec-expr]
-                                     [stop* stop])
-                                 (if (and (not stop*) (vector? vec))
-                                     (values vec (unsafe-vector-length vec))
-                                     (values vec stop*)))]
-                   [(start*) start]
-                   [(step*) step])
-                  ;; Outer check
-                  (when (or (not (vector? v*))
-                            (not (exact-integer? start*))
-                            (not (exact-integer? stop*))
-                            (not (exact-integer? step*))
-                            (zero? step*)
-                            (and (< start* stop*) (< step* 0))
-                            (and (> start* stop*) (> step* 0)))
-                    ;; Let in-vector report the error
-                    (in-vector v* start* stop* step*))
-                  ;; Loop bindings
-                  ([idx start*])
-                  ;; Pos guard
-                  #,(cond
-                     [(not (number? (syntax-e #'step)))
-                      #`(if (step* . >= . 0) (< idx stop*) (> idx stop*))]
-                     [((syntax-e #'step) . >= . 0)
-                      (if all-fx?
-                          #'(unsafe-fx< idx stop*)
-                          #'(< idx stop*))]
-                     [else
-                      (if all-fx?
-                          #'(unsafe-fx> idx stop*)
-                          #'(> idx stop*))])
-                  ;; Inner bindings
-                  ([(id) (unsafe-vector-ref v* idx)])
-                  ;; Pre guard
-                  #t
-                  ;; Post guard
-                  #t
-                  ;; Loop args
-                  ((#,(if all-fx? #'unsafe-fx+ #'+) idx step)))])]
-           [_ #f])))
-          in-vector-like)
-
-  (define-sequence-syntax *in-vector
-    (lambda () #'in-vector)
-    (vector-like-gen #'vector?
-                     #'unsafe-vector-length
-                     #'in-vector
-                     #'unsafe-vector-ref))
-
-  (define-sequence-syntax *in-string
-    (lambda () #'in-string)
-    (vector-like-gen #'string?
-                      #'string-length
-                      #'in-string
-                      #'string-ref))
-
-  (define-sequence-syntax *in-bytes
-    (lambda () #'in-bytes)
-    (vector-like-gen #'bytes?
-                     #'bytes-length
-                     #'in-bytes
-                     #'bytes-ref))
-
   (define-sequence-syntax *in-indexed
     (lambda () #'in-indexed)
     (lambda (stx)