use syntax-local-apply-transformer

Switch enforestation-level expansion away from a custom expansion step
and scope management, and use `syntax-local-apply-transformer`,
instead. Thanks to @michaelballantyne for reminding me how this is
supposed to work.

enforest/main.rkt

@@ -211,11 +211,12 @@
           [() (raise-syntax-error #f (format "missing ~a" form-kind-str) stxes)]
           [(head::name . tail)
            (define name-path? (starts-like-name-path? #'head #'tail))
+           (define head-name (and name-path? (in-name-root-space #'head.name)))
            (cond
              [(and name-path?
-                   (syntax-local-value* (in-name-root-space #'head.name) name-root-ref))
+                   (syntax-local-value* head-name name-root-ref))
               => (lambda (v)
-                   (define-values (head tail) (apply-name-root #'head.name v in-space stxes))
+                   (define-values (head tail) (apply-name-root head-name v in-space stxes))
                    (enforest-step (datum->syntax #f (cons head tail)) current-op current-op-stx stop-on-unbound?))]
              [else
               (define head-id (in-space #'head.name))
@@ -271,11 +272,12 @@
           [() (values init-form stxes)]
           [(head::name . tail)
            (define name-path? (starts-like-name-path? #'head #'tail))
+           (define head-name (and name-path? (in-name-root-space #'head.name)))
            (cond
              [(and name-path?
-                   (syntax-local-value* (in-name-root-space #'head.name) name-root-ref))
+                   (syntax-local-value* head-name name-root-ref))
               => (lambda (v)
-                   (define-values (head tail) (apply-name-root #'head.name v in-space stxes))
+                   (define-values (head tail) (apply-name-root head-name v in-space stxes))
                    (enforest-step init-form (datum->syntax #f (cons head tail)) current-op current-op-stx stop-on-unbound?))]
              [else
               (define head-id (in-space #'head.name))

enforest/name-root.rkt

@@ -17,17 +17,20 @@
 
 (define (apply-name-root op-stx lxc in-space stxes)
   (define proc (name-root-proc lxc))
-  (call-as-transformer
-   op-stx
-   syntax-track-origin
-   (lambda (in out)
-     (define-values (target tail) (proc in-space (in stxes)))
-     (unless (or (identifier? target)
-                 (and (syntax? target)
-                      (pair? (syntax-e target))
-                      (eq? 'op (syntax-e (car (syntax-e target))))))
-       (raise-result-error (proc-name proc) "identifier-or-operator?" target))
-     (check-transformer-result (out target) (out tail) proc))))
+  (define-values (target tail)
+    (call-as-transformer
+     op-stx
+     (list stxes)
+     syntax-track-origin
+     (lambda (stxes)
+       (define-values (target tail) (proc in-space stxes))
+       (unless (or (identifier? target)
+                   (and (syntax? target)
+                        (pair? (syntax-e target))
+                        (eq? 'op (syntax-e (car (syntax-e target))))))
+         (raise-result-error (proc-name proc) "identifier-or-operator?" target))
+       (values target tail))))
+  (check-transformer-result target tail proc))
 
 (define (name-root-ref-root v ref)
   (ref v))

enforest/operator.rkt

@@ -136,8 +136,8 @@
        [else dir])]))
 
 (define (lookup-prefix-implicit alone-name adj-context adj-form in-space operator-ref operator-kind form-kind)
-  (define op-stx (datum->syntax adj-context alone-name))
-  (define op (syntax-local-value* (in-space op-stx) operator-ref))
+  (define op-stx (in-space (datum->syntax adj-context alone-name)))
+  (define op (syntax-local-value* op-stx operator-ref))
   (unless op
     (raise-syntax-error #f
                         (format (string-append
@@ -155,8 +155,8 @@
 
 (define (lookup-infix-implicit adjacent-name prev-form adj-context adj-form in-space operator-ref operator-kind form-kind
                                stop-on-unbound? lookup-space-description)
-  (define op-stx (datum->syntax adj-context adjacent-name))
-  (define op (syntax-local-value* (in-space op-stx) operator-ref))
+  (define op-stx (in-space (datum->syntax adj-context adjacent-name)))
+  (define op (syntax-local-value* op-stx operator-ref))
   (unless op
     (cond
       [(identifier? prev-form)
@@ -215,39 +215,48 @@
   #f)
 
 (define (apply-prefix-direct-operator op form stx track-origin checker)
-  (call-as-transformer
-   stx
-   track-origin
-   (lambda (in out)
-     (define proc (operator-proc op))
-     (out (checker (proc (in form) stx) proc)))))
+  (define proc (operator-proc op))
+  (checker
+   (call-as-transformer
+    stx
+    (list form)
+    track-origin
+    (lambda (form)
+      (proc form stx)))
+   proc))
 
 (define (apply-infix-direct-operator op form1 form2 stx track-origin checker)
-  (call-as-transformer
-   stx
-   track-origin
-   (lambda (in out)
-     (define proc (operator-proc op))
-     (checker (out (proc (in form1) (in form2) stx)) proc))))
+  (define proc (operator-proc op))
+  (checker (call-as-transformer
+            stx
+            (list form1 form2)
+            track-origin
+            (lambda (form1 form2)
+              (proc form1 form2 stx)))
+           proc))
 
 (define (apply-prefix-transformer-operator op op-stx tail track-origin checker)
   (define proc (operator-proc op))
-  (call-as-transformer
-   op-stx
-   track-origin
-   (lambda (in out)
-     (define-values (form new-tail) (proc (in tail)))
-     (check-transformer-result (out (checker form proc))
-                               (out new-tail)
-                               proc))))
+  (define-values (form new-tail)
+    (call-as-transformer
+     op-stx
+     (list tail)
+     track-origin
+     (lambda (tail)
+       (define-values (form new-tail) (proc tail))
+       (values (checker form proc)
+               new-tail))))
+  (check-transformer-result form new-tail proc))
 
 (define (apply-infix-transformer-operator op op-stx form1 tail track-origin checker)
   (define proc (operator-proc op))
-  (call-as-transformer
-   op-stx
-   track-origin
-   (lambda (in out)
-     (define-values (form new-tail) (proc (in form1) (in tail)))
-     (check-transformer-result (out (checker form proc))
-                               (out new-tail)
-                               proc))))
+  (define-values (form new-tail)
+    (call-as-transformer
+     op-stx
+     (list form1 tail)
+     track-origin
+     (lambda (form1 tail)
+       (define-values (form new-tail) (proc form1 tail))
+       (values (checker form proc)
+               new-tail))))
+  (check-transformer-result form new-tail proc))

enforest/private/transform.rkt

@@ -10,29 +10,33 @@
 
 (define no-props (datum->syntax #f #f))
 
-(define current-transformer-introduce (make-parameter (lambda (stx) stx)))
 (define (transform-in stx)
-  ((current-transformer-introduce) stx))
+  (syntax-local-introduce stx))
 (define (transform-out stx)
-  ((current-transformer-introduce) stx))
+  (syntax-local-introduce stx))
 
-(define (call-as-transformer id track-origin thunk)
-  (define intro (make-syntax-introducer))
-  (parameterize ([current-transformer-introduce intro])
-    (thunk intro
-           (lambda (stx)
-             (let loop ([stx stx])
-               (cond
-                 [(syntax? stx)
-                  (track-origin (intro stx)
-                                (let ([du (syntax-property id 'disappeared-use)])
-                                  (if du
-                                      (syntax-property no-props 'disappeared-use du)
-                                      no-props))
-                                id)]
-                 [(pair? stx) (cons (loop (car stx))
-                                    (loop (cdr stx)))]
-                 [else stx]))))))
+(define (call-as-transformer id args track-origin proc)
+  (call-with-values
+   (lambda ()
+     (apply syntax-local-apply-transformer
+            proc
+            id
+            ;; for now, use contexts that imply no use-site scopes:
+            (if (eq? 'top-level (syntax-local-context))
+                'top-level
+                'expression)
+            #f
+            (map syntax-local-introduce args)))
+   (lambda stxes
+     (apply values (map syntax-local-introduce (map (track track-origin id) stxes))))))
+
+(define ((track track-origin id) stx)
+  (track-origin stx
+                (let ([du (syntax-property id 'disappeared-use)])
+                  (if du
+                      (syntax-property no-props 'disappeared-use du)
+                      no-props))
+                id))
 
 (define (check-transformer-result form tail proc)
   (unless (syntax? form) (raise-result-error (proc-name proc) "syntax?" form))
@@ -51,4 +55,3 @@
                    (syntax-track-origin e from-stx id))
                  stx
                  stx))
-

enforest/sequence.rkt

@@ -78,11 +78,13 @@
 
 (define (apply-sequence-transformer t id stx tail track-origin checker)
   (define proc (sequence-transformer-proc t))
-  (call-as-transformer
-   id
-   track-origin
-   (lambda (in out)
-     (define-values (forms new-tail) (proc (in stx) (in tail)))
-     (check-transformer-result (out (datum->syntax #f (checker forms proc)))
-                               (out new-tail)
-                               proc))))
+  (define-values (forms new-tail)
+    (call-as-transformer
+     id
+     (list stx tail)
+     track-origin
+     (lambda (stx tail)
+       (define-values (forms new-tail) (proc stx tail))
+       (values (datum->syntax #f (checker forms proc))
+               (datum->syntax #f new-tail)))))
+  (check-transformer-result forms new-tail proc))

enforest/transformer.rkt

@@ -18,8 +18,6 @@
          transformer
          transformer-ref
 
-         transform-in
-         transform-out
          call-as-transformer
 
          track-sequence-origin
@@ -116,7 +114,8 @@
   (define proc (transformer-proc t))
   (call-as-transformer
    id
+   (list stx)
    track-origin
-   (lambda (in out)
-     (define forms (checker (proc (in stx)) proc))
-     (datum->syntax #f (out forms)))))
+   (lambda (stx)
+     (define forms (checker (proc stx) proc))
+     (datum->syntax #f forms))))

rhombus/private/binding.rkt

@@ -57,13 +57,12 @@
                                          "cannot find a transformer for an infoer"
                                          #'infoer-id))]
              #:with info (check-binding-info-result
-                          (transform-out
-                           (let ([form (transform-in #'form)])
-                             (call-as-transformer
-                              #'infoer-id
-                              syntax-track-origin
-                              (lambda (in out)
-                                (out (proc (in form)))))))
+                          (let ([form #'form])
+                            (call-as-transformer
+                             #'infoer-id
+                             (list form)
+                             syntax-track-origin
+                             proc))
                           proc)))
 
   ;; To unpack a binding infoer result:

rhombus/private/export.rkt

@@ -92,26 +92,26 @@
     #:make-identifier-form make-identifier-export
     #:make-operator-form make-identifier-export)
 
-  (define (make-export-modifier-ref transform-in ex)
+  (define (make-export-modifier-ref ex)
     ;; "accessor" closes over `ex`:
     (lambda (v)
       (define mod (export-modifier-ref v))
       (and mod
            (transformer (lambda (stx)
-                          ((transformer-proc mod) (transform-in ex) stx))))))
+                          ((transformer-proc mod) (syntax-local-introduce ex) stx))))))
 
   (define-rhombus-transform
     #:syntax-class (:export-modifier parsed-ex)
     #:desc "export modifier"
     #:parsed-tag #:rhombus/expo
     #:in-space in-export-space
-    #:transformer-ref (make-export-modifier-ref transform-in (syntax-parse parsed-ex
-                                                               #:datum-literals (parsed)
-                                                               [(parsed #:rhombus/expo req) #'req]
-                                                               [_ (raise-arguments-error
-                                                                   'export_meta.ParsedModifier
-                                                                   "given export to modify is not parsed"
-                                                                   "base export" parsed-ex)])))
+    #:transformer-ref (make-export-modifier-ref (syntax-parse parsed-ex
+                                                  #:datum-literals (parsed)
+                                                  [(parsed #:rhombus/expo req) #'req]
+                                                  [_ (raise-arguments-error
+                                                      'export_meta.ParsedModifier
+                                                      "given export to modify is not parsed"
+                                                      "base export" parsed-ex)])))
 
   (define-syntax-class :modified-export
     #:attributes (parsed)

rhombus/private/expr-macro.rkt

@@ -158,10 +158,9 @@
     (syntax-parse (unpack-group s who #f)
       [e::expression
        (define-values (expr opaque)
-         (syntax-local-expand-expression
-          (syntax-local-introduce (transform-out #'e.parsed))))
+         (syntax-local-expand-expression #'e.parsed))
        (values (relocate+reraw expr #`(parsed #:rhombus/expr
-                                              #,(transform-in (syntax-local-introduce expr))))
+                                              #,expr))
                (relocate+reraw expr #`(parsed #:rhombus/expr
-                                              #,(transform-in (syntax-local-introduce opaque)))))]))
+                                              #,opaque)))]))
   )

rhombus/private/import.rkt

@@ -122,9 +122,9 @@
       (define mod (or (import-modifier-ref v)
                       (import-modifier-block-ref v)))
       (and mod
-           (transformer (let ([req (transform-in req)]) ; import transformer scope
+           (transformer (let ([req (syntax-local-introduce req)]) ; import transformer scope
                           (lambda (stx)
-                            ((transformer-proc mod) (transform-in req) ; import-modifier transformer scope
+                            ((transformer-proc mod) (syntax-local-introduce req) ; import-modifier transformer scope
                                                     stx)))))))
 
   (define-rhombus-transform
@@ -240,7 +240,7 @@
 
 (define-defn-syntax import
   (definition-transformer
-   (lambda (stx)
+    (lambda (stx)
      (syntax-parse stx
        [(_ (_::block r ...))
         #`((rhombus-import #,stx () r ...))]
@@ -506,7 +506,7 @@
                (syntax-parse i
                  #:datum-literals (parsed nspace)
                  [(parsed mod-path parsed-r)
-                  (define-values (mp r) (import-invert (syntax-local-introduce (transform-in #'parsed-r)) #f #f))
+                  (define-values (mp r) (import-invert (syntax-local-introduce #'parsed-r) #f #f))
                   #`(reimport #,id #,mp #,r)]
                  [(nspace . _) #`(import-root #,id #,i #,space-id)]))])))
   (cond

rhombus/private/name-root-ref.rkt

@@ -50,7 +50,7 @@
                              field-id
                              field-id)
               'disappeared-use
-              (transform-out (in-name-root-space prefix))))
+              (syntax-local-introduce (in-name-root-space prefix))))
            (define (next form-id field-id what tail)
              (define binding-end? (and binding-ref
                                        (syntax-parse tail
@@ -228,8 +228,8 @@
                                  (syntax-e root-id))
                              (syntax-e field-id))))
    'disappeared-use
-   (let ([root (transform-out (in-name-root-space root-id))])
-     (if (syntax-original? (transform-out field-id))
+   (let ([root (syntax-local-introduce (in-name-root-space root-id))])
+     (if (syntax-original? (syntax-local-introduce field-id))
          ;; enable arrows, etc., from `new-field-id` based on its binding
          (cons (syntax-property (datum->syntax new-field-id
                                                (syntax-e new-field-id)

rhombus/private/namespace.rkt

@@ -41,7 +41,7 @@
         #:with name::dotted-identifier #'name-seq
         (define intro syntax-local-introduce)
         #`((rhombus-nested-forwarding-sequence
-            (define-name-root-for-exports [name.name name.extends plain #,(intro #'scoped)])
+            (define-name-root-for-exports [name.name name.extends #,(intro #'plain) scoped])
             #,(intro
                #`(rhombus-nested form ...))))]))))