eval refitted

main.rkt

@@ -1,12 +1,62 @@
 #lang racket/base
 
-(require (for-syntax racket/base
+(require racket/string
+         (for-syntax racket/base
                      racket/list
                      racket/match
                      racket/string))
 
 (provide js js/expression)
 
+;; Convert a Racket value produced by (eval <racket-expr>) inside a js form to
+;; a JavaScript literal string.  This is a Racket -> JavaScript interpolation
+;; boundary, not JavaScript eval.
+(define (jsmaker-runtime-escape-js-string s)
+  (define out (open-output-string))
+  (for ([ch (in-string s)])
+    (case ch
+      [(#\\) (display "\\\\" out)]
+      [(#\") (display "\\\"" out)]
+      [(#\newline) (display "\\n" out)]
+      [(#\return) (display "\\r" out)]
+      [(#\tab) (display "\\t" out)]
+      [else (display ch out)]))
+  (get-output-string out))
+
+(define (jsmaker-runtime-js-string s)
+  (format "\"~a\"" (jsmaker-runtime-escape-js-string s)))
+
+(define (jsmaker-runtime-key->js k)
+  (jsmaker-runtime-js-string
+   (cond [(symbol? k) (symbol->string k)]
+         [(keyword? k) (keyword->string k)]
+         [(string? k) k]
+         [else (format "~a" k)])))
+
+(define (jsmaker-runtime-value->js v)
+  (cond
+    [(void? v) "undefined"]
+    [(eq? v #t) "true"]
+    [(eq? v #f) "false"]
+    [(number? v) (number->string v)]
+    [(string? v) (jsmaker-runtime-js-string v)]
+    [(char? v) (jsmaker-runtime-js-string (string v))]
+    [(symbol? v) (jsmaker-runtime-js-string (symbol->string v))]
+    [(keyword? v) (jsmaker-runtime-js-string (keyword->string v))]
+    [(null? v) "[]"]
+    [(pair? v)
+     (format "[~a]" (string-join (map jsmaker-runtime-value->js v) ", "))]
+    [(vector? v)
+     (format "[~a]" (string-join (map jsmaker-runtime-value->js (vector->list v)) ", "))]
+    [(hash? v)
+     (format "{~a}"
+             (string-join
+              (for/list ([(k val) (in-hash v)])
+                (format "~a: ~a" (jsmaker-runtime-key->js k) (jsmaker-runtime-value->js val)))
+              ", "))]
+    [else
+     (error 'js "cannot interpolate Racket value as JavaScript literal: ~e" v)]))
+
 ;; The js macro translates a practical Racket-expression subset to JavaScript.
 ;; It is intentionally syntax-driven: the Racket expressions are not evaluated.
 
@@ -201,6 +251,44 @@
     (set! tmp-counter (add1 tmp-counter))
     (format "__~a_~a" prefix tmp-counter))
 
+  ;; Runtime interpolation escape hatch.  Before compiling the syntax to a
+  ;; datum, the public macros replace each (eval <racket-expr>) subform by a
+  ;; unique placeholder symbol.  The generated macro result is then a Racket
+  ;; expression that replaces those placeholders by JavaScript literals computed
+  ;; from <racket-expr> in the use-site lexical context.  This is intentionally
+  ;; different from JavaScript eval, which remains available as
+  ;; (send window eval ...) or by binding/calling another identifier.
+  (define (compile-racket-eval expr)
+    (fail "internal eval placeholder; public macro should rewrite eval first" expr))
+
+  (define (replace-racket-evals stx)
+    (define counter 0)
+    (define evals '())
+    (define (fresh-eval-placeholder)
+      (set! counter (add1 counter))
+      (string->symbol (format "__rkt_eval_slot_~a__" counter)))
+    (define (walk d)
+      (match d
+        [(list 'quote _) d]
+        [(list 'quasiquote _) d]
+        [(list 'eval expr)
+         (define ph (fresh-eval-placeholder))
+         (set! evals (append evals (list (list (symbol->string ph) expr))))
+         ph]
+        [(? pair?) (cons (walk (car d)) (walk (cdr d)))]
+        [(? vector?) (list->vector (map walk (vector->list d)))]
+        [_ d]))
+    (values (walk (syntax->datum stx)) evals))
+
+  (define (wrap-compiled-js stx compiled evals)
+    (for/fold ([acc #`#,compiled]) ([ev (in-list evals)])
+      (define placeholder (first ev))
+      (define racket-expr-datum (second ev))
+      #`(string-replace #,acc
+                         #,placeholder
+                         (jsmaker-runtime-value->js
+                          #,(datum->syntax stx racket-expr-datum)))))
+
   ;; Racket conditionals treat only #f as false.  JavaScript would also
   ;; reject 0, "", null and undefined in condition position, so every
   ;; Racket test is compiled through this helper.
@@ -384,17 +472,36 @@
     (define content
       (case kind
         [(let)
-         ;; Evaluate all RHS expressions before introducing the JS let bindings.
-         ;; This avoids JavaScript TDZ bugs for Racket code such as
-         ;; (let ([x x]) ...), where the RHS must see the outer x.
-         (define tmps (for/list ([_ (in-list bindings)]) (fresh "let_value")))
-         (define rhs-stmts
-           (for/list ([tmp (in-list tmps)] [b (in-list bindings)])
-             (format "const ~a = ~a;" tmp (compile-expr (binding-rhs b)))))
-         (define bind-stmts
-           (for/list ([tmp (in-list tmps)] [b (in-list bindings)])
-             (format "let ~a = ~a;" (id->js (binding-id b)) tmp)))
-         (join-lines (append rhs-stmts (list (block (join-lines (append bind-stmts (list (body-code))))))))]
+         ;; Racket let evaluates all RHS expressions before introducing the new
+         ;; bindings.  The common case can still be emitted directly when no RHS
+         ;; mentions one of the newly-bound identifiers.  If it does, use temps
+         ;; to avoid JavaScript TDZ bugs for code such as (let ([x x]) ...),
+         ;; where the RHS must see the outer x.
+         (define ids (map binding-id bindings))
+         (define (mentions-id? x id)
+           (cond
+             [(symbol? x) (eq? x id)]
+             [(pair? x) (or (mentions-id? (car x) id) (mentions-id? (cdr x) id))]
+             [(vector? x) (for/or ([e (in-vector x)]) (mentions-id? e id))]
+             [else #f]))
+         (define (mentions-any-bound-id? rhs)
+           (for/or ([id (in-list ids)]) (mentions-id? rhs id)))
+         (cond
+           [(for/or ([b (in-list bindings)]) (mentions-any-bound-id? (binding-rhs b)))
+            (define tmps (for/list ([_ (in-list bindings)]) (fresh "let_value")))
+            (define rhs-stmts
+              (for/list ([tmp (in-list tmps)] [b (in-list bindings)])
+                (format "const ~a = ~a;" tmp (compile-expr (binding-rhs b)))))
+            (define bind-stmts
+              (for/list ([tmp (in-list tmps)] [b (in-list bindings)])
+                (format "let ~a = ~a;" (id->js (binding-id b)) tmp)))
+            (join-lines (append rhs-stmts (list (block (join-lines (append bind-stmts (list (body-code))))))))]
+           [else
+            (join-lines
+             (append
+              (for/list ([b (in-list bindings)])
+                (format "let ~a = ~a;" (id->js (binding-id b)) (compile-expr (binding-rhs b))))
+              (list (body-code))))])]
         [(let*)
          ;; Emit the common case directly:
          ;;   (let* ([x 10] [y (+ x x)]) body)
@@ -1280,6 +1387,8 @@ if (~a !== false) return ~a;" tmp (compile-expr arg) tmp tmp)))
        (format "(~a = ~a)" (compile-assignment-target target) (compile-expr rhs))]
       [(list 'return) "undefined"]
       [(list 'return e) (compile-expr e)]
+      [(list 'eval racket-expr)
+       (compile-racket-eval racket-expr)]
       [(list f args ...) (compile-call f args)]
       [_ (literal->js d)]))
 
@@ -1289,9 +1398,11 @@ if (~a !== false) return ~a;" tmp (compile-expr arg) tmp tmp)))
 (define-syntax (js stx)
   (syntax-case stx ()
     [(_ form ...)
-     (datum->syntax stx (compile-top (syntax->datum #'(form ...))))]))
+     (let-values ([(clean-datum evals) (replace-racket-evals #'(form ...))])
+       (wrap-compiled-js stx (compile-top clean-datum) evals))]))
 
 (define-syntax (js/expression stx)
   (syntax-case stx ()
     [(_ form)
-     (datum->syntax stx (compile-expr (syntax->datum #'form)))]))
+     (let-values ([(clean-datum evals) (replace-racket-evals #'form)])
+       (wrap-compiled-js stx (compile-expr clean-datum) evals))]))