#lang racket/base

(require (for-syntax racket/base
                     racket/list
                     racket/match
                     racket/string))

(provide js js/expression)

;; The js macro translates a practical Racket-expression subset to JavaScript.
;; It is intentionally syntax-driven: the Racket expressions are not evaluated.

(begin-for-syntax
  (struct unsupported (message datum) #:transparent)

  (define (fail who d)
    (raise-syntax-error 'js (format "unsupported ~a: ~v" who d)))

  (define (indent s [prefix "  "])
    (define lines (string-split s "\n" #:trim? #f))
    (string-join (map (λ (line) (if (string=? line "") line (string-append prefix line))) lines) "\n"))

  (define (join-lines xs)
    (string-join (filter (λ (x) (and x (not (string=? x "")))) xs) "\n"))

  (define (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 (js-string s) (format "\"~a\"" (escape-js-string s)))

  (define reserved-js
    '(break case catch class const continue debugger default delete do else export extends
       finally for function if import in instanceof let new return super switch this throw
       try typeof var void while with yield enum await implements package protected static
       interface private public null true false undefined NaN Infinity))

  (define (replace-suffix s suffix replacement)
    (if (string-suffix? s suffix)
        (string-append (substring s 0 (- (string-length s) (string-length suffix))) replacement)
        s))

  (define (id->js x)
    (define s0 (cond [(symbol? x) (symbol->string x)] [(keyword? x) (keyword->string x)] [else (format "~a" x)]))
    (cond
      [(member s0 '("...")) (fail "identifier" x)]
      [(regexp-match? #rx"^[A-Za-z_$][A-Za-z0-9_$]*(\\.[A-Za-z_$][A-Za-z0-9_$]*)*$" s0)
       (if (memq (string->symbol s0) reserved-js) (string-append s0 "_") s0)]
      [else
       (define parts (string-split s0 "." #:trim? #f))
       (define (clean part)
         (define p1 (replace-suffix (replace-suffix (replace-suffix part "?" "_p") "!" "_bang") "->" "_to"))
         (define p2 (regexp-replace* #rx"[^A-Za-z0-9_$]" p1 "_"))
         (define p3 (if (regexp-match? #rx"^[A-Za-z_$]" p2) p2 (string-append "_" p2)))
         (if (memq (string->symbol p3) reserved-js) (string-append p3 "_") p3))
       (string-join (map clean parts) ".")]))

  (define (prop->js x)
    ;; Property names after a dot may legally be reserved words in modern
    ;; JavaScript, for example promise.catch(...).  Variable identifiers still
    ;; use id->js, but method/property positions use this less restrictive
    ;; mapper.
    (define s0 (cond [(symbol? x) (symbol->string x)] [(keyword? x) (keyword->string x)] [else (format "~a" x)]))
    (define s1 (replace-suffix (replace-suffix (replace-suffix s0 "?" "_p") "!" "_bang") "->" "_to"))
    (define s2 (regexp-replace* #rx"[^A-Za-z0-9_$]" s1 "_"))
    (if (regexp-match? #rx"^[A-Za-z_$]" s2) s2 (string-append "_" s2)))

  (define (compile-assignment-target target)
    (match target
      [(? symbol?) (id->js target)]
      [(list 'js-ref obj key) (format "~a[~a]" (compile-expr obj) (compile-expr key))]
      [(list 'js-dot obj (? symbol? key)) (format "~a.~a" (compile-expr obj) (prop->js key))]
      [_ (fail "assignment target" target)]))

  (define (compile-delete-target obj key)
    (format "delete ~a[~a]" (compile-expr obj) (compile-expr key)))

  (define (object-binding-prop->js prop)
    (match prop
      [(list 'quote (? symbol? s)) (prop->js s)]
      [(? symbol? s) (prop->js s)]
      [(? keyword? kw) (prop->js kw)]
      [(? string? s) s]
      [_ (fail "object destructuring property" prop)]))

  (define (compile-object-destructure-pattern bindings)
    (define parts
      (for/list ([b (in-list bindings)])
        (match b
          [(list id prop)
           (format "~a: ~a" (object-binding-prop->js prop) (id->js id))]
          [(list id prop default)
           (format "~a: ~a = ~a" (object-binding-prop->js prop) (id->js id) (compile-expr default))]
          [_ (fail "object destructuring binding" b)])))
    (format "{ ~a }" (string-join parts ", ")))

  (define (compile-let-object bindings obj body #:return-last? [return-last? #f] #:as-expression? [as-expression? #f])
    (define content
      (join-lines
       (list (format "const ~a = ~a;" (compile-object-destructure-pattern bindings) (compile-expr obj))
             (compile-body body #:return-last? return-last?))))
    (if as-expression?
        (format "(() => ~a)()" (block content))
        (block content)))

  (define (compile-class-member m)
    (match m
      [(list 'constructor formals body ...) #:when (not (and (list? formals) (andmap list? formals)))
       (format "constructor(~a) ~a" (compile-formals formals) (block (compile-body body)))]
      [(list 'constructor bindings body ...) #:when (and (list? bindings) (andmap list? bindings))
       (define formals
         (string-join
          (for/list ([b (in-list bindings)])
            (match b
              [(list id default) (format "~a = ~a" (id->js id) (compile-expr default))]
              [(list id) (id->js id)]
              [_ (fail "constructor binding" b)]))
          ", "))
       (format "constructor(~a) ~a" formals (block (compile-body body)))]
      [(list 'method (? symbol? name) formals body ...)
       (format "~a(~a) ~a" (prop->js name) (compile-formals formals) (block (compile-body body #:return-last? #t)))]
      [_ (fail "class member" m)]))

  (define (compile-define-class name members)
    (format "class ~a {
~a
}"
            (id->js name)
            (indent (string-join (map compile-class-member members) "
"))))


  (define (unsupported-regexp-reason src)
    ;; JavaScript RegExp is close to Racket #px for common cases, but it is
    ;; not PCRE/Racket.  Reject known constructs that would silently change
    ;; meaning or fail cryptically in JavaScript.  This is deliberately a
    ;; conservative syntax check, not a full regexp parser.
    (cond
      [(regexp-match? #rx"\\(\\?[imsxU-]" src)
       "inline regexp option groups such as (?i:...) are not translated to JavaScript flags"]
      [(regexp-match? #rx"\\(\\?>" src)
       "atomic groups (?>...) are not supported by JavaScript RegExp"]
      [(regexp-match? #rx"\\(\\?\\(" src)
       "conditional regexp groups are not supported by JavaScript RegExp"]
      [(regexp-match? #rx"\\(\\?P" src)
       "Python/PCRE-style named groups (?P...) are not supported by JavaScript RegExp"]
      [(regexp-match? #rx"\\\\[pP]\\{" src)
       "Unicode property escapes are not emitted yet; JavaScript requires careful u-flag handling"]
      [else #f]))

  (define (compile-regexp-literal rx)
    (cond
      [(or (byte-regexp? rx) (byte-pregexp? rx))
       (fail "byte regexp literal" rx)]
      [else
       (define src (object-name rx))
       (define reason (unsupported-regexp-reason src))
       (when reason (fail reason rx))
       (format "new RegExp(~a)" (js-string src))]))

  (define (literal->js v)
    (cond
      [(void? v) "undefined"]
      [(eq? v #t) "true"]
      [(eq? v #f) "false"]
      [(regexp? v) (compile-regexp-literal v)]
      [(or (byte-regexp? v) (byte-pregexp? v)) (fail "byte regexp literal" v)]
      [(number? v) (number->string v)]
      [(string? v) (js-string v)]
      [(char? v) (js-string (string v))]
      [(symbol? v) (js-string (symbol->string v))]
      [(keyword? v) (js-string (keyword->string v))]
      [(null? v) "[]"]
      [(pair? v) (format "[~a]" (string-join (map literal->js v) ", "))]
      [(vector? v) (format "[~a]" (string-join (map literal->js (vector->list v)) ", "))]
      [else (fail "literal" v)]))

  (define (block stmt)
    (string-append "{\n" (indent stmt) "\n}"))

  (define (parens s) (string-append "(" s ")"))

  (define (strip-one-outer-parens s)
    (if (and (positive? (string-length s))
             (char=? (string-ref s 0) #\()
             (char=? (string-ref s (sub1 (string-length s))) #\)))
        (substring s 1 (sub1 (string-length s)))
        s))

  (define tmp-counter 0)

  (define (fresh prefix)
    (set! tmp-counter (add1 tmp-counter))
    (format "__~a_~a" prefix tmp-counter))

  ;; 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.
  (define (compile-test d)
    (if (boolean-expr? d)
        (let ([e (compile-expr d)])
          ;; Keep IIFEs intact: (() => {...})() starts and ends with parens,
          ;; but removing the first/last character makes invalid JavaScript.
          (if (regexp-match? #rx"=>" e) e (strip-one-outer-parens e)))
        (format "(~a !== false)" (compile-expr d))))

  (define (compile-arg-list args)
    (string-join (map id->js args) ", "))

  (define (split-formals formals)
    (cond
      [(null? formals) (values '() #f)]
      [(symbol? formals) (values '() formals)]
      [(pair? formals)
       (let loop ([xs formals] [acc '()])
         (cond
           [(null? xs) (values (reverse acc) #f)]
           [(symbol? xs) (values (reverse acc) xs)]
           [(pair? xs) (loop (cdr xs) (cons (car xs) acc))]
           [else (fail "formals" formals)]))]
      [else (fail "formals" formals)]))

  (define (compile-formals formals)
    (define-values (pos rest) (split-formals formals))
    (define pos-js (map id->js pos))
    (define all-js (if rest (append pos-js (list (string-append "..." (id->js rest)))) pos-js))
    (string-join all-js ", "))

  (define (binding-id b)
    (match b
      [(list id _) id]
      [(list id _ ...) id]
      [_ (fail "binding" b)]))

  (define (binding-rhs b)
    (match b
      [(list _ rhs) rhs]
      [_ (fail "binding" b)]))

  (define (binding-ids b)
    (match b
      [(list ids _) ids]
      [_ (fail "value binding" b)]))

  (define (ids-pattern->js ids)
    (cond
      [(and (list? ids) (= (length ids) 1)) (id->js (car ids))]
      [(list? ids) (format "[~a]" (compile-arg-list ids))]
      [(symbol? ids) (id->js ids)]
      [else (fail "binding ids" ids)]))

  (define (definition? d)
    (match d
      [(list 'define _ ...) #t]
      [(list 'define-values _ ...) #t]
      [_ #f]))

  (define (return-form? d)
    (match d
      [(list 'return _) #t]
      [_ #f]))

  (define (compile-body body #:return-last? [return-last? #f])
    (cond
      [(null? body) (if return-last? "return undefined;" "")]
      [else
       (define n (length body))
       (join-lines
        (for/list ([form (in-list body)] [i (in-naturals)])
          (define last? (= i (sub1 n)))
          (if (and return-last? last? (not (definition? form)))
              (compile-return form)
              (compile-stmt form))))]))

  (define (compile-return d)
    (match d
      [(list 'return) "return undefined;"]
      [(list 'return e) (format "return ~a;" (compile-expr e))]
      [(list 'begin es ...)
       (compile-body es #:return-last? #t)]
      [(list 'if c t e)
       (format "if (~a) ~a else ~a" (compile-test c)
               (block (compile-body (list t) #:return-last? #t))
               (block (compile-body (list e) #:return-last? #t)))]
      [(list 'cond clauses ...)
       (compile-cond clauses #:return-last? #t)]
      [(list 'with-handlers clauses body ...)
       (compile-with-handlers clauses body #:return-last? #t #:as-expression? #f)]
      [(list 'let name bindings body ...) #:when (symbol? name)
       (compile-named-let name bindings body #:return-last? #t #:as-expression? #f)]
      [(list 'let bindings body ...)
       (compile-let 'let bindings body #:return-last? #t #:as-expression? #f)]
      [(list 'let* bindings body ...)
       (compile-let 'let* bindings body #:return-last? #t #:as-expression? #f)]
      [(list 'letrec bindings body ...)
       (compile-let 'letrec bindings body #:return-last? #t #:as-expression? #f)]
      [(list 'let-values bindings body ...)
       (compile-let-values 'let-values bindings body #:return-last? #t #:as-expression? #f)]
      [(list 'let*-values bindings body ...)
       (compile-let-values 'let*-values bindings body #:return-last? #t #:as-expression? #f)]
      [(list 'when c body ...)
       (format "if (~a) ~a\nreturn undefined;" (compile-expr c) (block (compile-body body)))]
      [(list 'unless c body ...)
       (format "if (!(~a)) ~a\nreturn undefined;" (compile-expr c) (block (compile-body body)))]
      [_ (format "return ~a;" (compile-expr d))]))

  (define (compile-stmt d)
    (match d
      [(list 'begin es ...)
       (compile-body es)]
      [(list 'begin0 first rest ...)
       (join-lines (cons (compile-stmt first) (map compile-stmt rest)))]
      [(list 'define (? pair? sig) body ...)
       (format "function ~a(~a) ~a" (id->js (car sig)) (compile-formals (cdr sig)) (block (compile-body body #:return-last? #t)))]
      [(list 'define id rhs)
       (format "let ~a = ~a;" (id->js id) (compile-expr rhs))]
      [(list 'define-values (list id) rhs)
       (format "let ~a = ~a;" (id->js id) (compile-expr rhs))]
      [(list 'define-values ids rhs)
       (format "let [~a] = ~a;" (compile-arg-list ids) (compile-expr rhs))]
      [(list 'set! target rhs)
       (format "~a = ~a;" (compile-assignment-target target) (compile-expr rhs))]
      [(list 'return)
       "return undefined;"]
      [(list 'return e)
       (format "return ~a;" (compile-expr e))]
      [(list 'while c body ...)
       (format "while (~a) ~a" (compile-test c) (block (compile-body body)))]
      [(list 'if c t e)
       (format "if (~a) ~a else ~a" (compile-test c) (block (compile-body (list t))) (block (compile-body (list e))))]
      [(list 'cond clauses ...)
       (compile-cond clauses #:return-last? #f)]
      [(list 'with-handlers clauses body ...)
       (compile-with-handlers clauses body #:return-last? #f #:as-expression? #f)]
      [(list 'case key clauses ...)
       (compile-case key clauses #:return-last? #f)]
      [(list 'when c body ...)
       (format "if (~a) ~a" (compile-test c) (block (compile-body body)))]
      [(list 'unless c body ...)
       (format "if (!(~a)) ~a" (compile-test c) (block (compile-body body)))]
      [(list 'let name bindings body ...) #:when (symbol? name)
       (compile-named-let name bindings body #:return-last? #f #:as-expression? #f)]
      [(list 'let bindings body ...)
       (compile-let 'let bindings body #:return-last? #f #:as-expression? #f)]
      [(list 'let* bindings body ...)
       (compile-let 'let* bindings body #:return-last? #f #:as-expression? #f)]
      [(list 'letrec bindings body ...)
       (compile-let 'letrec bindings body #:return-last? #f #:as-expression? #f)]
      [(list 'let-values bindings body ...)
       (compile-let-values 'let-values bindings body #:return-last? #f #:as-expression? #f)]
      [(list 'let*-values bindings body ...)
       (compile-let-values 'let*-values bindings body #:return-last? #f #:as-expression? #f)]
      [(list 'for clauses body ...)
       (compile-for clauses body #:collect? #f #:as-expression? #f)]
      [(list 'for/list clauses body ...)
       (format "~a;" (compile-for clauses body #:collect? #t #:as-expression? #t))]
      [(list 'for/vector clauses body ...)
       (format "~a;" (compile-for clauses body #:collect? #t #:as-expression? #t))]
      [(list 'vector-set! v i val)
       (format "~a[~a] = ~a;" (compile-expr v) (compile-expr i) (compile-expr val))]
      [(list 'set-prop! obj key val)
       (format "~a[~a] = ~a;" (compile-expr obj) (compile-expr key) (compile-expr val))]
      [(list 'delete-prop! obj key)
       (format "~a;" (compile-delete-target obj key))]
      [(list 'let-object bindings obj body ...)
       (compile-let-object bindings obj body #:return-last? #f #:as-expression? #f)]
      [(list 'define-class name members ...)
       (compile-define-class name members)]
      [(list 'send obj method args ...)
       (format "~a.~a(~a);" (compile-expr obj) (prop->js method) (string-join (map compile-expr args) ", "))]
      [_
       (format "~a;" (compile-expr d))]))

  (define (compile-let kind bindings body #:return-last? [return-last? #f] #:as-expression? [as-expression? #f])
    (define (body-code) (compile-body body #:return-last? return-last?))
    (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))))))))]
        [(let*)
         ;; Emit the common case directly:
         ;;   (let* ([x 10] [y (+ x x)]) body)
         ;; becomes one JavaScript block with sequential let bindings.  Only
         ;; when a RHS mentions the same identifier that is being introduced,
         ;; such as (let* ([x x]) ...), do we use a temporary to preserve
         ;; Racket semantics and avoid JavaScript's temporal-dead-zone error.
         (define (mentions-id? x id)
           (cond
             [(symbol? x) (eq? x id)]
             [(pair? x) (or (mentions-id? (car x) id) (mentions-id? (cdr x) id))]
             [else #f]))
         (define (emit bs)
           (cond
             [(null? bs) (body-code)]
             [else
              (define b (car bs))
              (define id (binding-id b))
              (define rhs (binding-rhs b))
              (cond
                [(mentions-id? rhs id)
                 (define tmp (fresh "let_star_value"))
                 (join-lines
                  (list (format "const ~a = ~a;" tmp (compile-expr rhs))
                        (block (join-lines
                                (list (format "let ~a = ~a;" (id->js id) tmp)
                                      (emit (cdr bs)))))))]
                [else
                 (join-lines
                  (list (format "let ~a = ~a;" (id->js id) (compile-expr rhs))
                        (emit (cdr bs))))])]))
         (emit bindings)]
        [(letrec)
         (define decls (for/list ([b (in-list bindings)]) (format "let ~a;" (id->js (binding-id b)))))
         (define sets (for/list ([b (in-list bindings)]) (format "~a = ~a;" (id->js (binding-id b)) (compile-expr (binding-rhs b)))))
         (join-lines (append decls sets (list (body-code))))]
        [else (fail "let kind" kind)]))
    (if as-expression?
        (format "(() => ~a)()" (block content))
        (block content)))

  (define (compile-let-values kind bindings body #:return-last? [return-last? #f] #:as-expression? [as-expression? #f])
    (define (body-code) (compile-body body #:return-last? return-last?))
    (define (bind-stmt ids tmp) (format "let ~a = ~a;" (ids-pattern->js ids) tmp))
    (define content
      (case kind
        [(let-values)
         (define tmps (for/list ([_ (in-list bindings)]) (fresh "let_values")))
         (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)])
             (bind-stmt (binding-ids b) tmp)))
         (join-lines (append rhs-stmts (list (block (join-lines (append bind-stmts (list (body-code))))))))]
        [(let*-values)
         (define (emit bs)
           (cond
             [(null? bs) (body-code)]
             [else
              (define b (car bs))
              (define tmp (fresh "let_star_values"))
              (join-lines (list (format "const ~a = ~a;" tmp (compile-expr (binding-rhs b)))
                                (block (join-lines (list (bind-stmt (binding-ids b) tmp) (emit (cdr bs)))))))]))
         (emit bindings)]
        [else (fail "let-values kind" kind)]))
    (if as-expression?
        (format "(() => ~a)()" (block content))
        (block content)))

  (define (compile-named-let name bindings body #:return-last? [return-last? #f] #:as-expression? [as-expression? #f])
    ;; Tail-recursive named let is emitted as a JavaScript loop.  This covers
    ;; the common Racket idiom:
    ;;   (let loop ([i 0] [acc 0])
    ;;     (if (...) (loop ...) acc))
    ;; without consuming the JavaScript call stack.
    (define ids (map binding-id bindings))
    (define vals (map binding-rhs bindings))
    (define loop-name (id->js name))
    (define init-stmts
      (for/list ([id (in-list ids)] [v (in-list vals)])
        (format "let ~a = ~a;" (id->js id) (compile-expr v))))
    (define (tail-call? d)
      (and (pair? d) (eq? (car d) name)))
    (define (emit-tail d)
      (match d
        [(list 'begin es ...)
         (compile-tail-sequence es)]
        [(list 'if c t e)
         (format "if (~a) ~a else ~a"
                 (compile-test c)
                 (block (emit-tail t))
                 (block (emit-tail e)))]
        [(list 'cond clauses ...)
         (compile-cond clauses #:return-last? return-last?)]
        [(? tail-call?)
         (define args (cdr d))
         (unless (= (length args) (length ids))
           (fail "named let arity" d))
         (define temps (for/list ([_ (in-list args)]) (fresh "loop_arg")))
         (join-lines
          (append
           (for/list ([tmp (in-list temps)] [arg (in-list args)])
             (format "const ~a = ~a;" tmp (compile-expr arg)))
           (for/list ([id (in-list ids)] [tmp (in-list temps)])
             (format "~a = ~a;" (id->js id) tmp))
           (list "continue;")))]
        [_
         (if return-last?
             (format "return ~a;" (compile-expr d))
             (format "~a;
break;" (compile-expr d)))]))
    (define (compile-tail-sequence es)
      (cond
        [(null? es) (if return-last? "return undefined;" "break;")]
        [(null? (cdr es)) (emit-tail (car es))]
        [else (join-lines (append (map compile-stmt (reverse (cdr (reverse es))))
                                  (list (emit-tail (car (reverse es))))))]))
    (define content
      (join-lines (append init-stmts
                          (list (format "while (true) ~a"
                                        (block (compile-tail-sequence body)))))))
    (if as-expression?
        (format "(() => ~a)()" (block content))
        (block content)))

  (define (compile-cond clauses #:return-last? [return-last? #f])
    (define (emit-result expr)
      (if return-last? (format "return ~a;" expr) (format "~a;" expr)))
    (define (emit-then test-tmp c)
      (match c
        [(list _ '=> proc)
         (emit-result (format "~a(~a)" (compile-callee proc) test-tmp))]
        [(list _)
         (emit-result test-tmp)]
        [(list _ body ...)
         (if return-last? (compile-body body #:return-last? #t) (compile-body body))]
        [_ (fail "cond clause" c)]))
    (define (loop cs)
      (cond
        [(null? cs) (if return-last? "return undefined;" "")]
        [else
         (define c (car cs))
         (match c
           [(list 'else body ...)
            (if return-last? (compile-body body #:return-last? #t) (compile-body body))]
           [(list test _ ...)
            (define tmp (fresh "cond_value"))
            (define else-part (loop (cdr cs)))
            (define then-block (block (emit-then tmp c)))
            (join-lines
             (list (format "const ~a = ~a;" tmp (compile-expr test))
                   (if (string=? else-part "")
                       (format "if (~a !== false) ~a" tmp then-block)
                       (format "if (~a !== false) ~a else ~a" tmp then-block (block else-part)))))]
           [_ (fail "cond clause" c)])]))
    (loop clauses))

  (define (compile-case key clauses #:return-last? [return-last? #f])
    (define key-js (compile-expr key))
    (define tmp "__case_value")
    (define (compile-clause c)
      (match c
        [(list 'else body ...)
         (string-append "default:\n" (indent (compile-body body #:return-last? return-last?)))]
        [(list datums body ...)
         (define tests (for/list ([d (in-list datums)]) (format "case ~a:" (literal->js d))))
         (string-append (string-join tests "\n") "\n" (indent (compile-body body #:return-last? return-last?)) "\n  break;")]
        [_ (fail "case clause" c)]))
    (format "{\n  const ~a = ~a;\n  switch (~a) {\n~a\n  }\n}"
            tmp key-js tmp (indent (string-join (map compile-clause clauses) "\n") "    ")))

  (define (compile-if-expr c t e)
    (format "(~a ? ~a : ~a)" (compile-test c) (compile-expr t) (compile-expr e)))

  (define (compile-begin-expr es)
    (format "(() => ~a)()" (block (compile-body es #:return-last? #t))))

  (define (compile-hash args)
    (unless (even? (length args)) (fail "hash expression with odd number of arguments" args))
    (define pairs
      (for/list ([k (in-list args)] [v (in-list (cdr args))] [i (in-naturals)] #:when (even? i))
        (define key
          (match k
            [(list 'quote (? symbol? s)) (symbol->string s)]
            [(? keyword? kw) (keyword->string kw)]
            [(? symbol? s) (symbol->string s)]
            [(? string? s) s]
            [_ #f]))
        (if key
            (format "~a: ~a" (if (regexp-match? #rx"^[A-Za-z_$][A-Za-z0-9_$]*$" key) key (js-string key)) (compile-expr v))
            (format "[~a]: ~a" (compile-expr k) (compile-expr v)))))
    (format "{~a}" (string-join pairs ", ")))

  (define (compile-make-hash args)
    (match args
      ['() "{}"]
      [(list entries) (format "Object.fromEntries(~a)" (compile-expr entries))]
      [_ (fail "make-hash arity" args)]))

  (define (compile-hash-ref args)
    (match args
      [(list h k)
       (format "~a[~a]" (parens (compile-expr h)) (compile-expr k))]
      [(list h k default)
       (format "((__h, __k, __default) => Object.prototype.hasOwnProperty.call(__h, __k) ? __h[__k] : (typeof __default === 'function' ? __default() : __default))(~a, ~a, ~a)"
               (compile-expr h) (compile-expr k) (compile-expr default))]
      [_ (fail "hash-ref" args)]))

  (define (compile-hash-set args #:mutate? [mutate? #f])
    (match args
      [(list h k v)
       (if mutate?
           (format "((__h, __k, __v) => { __h[__k] = __v; return undefined; })(~a, ~a, ~a)"
                   (compile-expr h) (compile-expr k) (compile-expr v))
           (format "Object.assign({}, ~a, { [~a]: ~a })"
                   (compile-expr h) (compile-expr k) (compile-expr v)))]
      [_ (fail (if mutate? "hash-set!" "hash-set") args)]))

  (define (compile-hash-remove args #:mutate? [mutate? #f])
    (match args
      [(list h k)
       (if mutate?
           (format "((__h, __k) => { delete __h[__k]; return undefined; })(~a, ~a)"
                   (compile-expr h) (compile-expr k))
           (format "((__h, __k) => { const __out = Object.assign({}, __h); delete __out[__k]; return __out; })(~a, ~a)"
                   (compile-expr h) (compile-expr k)))]
      [_ (fail (if mutate? "hash-remove!" "hash-remove") args)]))

  (define (compile-hash-update args #:mutate? [mutate? #f])
    (match args
      [(list h k f)
       (format "((__h, __k, __f) => { if (!Object.prototype.hasOwnProperty.call(__h, __k)) throw new Error('hash-update: no value found for key'); ~a; return ~a; })(~a, ~a, ~a)"
               (if mutate? "__h[__k] = __f(__h[__k])" "const __out = Object.assign({}, __h); __out[__k] = __f(__h[__k])")
               (if mutate? "undefined" "__out")
               (compile-expr h) (compile-expr k) (compile-expr f))]
      [(list h k f default)
       (format "((__h, __k, __f, __default) => { const __old = Object.prototype.hasOwnProperty.call(__h, __k) ? __h[__k] : (typeof __default === 'function' ? __default() : __default); ~a; return ~a; })(~a, ~a, ~a, ~a)"
               (if mutate? "__h[__k] = __f(__old)" "const __out = Object.assign({}, __h); __out[__k] = __f(__old)")
               (if mutate? "undefined" "__out")
               (compile-expr h) (compile-expr k) (compile-expr f) (compile-expr default))]
      [_ (fail (if mutate? "hash-update!" "hash-update") args)]))

  (define (compile-hash-clear args #:mutate? [mutate? #f])
    (match args
      [(list h)
       (if mutate?
           (format "((__h) => { for (const __k of Object.keys(__h)) delete __h[__k]; return undefined; })(~a)"
                   (compile-expr h))
           "{}")]
      [_ (fail (if mutate? "hash-clear!" "hash-clear") args)]))

  (define (atomic-expr? x)
    (or (boolean? x)
        (number? x)
        (string? x)
        (char? x)
        (keyword? x)
        (regexp? x)
        (and (symbol? x) (not (memq x '(#%app quote quasiquote lambda λ if begin let let* letrec cond case for for/list for/vector for/fold values return while))))
        (and (pair? x) (eq? (car x) 'quote))))

  (define (boolean-expr? x)
    (or (boolean? x)
        (and (pair? x)
             (let ([op (car x)])
               (or (memq op '(< > <= >= = == equal? eq? eqv? != not-equal?
                                zero? positive? negative? even? odd?
                                null? empty? pair? list? vector? number? real? integer?
                                string? boolean? symbol? regexp? pregexp? regexp-match?
                                string=? string-ci=? string<? string>? string<=? string>=?
                                hash? hash-has-key? not))
                   (and (eq? op 'and) (andmap boolean-expr? (cdr x)))
                   (and (eq? op 'or) (andmap boolean-expr? (cdr x))))))))

  (define (compile-pairwise args make-test)
    (cond
      [(or (null? args) (null? (cdr args))) "true"]
      [(andmap atomic-expr? args)
       (define compiled (map compile-expr args))
       (define tests
         (for/list ([a (in-list compiled)] [b (in-list (cdr compiled))])
           (make-test a b)))
       (if (null? (cdr tests)) (car tests) (parens (string-join tests " && ")))]
      [else
       (define temps (for/list ([_ (in-list args)]) (fresh "cmp")))
       (define bindings
         (for/list ([tmp (in-list temps)] [arg (in-list args)])
           (format "const ~a = ~a;" tmp (compile-expr arg))))
       (define tests
         (for/list ([a (in-list temps)] [b (in-list (cdr temps))])
           (make-test a b)))
       (format "(() => ~a)()"
               (block (join-lines (append bindings
                                           (list (format "return ~a;" (string-join tests " && ")))))))]))

  (define (compile-comparison jsop args)
    (compile-pairwise args (λ (a b) (format "(~a ~a ~a)" a jsop b))))

  (define (compile-object-is args)
    (compile-pairwise args (λ (a b) (format "Object.is(~a, ~a)" a b))))

  (define (compile-deep-equal args)
    (compile-pairwise
     args
     (λ (a b)
       (format "(Object.is(~a, ~a) || JSON.stringify(~a) === JSON.stringify(~a))" a b a b))))

  (define (compile-and args)
    (cond
      [(null? args) "true"]
      [(null? (cdr args)) (compile-expr (car args))]
      [(andmap boolean-expr? args)
       (parens (string-join (map compile-expr args) " && "))]
      [else
       (define tmp (fresh "and_value"))
       (define non-last (reverse (cdr (reverse args))))
       (define last-arg (car (reverse args)))
       (define steps
         (append
          (list (format "let ~a = ~a;" tmp (compile-expr (car non-last)))
                (format "if (~a === false) return false;" tmp))
          (for/list ([arg (in-list (cdr non-last))])
            (format "~a = ~a;
if (~a === false) return false;" tmp (compile-expr arg) tmp))
          (list (format "return ~a;" (compile-expr last-arg)))))
       (format "(() => ~a)()" (block (join-lines steps)))]))

  (define (compile-or args)
    (cond
      [(null? args) "false"]
      [(andmap boolean-expr? args)
       (parens (string-join (map compile-expr args) " || "))]
      [else
       (define tmp (fresh "or_value"))
       (define steps
         (for/list ([arg (in-list args)])
           (format "~a = ~a;
if (~a !== false) return ~a;" tmp (compile-expr arg) tmp tmp)))
       (format "(() => ~a)()"
               (block (join-lines (append (list (format "let ~a = false;" tmp))
                                           steps
                                           (list "return false;")))))]))

  (define (compile-sequence d)
    (match d
      [(list 'in-list xs) (compile-expr xs)]
      [(list 'in-vector xs) (compile-expr xs)]
      [(list 'in-string xs) (format "Array.from(~a)" (compile-expr xs))]
      [(list 'in-range end)
       (format "((__end) => { const __out = []; for (let __i = 0; __i < __end; __i++) __out.push(__i); return __out; })(~a)"
               (compile-expr end))]
      [(list 'in-range start end)
       (format "((__start, __end) => { const __out = []; for (let __i = __start; __i < __end; __i++) __out.push(__i); return __out; })(~a, ~a)"
               (compile-expr start) (compile-expr end))]
      [(list 'in-range start end step)
       (format "((__start, __end, __step) => { const __out = []; for (let __i = __start; (__step >= 0 ? __i < __end : __i > __end); __i += __step) __out.push(__i); return __out; })(~a, ~a, ~a)"
               (compile-expr start) (compile-expr end) (compile-expr step))]
      [_ (compile-expr d)]))

  (define (compile-body-as-expr body)
    (cond
      [(null? body) "undefined"]
      [(null? (cdr body)) (compile-expr (car body))]
      [else (compile-begin-expr body)]))

  (define (compile-callee f)
    ;; A lambda in callee position must be emitted as a function expression,
    ;; not as a function declaration statement.  Parenthesizing compound
    ;; callees is harmless and prevents invalid code such as:
    ;;   function(...args) { ... }(__exn)
    (define f-js (compile-expr f))
    (if (symbol? f) f-js (parens f-js)))

  (define (compile-for clauses body #:collect? [collect? #f] #:as-expression? [as-expression? #t])
    (define out (fresh "for_out"))
    (define (emit clauses*)
      (cond
        [(null? clauses*)
         (if collect?
             (format "~a.push(~a);" out (compile-body-as-expr body))
             (compile-body body))]
        [else
         (define c (car clauses*))
         (cond
           [(eq? c '#:when)
            (match (cdr clauses*)
              [(list test more ...) (format "if (~a) ~a" (compile-test test) (block (emit more)))]
              [_ (fail "for #:when clause" clauses*)])]
           [(eq? c '#:unless)
            (match (cdr clauses*)
              [(list test more ...) (format "if (!(~a)) ~a" (compile-test test) (block (emit more)))]
              [_ (fail "for #:unless clause" clauses*)])]
           [else
            (match c
              [(list id seq)
               (format "for (const ~a of ~a) ~a" (id->js id) (compile-sequence seq) (block (emit (cdr clauses*))))]
              [_ (fail "for clause" c)])])]))
    (define content
      (if collect?
          (join-lines (list (format "const ~a = [];" out) (emit clauses) (format "return ~a;" out)))
          (emit clauses)))
    (cond
      [as-expression? (format "(() => ~a)()" (block content))]
      [else content]))

  (define (compile-for-fold bindings clauses body)
    (define ids (map binding-id bindings))
    (define init-stmts
      (for/list ([b (in-list bindings)])
        (format "let ~a = ~a;" (id->js (binding-id b)) (compile-expr (binding-rhs b)))))
    (define body-expr (compile-body-as-expr body))
    (define update
      (if (= (length ids) 1)
          (format "~a = ~a;" (id->js (car ids)) body-expr)
          (format "[~a] = ~a;" (compile-arg-list ids) body-expr)))
    (define (emit clauses*)
      (cond
        [(null? clauses*) update]
        [else
         (define c (car clauses*))
         (cond
           [(eq? c '#:when)
            (match (cdr clauses*)
              [(list test more ...) (format "if (~a) ~a" (compile-test test) (block (emit more)))]
              [_ (fail "for/fold #:when clause" clauses*)])]
           [(eq? c '#:unless)
            (match (cdr clauses*)
              [(list test more ...) (format "if (!(~a)) ~a" (compile-test test) (block (emit more)))]
              [_ (fail "for/fold #:unless clause" clauses*)])]
           [else
            (match c
              [(list id seq)
               (format "for (const ~a of ~a) ~a" (id->js id) (compile-sequence seq) (block (emit (cdr clauses*))))]
              [_ (fail "for/fold clause" c)])])]))
    (format "(() => ~a)()"
            (block (join-lines (append init-stmts
                                        (list (emit clauses)
                                              (if (= (length ids) 1)
                                                  (format "return ~a;" (id->js (car ids)))
                                                  (format "return [~a];" (compile-arg-list ids)))))))))

  (define (regexp-arg->js pat)
    (format "__rkt_to_regexp(~a, false)" (compile-expr pat)))

  (define (regexp-arg->js/global pat)
    (format "__rkt_to_regexp(~a, true)" (compile-expr pat)))

  (define (inline-regexp-runtime expr)
    (format "((__rkt_body) => {\n  const __rkt_to_regexp = (__pat, __global) => {\n    const __flags = (__pat instanceof RegExp)\n      ? Array.from(new Set((__pat.flags.replace(/g/g, '') + (__global ? 'g' : '')).split(''))).join('')\n      : (__global ? 'g' : '');\n    return (__pat instanceof RegExp) ? new RegExp(__pat.source, __flags) : new RegExp(String(__pat), __flags);\n  };\n  const __rkt_match_array = (__m) => (__m === null ? false : Array.from(__m, (__x) => __x === undefined ? false : __x));\n  const __rkt_replacement = (__s) => {\n    if (typeof __s !== 'string') return __s;\n    let __out = '';\n    for (let __i = 0; __i < __s.length; __i++) {\n      const __ch = __s[__i];\n      if (__ch === '$') { __out += '$$'; continue; }\n      if (__ch === '\\\\' && __i + 1 < __s.length) {\n        const __n = __s[++__i];\n        if (__n >= '0' && __n <= '9') __out += (__n === '0' ? '$&' : ('$' + __n));\n        else __out += __n;\n      } else __out += __ch;\n    }\n    return __out;\n  };\n  return __rkt_body(__rkt_to_regexp, __rkt_match_array, __rkt_replacement);\n})((__rkt_to_regexp, __rkt_match_array, __rkt_replacement) => ~a)" expr))

  (define (compile-regexp-match args)
    (match args
      [(list pat s)
       (inline-regexp-runtime
        (format "__rkt_match_array(String(~a).match(~a))" (compile-expr s) (regexp-arg->js pat)))]
      [(list pat s start)
       (inline-regexp-runtime
        (format "__rkt_match_array(String(~a).slice(~a).match(~a))"
                (compile-expr s) (compile-expr start) (regexp-arg->js pat)))]
      [_ (fail "regexp-match arity" args)]))

  (define (compile-regexp-match? args)
    (match args
      [(list pat s)
       (inline-regexp-runtime
        (format "~a.test(String(~a))" (regexp-arg->js pat) (compile-expr s)))]
      [(list pat s start)
       (inline-regexp-runtime
        (format "~a.test(String(~a).slice(~a))" (regexp-arg->js pat) (compile-expr s) (compile-expr start)))]
      [_ (fail "regexp-match? arity" args)]))

  (define (compile-regexp-match* args)
    (match args
      [(list pat s)
       (inline-regexp-runtime
        (format "Array.from(String(~a).matchAll(~a), (__m) => __m[0])"
                (compile-expr s) (regexp-arg->js/global pat)))]
      [(list pat s start)
       (inline-regexp-runtime
        (format "Array.from(String(~a).slice(~a).matchAll(~a), (__m) => __m[0])"
                (compile-expr s) (compile-expr start) (regexp-arg->js/global pat)))]
      [_ (fail "regexp-match* arity" args)]))

  (define (compile-regexp-match-positions args)
    (match args
      [(list pat s)
       (inline-regexp-runtime
        (format "((__s, __rx) => { const __m = __rx.exec(__s); if (__m === null) return false; return __m.map((__x, __i) => { if (__x === undefined) return false; const __start = __m.indices ? __m.indices[__i][0] : (__i === 0 ? __m.index : __s.indexOf(__x, __m.index)); return [__start, __start + __x.length]; }); })(String(~a), (() => { const __rx = ~a; return new RegExp(__rx.source, Array.from(new Set((__rx.flags.replace(/g/g, '') + 'd').split(''))).join('')); })())"
                (compile-expr s) (regexp-arg->js pat)))]
      [_ (fail "regexp-match-positions arity" args)]))

  (define (compile-regexp-split args)
    (match args
      [(list pat s)
       (inline-regexp-runtime
        (format "String(~a).split(~a)" (compile-expr s) (regexp-arg->js/global pat)))]
      [_ (fail "regexp-split arity" args)]))

  (define (compile-regexp-replace args #:all? all?)
    (match args
      [(list pat s repl)
       (inline-regexp-runtime
        (format "String(~a).replace(~a, __rkt_replacement(~a))"
                (compile-expr s)
                ((if all? regexp-arg->js/global regexp-arg->js) pat)
                (compile-expr repl)))]
      [_ (fail (if all? "regexp-replace* arity" "regexp-replace arity") args)]))

  (define (compile-regexp-quote args)
    (match args
      [(list s)
       (format "String(~a).replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&')" (compile-expr s))]
      [_ (fail "regexp-quote arity" args)]))


  (define (handler-predicate-supported? pred)
    ;; Deliberately narrow: js-maker only models one JavaScript catch channel.
    ;; It therefore supports generic exn? handlers, not the Racket exception
    ;; predicate hierarchy.
    (eq? pred 'exn?))

  (define (compile-with-handlers clauses body #:return-last? [return-last? #t] #:as-expression? [as-expression? #t])
    (unless (and (list? clauses) (andmap list? clauses))
      (fail "with-handlers clauses" clauses))
    (define catch-var (fresh "exn"))
    (define (emit-handler cs)
      (cond
        [(null? cs) (format "throw ~a;" catch-var)]
        [else
         (match (car cs)
           [(list (? symbol? pred) handler)
            (unless (handler-predicate-supported? pred)
              (fail "with-handlers predicate; only generic exn? is supported" pred))
            (define call (format "~a(~a)" (compile-callee handler) catch-var))
            (if return-last? (format "return ~a;" call) (format "~a;" call))]
           [_ (fail "with-handlers clause" (car cs))])]))
    (define content
      (format "try ~a catch (~a) ~a"
              (block (compile-body body #:return-last? return-last?))
              catch-var
              (block (emit-handler clauses))))
    (if as-expression? (format "(() => ~a)()" (block content)) content))

  (define (identifier-local-name op)
    ;; Gregor is commonly imported with a prefix, but that prefix is not
    ;; stable in user code.  This helper strips an arbitrary prefix ending in
    ;; ':' and matches on the local binding name.  It is intentionally only
    ;; used by the small Gregor compatibility table below.
    (define s (symbol->string op))
    (define parts (string-split s ":"))
    (if (null? parts) s (car (reverse parts))))

  (define (inline-gregor-runtime expr)
    ;; Small JS-side value model for Gregor-like date/time values. Plain dates
    ;; and times remain timezone-independent tagged objects.  Explicit
    ;; ->js-date conversion yields a native JavaScript Date.
    (format "((__rkt_body) => {\n  const __pad = (__n, __w = 2) => String(__n).padStart(__w, '0');\n  const __date = (__y, __m, __d) => ({__gregor: 'date', year: Number(__y), month: Number(__m), day: Number(__d)});\n  const __time = (__h, __m, __s = 0) => ({__gregor: 'time', hour: Number(__h), minute: Number(__m), second: Number(__s)});\n  const __datetime = (__y, __mo, __d, __h = 0, __mi = 0, __s = 0) => ({__gregor: 'datetime', year: Number(__y), month: Number(__mo), day: Number(__d), hour: Number(__h), minute: Number(__mi), second: Number(__s)});\n  const __parse_date = (__s) => { const __m = String(__s).match(/^(\\d{4})-(\\d{2})-(\\d{2})$/); if (!__m) throw new Error('invalid date: ' + __s); return __date(__m[1], __m[2], __m[3]); };\n  const __parse_time = (__s) => { const __m = String(__s).match(/^(\\d{2}):(\\d{2})(?::(\\d{2}))?$/); if (!__m) throw new Error('invalid time: ' + __s); return __time(__m[1], __m[2], __m[3] || 0); };\n  const __parse_datetime = (__s) => { const __m = String(__s).match(/^(\\d{4})-(\\d{2})-(\\d{2})[T ](\\d{2}):(\\d{2})(?::(\\d{2}))?(?:Z|[+-]\\d{2}:?\\d{2})?$/); if (!__m) throw new Error('invalid datetime: ' + __s); return __datetime(__m[1], __m[2], __m[3], __m[4], __m[5], __m[6] || 0); };\n  const __from_js_date = (__x) => __datetime(__x.getFullYear(), __x.getMonth() + 1, __x.getDate(), __x.getHours(), __x.getMinutes(), __x.getSeconds());\n  const __to_js_date = (__x) => { if (__x instanceof Date) return __x; if (__x.__gregor === 'date') return new Date(__x.year, __x.month - 1, __x.day); if (__x.__gregor === 'time') return new Date(1970, 0, 1, __x.hour, __x.minute, __x.second || 0); return new Date(__x.year, __x.month - 1, __x.day, __x.hour || 0, __x.minute || 0, __x.second || 0); };\n  const __date_string = (__x) => `${__pad(__x.year, 4)}-${__pad(__x.month)}-${__pad(__x.day)}`;\n  const __time_string = (__x) => `${__pad(__x.hour)}:${__pad(__x.minute)}:${__pad(__x.second || 0)}`;\n  const __datetime_string = (__x) => `${__pad(__x.year, 4)}-${__pad(__x.month)}-${__pad(__x.day)}T${__pad(__x.hour || 0)}:${__pad(__x.minute || 0)}:${__pad(__x.second || 0)}`;\n  const __kind = (__x) => (__x && __x.__gregor) || (__x instanceof Date ? 'js-date' : false);\n  const __get = (__x, __field) => { if (__x instanceof Date) { const __m = {year: __x.getFullYear(), month: __x.getMonth() + 1, day: __x.getDate(), hour: __x.getHours(), minute: __x.getMinutes(), second: __x.getSeconds()}; return __m[__field]; } return __x[__field]; };\n  return __rkt_body({date: __date, time: __time, datetime: __datetime, parseDate: __parse_date, parseTime: __parse_time, parseDateTime: __parse_datetime, fromJSDate: __from_js_date, toJSDate: __to_js_date, dateString: __date_string, timeString: __time_string, dateTimeString: __datetime_string, kind: __kind, get: __get});\n})((__g) => ~a)" expr))

  (define (compile-gregor op args)
    (define lname (identifier-local-name op))
    (define (one who) (match args [(list x) x] [_ (fail who args)]))
    (define (one/two who) (match args [(list x) x] [(list x _fmt) x] [_ (fail who args)]))
    (define (date3 who)
      (match args [(list y m d) (inline-gregor-runtime (format "__g.date(~a, ~a, ~a)" (compile-expr y) (compile-expr m) (compile-expr d)))] [_ (fail who args)]))
    (define (time2/3 who)
      (match args
        [(list h m) (inline-gregor-runtime (format "__g.time(~a, ~a, 0)" (compile-expr h) (compile-expr m)))]
        [(list h m s) (inline-gregor-runtime (format "__g.time(~a, ~a, ~a)" (compile-expr h) (compile-expr m) (compile-expr s)))]
        [_ (fail who args)]))
    (define (dt who)
      (match args
        [(list y mo d h mi) (inline-gregor-runtime (format "__g.datetime(~a, ~a, ~a, ~a, ~a, 0)" (compile-expr y) (compile-expr mo) (compile-expr d) (compile-expr h) (compile-expr mi)))]
        [(list y mo d h mi s) (inline-gregor-runtime (format "__g.datetime(~a, ~a, ~a, ~a, ~a, ~a)" (compile-expr y) (compile-expr mo) (compile-expr d) (compile-expr h) (compile-expr mi) (compile-expr s)))]
        [_ (fail who args)]))
    (case (string->symbol lname)
      [(string->date parse-date) (inline-gregor-runtime (format "__g.parseDate(~a)" (compile-expr (one/two op))))]
      [(date->string) (inline-gregor-runtime (format "__g.dateString(~a)" (compile-expr (one op))))]
      [(string->time parse-time) (inline-gregor-runtime (format "__g.parseTime(~a)" (compile-expr (one/two op))))]
      [(time->string) (inline-gregor-runtime (format "__g.timeString(~a)" (compile-expr (one op))))]
      [(string->datetime parse-moment parse-datetime) (inline-gregor-runtime (format "__g.parseDateTime(~a)" (compile-expr (one/two op))))]
      [(datetime->string moment->string) (inline-gregor-runtime (format "__g.dateTimeString(~a)" (compile-expr (one op))))]
      [(date make-date) (date3 op)]
      [(time make-time) (time2/3 op)]
      [(datetime moment make-datetime make-moment) (dt op)]
      [(date?) (inline-gregor-runtime (format "(__g.kind(~a) === 'date')" (compile-expr (one op))))]
      [(time?) (inline-gregor-runtime (format "(__g.kind(~a) === 'time')" (compile-expr (one op))))]
      [(datetime? moment?) (inline-gregor-runtime (format "(__g.kind(~a) === 'datetime' || __g.kind(~a) === 'js-date')" (compile-expr (one op)) (compile-expr (one op))))]
      [(->year year) (inline-gregor-runtime (format "__g.get(~a, 'year')" (compile-expr (one op))))]
      [(->month month) (inline-gregor-runtime (format "__g.get(~a, 'month')" (compile-expr (one op))))]
      [(->day day) (inline-gregor-runtime (format "__g.get(~a, 'day')" (compile-expr (one op))))]
      [(->hours hours) (inline-gregor-runtime (format "__g.get(~a, 'hour')" (compile-expr (one op))))]
      [(->minutes minutes) (inline-gregor-runtime (format "__g.get(~a, 'minute')" (compile-expr (one op))))]
      [(->seconds seconds) (inline-gregor-runtime (format "__g.get(~a, 'second')" (compile-expr (one op))))]
      [(->js-date) (inline-gregor-runtime (format "__g.toJSDate(~a)" (compile-expr (one op))))]
      [(js-date->datetime) (inline-gregor-runtime (format "__g.fromJSDate(~a)" (compile-expr (one op))))]
      [else #f]))

  (define (compile-division args)
    ;; JavaScript produces Infinity for 10 / 0, while Racket raises an
    ;; exception for exact division by zero.  This subset uses a runtime
    ;; zero-check so with-handlers can catch the common division-by-zero case.
    (when (null? args) (fail "empty / operator" args))
    (define temps (for/list ([_ (in-list args)]) (fresh "div")))
    (define bindings
      (for/list ([tmp (in-list temps)] [arg (in-list args)])
        (format "const ~a = ~a;" tmp (compile-expr arg))))
    (define denominators (if (= (length temps) 1) temps (cdr temps)))
    (define checks
      (for/list ([tmp (in-list denominators)])
        (format "if (~a === 0) throw new Error(\"division by zero\");" tmp)))
    (define result
      (if (= (length temps) 1)
          (format "(1 / ~a)" (car temps))
          (parens (string-join temps " / "))))
    (format "(() => ~a)()"
            (block (join-lines (append bindings checks (list (format "return ~a;" result)))))))

  (define (compile-operator op args)
    (or (compile-gregor op args)
        (let ()
    (define (binary jsop [empty #f] [single-prefix #f])
      (cond
        [(null? args) (or empty (fail "empty operator" op))]
        [(and (= (length args) 1) single-prefix) (format "(~a~a)" single-prefix (compile-expr (car args)))]
        [else (parens (string-join (map compile-expr args) (format " ~a " jsop)))]))
    (case op
      [(+) (if (null? args) "0" (binary "+"))]
      [(*) (if (null? args) "1" (binary "*"))]
      [(-) (binary "-" #f "-")]
      [(/) (compile-division args)]
      [(quotient) (format "Math.trunc(~a / ~a)" (compile-expr (car args)) (compile-expr (cadr args)))]
      [(remainder modulo) (binary "%")]
      [(add1) (format "(~a + 1)" (compile-expr (car args)))]
      [(sub1) (format "(~a - 1)" (compile-expr (car args)))]
      [(abs) (format "Math.abs(~a)" (compile-expr (car args)))]
      [(floor) (format "Math.floor(~a)" (compile-expr (car args)))]
      [(ceiling) (format "Math.ceil(~a)" (compile-expr (car args)))]
      [(round) (format "Math.round(~a)" (compile-expr (car args)))]
      [(max) (format "Math.max(~a)" (string-join (map compile-expr args) ", "))]
      [(min) (format "Math.min(~a)" (string-join (map compile-expr args) ", "))]
      [(sqrt) (format "Math.sqrt(~a)" (compile-expr (car args)))]
      [(sqr) (format "((__x) => __x * __x)(~a)" (compile-expr (car args)))]
      [(expt) (format "Math.pow(~a, ~a)" (compile-expr (car args)) (compile-expr (cadr args)))]
      [(sin cos tan asin acos atan log exp) (format "Math.~a(~a)" (symbol->string op) (string-join (map compile-expr args) ", "))]
      [(zero?) (format "(~a === 0)" (compile-expr (car args)))]
      [(positive?) (format "(~a > 0)" (compile-expr (car args)))]
      [(negative?) (format "(~a < 0)" (compile-expr (car args)))]
      [(even?) (format "(~a % 2 === 0)" (compile-expr (car args)))]
      [(odd?) (format "(~a % 2 !== 0)" (compile-expr (car args)))]
      [(= ==) (compile-comparison "===" args)]
      [(equal?) (compile-deep-equal args)]
      [(eq? eqv?) (compile-object-is args)]
      [(!= not-equal?) (format "!(~a)" (compile-deep-equal args))]
      [(< > <= >=) (compile-comparison (symbol->string op) args)]
      [(and) (compile-and args)]
      [(or) (compile-or args)]
      [(not) (format "(~a === false)" (compile-expr (car args)))]
      [(list vector) (format "[~a]" (string-join (map compile-expr args) ", "))]
      [(list*)
       (cond
         [(null? args) "[]"]
         [(null? (cdr args)) (compile-expr (car args))]
         [else
          (define fixed (reverse (cdr (reverse args))))
          (define last-arg (car (reverse args)))
          (format "[~a].concat(~a)" (string-join (map compile-expr fixed) ", ") (compile-expr last-arg))])]
      [(cons) (format "[~a].concat(~a)" (compile-expr (car args)) (compile-expr (cadr args)))]
      [(append) (if (null? args) "[]" (format "[].concat(~a)" (string-join (map compile-expr args) ", ")))]
      [(car first) (format "~a[0]" (parens (compile-expr (car args))))]
      [(cdr rest) (format "~a.slice(1)" (parens (compile-expr (car args))))]
      [(cadr second) (format "~a[1]" (parens (compile-expr (car args))))]
      [(caddr third) (format "~a[2]" (parens (compile-expr (car args))))]
      [(length vector-length string-length) (format "~a.length" (parens (compile-expr (car args))))]
      [(list-ref vector-ref string-ref) (format "~a[~a]" (parens (compile-expr (car args))) (compile-expr (cadr args)))]
      [(list-tail) (format "~a.slice(~a)" (parens (compile-expr (car args))) (compile-expr (cadr args)))]
      [(last) (format "((__xs) => __xs[__xs.length - 1])(~a)" (compile-expr (car args)))]
      [(list-set)
       (match args
         [(list xs i v)
          (format "((__xs, __i, __v) => { const __out = __xs.slice(); __out[__i] = __v; return __out; })(~a, ~a, ~a)"
                  (compile-expr xs) (compile-expr i) (compile-expr v))]
         [_ (fail "list-set" args)])]
      [(list-update)
       (match args
         [(list xs i f)
          (format "((__xs, __i, __f) => { const __out = __xs.slice(); __out[__i] = __f(__out[__i]); return __out; })(~a, ~a, ~a)"
                  (compile-expr xs) (compile-expr i) (compile-expr f))]
         [_ (fail "list-update" args)])]
      [(null? empty?) (format "((__xs) => Array.isArray(__xs) && __xs.length === 0)(~a)" (compile-expr (car args)))]
      [(pair?) (format "((__xs) => Array.isArray(__xs) && __xs.length > 0)(~a)" (compile-expr (car args)))]
      [(list? vector?) (format "Array.isArray(~a)" (compile-expr (car args)))]
      [(number? real? integer?) (format "typeof ~a === \"number\"" (compile-expr (car args)))]
      [(string?) (format "typeof ~a === \"string\"" (compile-expr (car args)))]
      [(boolean?) (format "typeof ~a === \"boolean\"" (compile-expr (car args)))]
      [(symbol?) (format "typeof ~a === \"string\"" (compile-expr (car args)))]
      [(void) "undefined"]
      [(values) (if (= (length args) 1) (compile-expr (car args)) (format "[~a]" (string-join (map compile-expr args) ", ")))]
      [(string-append) (if (null? args) "\"\"" (binary "+"))]
      [(substring)
       (match args
         [(list s start) (format "~a.substring(~a)" (parens (compile-expr s)) (compile-expr start))]
         [(list s start end) (format "~a.substring(~a, ~a)" (parens (compile-expr s)) (compile-expr start) (compile-expr end))]
         [_ (fail "substring" args)])]
      [(string-upcase) (format "~a.toUpperCase()" (parens (compile-expr (car args))))]
      [(string-downcase) (format "~a.toLowerCase()" (parens (compile-expr (car args))))]
      [(string-trim) (format "~a.trim()" (parens (compile-expr (car args))))]
      [(string-contains?) (format "~a.includes(~a)" (parens (compile-expr (car args))) (compile-expr (cadr args)))]
      [(regexp? pregexp?) (format "(~a instanceof RegExp || typeof ~a === \"string\")" (compile-expr (car args)) (compile-expr (car args)))]
      [(regexp-match) (compile-regexp-match args)]
      [(regexp-match?) (compile-regexp-match? args)]
      [(regexp-match*) (compile-regexp-match* args)]
      [(regexp-match-positions) (compile-regexp-match-positions args)]
      [(regexp-split) (compile-regexp-split args)]
      [(regexp-replace) (compile-regexp-replace args #:all? #f)]
      [(regexp-replace*) (compile-regexp-replace args #:all? #t)]
      [(regexp-quote) (compile-regexp-quote args)]
      [(string=? string-ci=?) (compile-comparison "===" args)]
      [(string<? string>? string<=? string>=?)
       (compile-comparison (case op [(string<?) "<"] [(string>?) ">"] [(string<=?) "<="] [(string>=?) ">="]) args)]
      [(number->string symbol->string string->symbol) (format "String(~a)" (compile-expr (car args)))]
      [(string->number) (format "Number(~a)" (compile-expr (car args)))]
      [(displayln) (format "console.log(~a)" (string-join (map compile-expr args) ", "))]
      [(display) (format "console.log(~a)" (string-join (map compile-expr args) ", "))]
      [(hash hasheq hasheqv) (compile-hash args)]
      [(make-hash make-immutable-hash make-hasheq make-immutable-hasheq make-hasheqv make-immutable-hasheqv)
       (compile-make-hash args)]
      [(hash?) (format "((__h) => __h !== null && typeof __h === 'object' && !Array.isArray(__h))(~a)" (compile-expr (car args)))]
      [(hash-ref) (compile-hash-ref args)]
      [(hash-set) (compile-hash-set args)]
      [(hash-set!) (compile-hash-set args #:mutate? #t)]
      [(hash-remove) (compile-hash-remove args)]
      [(hash-remove!) (compile-hash-remove args #:mutate? #t)]
      [(hash-update) (compile-hash-update args)]
      [(hash-update!) (compile-hash-update args #:mutate? #t)]
      [(hash-clear) (compile-hash-clear args)]
      [(hash-clear!) (compile-hash-clear args #:mutate? #t)]
      [(hash-copy) (format "Object.assign({}, ~a)" (compile-expr (car args)))]
      [(hash-copy-clear) "{}"]
      [(hash-has-key?) (format "Object.prototype.hasOwnProperty.call(~a, ~a)" (compile-expr (car args)) (compile-expr (cadr args)))]
      [(hash-count) (format "Object.keys(~a).length" (compile-expr (car args)))]
      [(hash-empty?) (format "Object.keys(~a).length === 0" (compile-expr (car args)))]
      [(hash-keys) (format "Object.keys(~a)" (compile-expr (car args)))]
      [(hash-values) (format "Object.values(~a)" (compile-expr (car args)))]
      [(hash->list) (format "Object.entries(~a)" (compile-expr (car args)))]
      [(hash-map) (format "Object.entries(~a).map(([__k, __v]) => ~a(__k, __v))" (compile-expr (car args)) (compile-expr (cadr args)))]
      [(hash-for-each) (format "((__h, __f) => { Object.entries(__h).forEach(([__k, __v]) => __f(__k, __v)); return undefined; })(~a, ~a)" (compile-expr (car args)) (compile-expr (cadr args)))]
      [(reverse) (format "[...~a].reverse()" (parens (compile-expr (car args))))]
      [(take) (format "~a.slice(0, ~a)" (parens (compile-expr (car args))) (compile-expr (cadr args)))]
      [(drop) (format "~a.slice(~a)" (parens (compile-expr (car args))) (compile-expr (cadr args)))]
      [(take-right) (format "((__xs, __n) => __xs.slice(Math.max(0, __xs.length - __n)))(~a, ~a)" (compile-expr (car args)) (compile-expr (cadr args)))]
      [(drop-right) (format "((__xs, __n) => __xs.slice(0, Math.max(0, __xs.length - __n)))(~a, ~a)" (compile-expr (car args)) (compile-expr (cadr args)))]
      [(member)
       (format "((__v, __xs) => { const __i = __xs.findIndex((__x) => Object.is(__x, __v) || JSON.stringify(__x) === JSON.stringify(__v)); return __i < 0 ? false : __xs.slice(__i); })(~a, ~a)"
               (compile-expr (car args)) (compile-expr (cadr args)))]
      [(memq memv)
       (format "((__v, __xs) => { const __i = __xs.findIndex((__x) => Object.is(__x, __v)); return __i < 0 ? false : __xs.slice(__i); })(~a, ~a)"
               (compile-expr (car args)) (compile-expr (cadr args)))]
      [(remove)
       (format "((__v, __xs) => { let __done = false; return __xs.filter((__x) => { const __same = Object.is(__x, __v) || JSON.stringify(__x) === JSON.stringify(__v); if (!__done && __same) { __done = true; return false; } return true; }); })(~a, ~a)"
               (compile-expr (car args)) (compile-expr (cadr args)))]
      [(remove*)
       (format "((__vs, __xs) => __xs.filter((__x) => !__vs.some((__v) => Object.is(__x, __v) || JSON.stringify(__x) === JSON.stringify(__v))))(~a, ~a)"
               (compile-expr (car args)) (compile-expr (cadr args)))]
      [(sort)
       (match args
         [(list xs less?)
          (format "((__xs, __less) => __xs.slice().sort((__a, __b) => __less(__a, __b) !== false ? -1 : (__less(__b, __a) !== false ? 1 : 0)))(~a, ~a)"
                  (compile-expr xs) (compile-expr less?))]
         [_ (fail "sort" args)])]
      [(map)
       (match args
         [(list f xs) (format "~a.map((__x) => ~a(__x))" (parens (compile-expr xs)) (compile-expr f))]
         [(list f xs more ...)
          (format "((__arrays) => __arrays[0].map((_, __i) => ~a(...__arrays.map((__a) => __a[__i]))))([~a])"
                  (compile-expr f) (string-join (map compile-expr (cons xs more)) ", "))]
         [_ (fail "map" args)])]
      [(filter) (format "~a.filter((__x) => (~a(__x) !== false))" (parens (compile-expr (cadr args))) (compile-expr (car args)))]
      [(foldl) (format "~a.reduce((__acc, __x) => ~a(__x, __acc), ~a)" (parens (compile-expr (caddr args))) (compile-expr (car args)) (compile-expr (cadr args)))]
      [(foldr) (format "~a.reduceRight((__acc, __x) => ~a(__x, __acc), ~a)" (parens (compile-expr (caddr args))) (compile-expr (car args)) (compile-expr (cadr args)))]
      [(apply)
       (match args
         [(list f last-arg) (format "~a(...~a)" (compile-expr f) (compile-expr last-arg))]
         [(list f fixed ... last-arg) (format "~a(~a, ...~a)" (compile-expr f) (string-join (map compile-expr fixed) ", ") (compile-expr last-arg))]
         [_ (fail "apply" args)])]
      [(error) (format "(() => { throw new Error(~a); })()" (if (null? args) "\"error\"" (compile-expr (car args))))]
      [(raise) (format "(() => { throw ~a; })()" (if (null? args) "new Error(\"raise\")" (compile-expr (car args))))]
      [(exn?) (if (null? args) "true" "true")]
      [(exn-message) (format "String((~a && ~a.message !== undefined) ? ~a.message : ~a)" (compile-expr (car args)) (compile-expr (car args)) (compile-expr (car args)) (compile-expr (car args)))]
      [else #f]))))

  (define (compile-call f args)
    (or (and (symbol? f) (compile-operator f args))
        (match f
          ['send (match args
                   [(list obj method more ...)
                    (format "~a.~a(~a)" (compile-expr obj) (prop->js method) (string-join (map compile-expr more) ", "))]
                   [_ (fail "send" args)])]
          ['new (match args
                  [(list cls more ...) (format "new ~a(~a)" (compile-expr cls) (string-join (map compile-expr more) ", "))]
                  [_ (fail "new" args)])]
          ['js-ref (match args
                     [(list obj key) (format "~a[~a]" (compile-expr obj) (compile-expr key))]
                     [_ (fail "js-ref" args)])]
          ['js-dot (match args
                     [(list obj (? symbol? key)) (format "~a.~a" (compile-expr obj) (prop->js key))]
                     [_ (fail "js-dot" args)])]
          ['js-delete (match args
                        [(list obj key) (parens (compile-delete-target obj key))]
                        [_ (fail "js-delete" args)])]
          ['array (format "[~a]" (string-join (map compile-expr args) ", "))]
          ['object (compile-hash args)]
          [_ (format "~a(~a)" (compile-callee f) (string-join (map compile-expr args) ", "))])))

  (define (compile-expr d)
    (match d
      [(? boolean?) (if d "true" "false")]
      [(? regexp?) (compile-regexp-literal d)]
      [(? byte-regexp?) (fail "byte regexp literal" d)]
      [(? number?) (number->string d)]
      [(? string?) (js-string d)]
      [(? char?) (js-string (string d))]
      [(? keyword?) (js-string (keyword->string d))]
      ['js-null "null"]
      ['js-undefined "undefined"]
      ['js-NaN "NaN"]
      [(? symbol?) (id->js d)]
      [(list 'quote v) (literal->js v)]
      [(list 'quasiquote v) (literal->js v)]
      [(list 'lambda formals body ...)
       (format "function(~a) ~a" (compile-formals formals) (block (compile-body body #:return-last? #t)))]
      [(list 'λ formals body ...)
       (format "function(~a) ~a" (compile-formals formals) (block (compile-body body #:return-last? #t)))]
      [(list 'if c t e) (compile-if-expr c t e)]
      [(list 'begin es ...) (compile-begin-expr es)]
      [(list 'while c body ...)
       (format "(() => ~a)()"
               (block (join-lines
                       (list (format "while (~a) ~a" (compile-test c) (block (compile-body body)))
                             "return undefined;"))))]
      [(list 'begin0 first rest ...)
       (define tmp "__begin0_value")
       (format "(() => ~a)()" (block (join-lines (append (list (format "const ~a = ~a;" tmp (compile-expr first)))
                                                          (map compile-stmt rest)
                                                          (list (format "return ~a;" tmp))))))]
      [(list 'let name bindings body ...) #:when (symbol? name)
       (compile-named-let name bindings body #:return-last? #t #:as-expression? #t)]
      [(list 'let bindings body ...)
       (compile-let 'let bindings body #:return-last? #t #:as-expression? #t)]
      [(list 'let* bindings body ...)
       (compile-let 'let* bindings body #:return-last? #t #:as-expression? #t)]
      [(list 'letrec bindings body ...)
       (compile-let 'letrec bindings body #:return-last? #t #:as-expression? #t)]
      [(list 'let-values bindings body ...)
       (compile-let-values 'let-values bindings body #:return-last? #t #:as-expression? #t)]
      [(list 'let*-values bindings body ...)
       (compile-let-values 'let*-values bindings body #:return-last? #t #:as-expression? #t)]
      [(list 'cond clauses ...)
       (format "(() => ~a)()" (block (compile-cond clauses #:return-last? #t)))]
      [(list 'case key clauses ...)
       (format "(() => ~a)()" (block (compile-case key clauses #:return-last? #t)))]
      [(list 'with-handlers clauses body ...)
       (compile-with-handlers clauses body #:return-last? #t #:as-expression? #t)]
      [(list 'for/list clauses body ...)
       (compile-for clauses body #:collect? #t #:as-expression? #t)]
      [(list 'for/vector clauses body ...)
       (compile-for clauses body #:collect? #t #:as-expression? #t)]
      [(list 'for clauses body ...)
       (compile-for clauses body #:collect? #f #:as-expression? #t)]
      [(list 'for/fold bindings clauses body ...)
       (compile-for-fold bindings clauses body)]
      [(list 'when c body ...)
       (format "(() => ~a)()" (block (compile-return `(when ,c ,@body))))]
      [(list 'unless c body ...)
       (format "(() => ~a)()" (block (compile-return `(unless ,c ,@body))))]
      [(list 'let-object bindings obj body ...)
       (compile-let-object bindings obj body #:return-last? #t #:as-expression? #t)]
      [(list 'js-delete obj key)
       (parens (compile-delete-target obj key))]
      [(list 'set-prop! obj key val)
       (format "(~a[~a] = ~a)" (compile-expr obj) (compile-expr key) (compile-expr val))]
      [(list 'set! target rhs)
       (format "(~a = ~a)" (compile-assignment-target target) (compile-expr rhs))]
      [(list 'return) "undefined"]
      [(list 'return e) (compile-expr e)]
      [(list f args ...) (compile-call f args)]
      [_ (literal->js d)]))

  (define (compile-top forms)
    (compile-body forms #:return-last? #f)))

(define-syntax (js stx)
  (syntax-case stx ()
    [(_ form ...)
     (datum->syntax stx (compile-top (syntax->datum #'(form ...))))]))

(define-syntax (js/expression stx)
  (syntax-case stx ()
    [(_ form)
     (datum->syntax stx (compile-expr (syntax->datum #'form)))]))