(module compile mzscheme
  (require (planet "evector.scm" ("soegaard" "evector.plt" 1 0))
           (planet "list.ss" ("dherman" "list.plt" 1 0))
           (lib "match.ss")
           (lib "etc.ss")
           "../syntax/ast.ss"
           "../syntax/token.ss"
           "../config.ss"
           "../exn.ss"
           "../runtime/runtime.ss"
           "hoist.ss")

  ;; TODO: is generate-temporaries guaranteed never to be captured?
  ;;  - perhaps not, because sometimes 'x57 == (generate-temporaries '(x))
  ;;  - perhaps so, if we always use non-forgeable names (e.g., with an illegal character)
  ;;  - but be careful about capture with string keys!

  ;; TODO: optimizations
  ;;   - don't capture return continuation if it's not used
  ;;   - remove unnecessary `void' if last statement in function is not an expression statement

  ;; static-environment : (parameterof (alistof Identifier (optional (syntaxof ref))))
  (define static-environment (make-parameter null))
  (define current-with-statement (make-parameter #f))

  ;; The (potentially dynamic) scope chain, only used underneath `with'.
  (define scope-chain (datum->syntax-object #f 'scope-chain))

  ;; This syntax object will have the syntax-original? property. It can be used
  ;; with datum->syntax-object to give subsequent syntax objects this property.
  (define stx-for-original-property (read-syntax #f (open-input-string "original")))

  (define-syntax syntax/loc*
    (syntax-rules ()
      [(_ loc expr)
       (syntax/loc (region->syntax loc)
         expr)]))

  ;; build-syntax : any [(optional region) boolean] -> syntax
  (define build-syntax
    (opt-lambda (expr [location #f] [original? #t])
      (datum->syntax-object #f
                            expr
                            (and location (region->syntax location original?))
                            (and original? stx-for-original-property))))

  ;; region->syntax : region [boolean] -> syntax
  (define region->syntax
    (opt-lambda (region [original? #t])
      (let ([start (region-start region)]
            [end (region-end region)])
        (datum->syntax-object #f
                              'source-location
                              (list
                               (region-source region)
                               (position-line start)
                               (position-col start)
                               (position-offset start)
                               (- (position-offset end) (position-offset start)))
                              (and original? stx-for-original-property)))))

  ;; Identifier->syntax : Identifier -> syntax
  (define Identifier->syntax
    (opt-lambda (id [loc (Term-location id)])
      (build-syntax (Identifier-name id) loc)))

  ;; Identifier->key : Identifier -> syntax
  (define (Identifier->key id)
    (build-syntax (symbol->string (Identifier-name id))
                  (Term-location id)))

  ;; loop? : Statement -> boolean
  (define (loop? stmt)
    (or (DoWhileStatement? stmt)
        (WhileStatement? stmt)
        (ForStatement? stmt)
        (ForInStatement? stmt)))

  (define (debug fmt . args)
    (apply fprintf (current-error-port) (format "<<DEBUG: ~a>>~n" fmt) args))

  (define current-labels (make-parameter null))

  (define enable-return? (make-parameter #f))

  ;; ===========================================================================
  ;; COMPILER TOP-LEVEL
  ;; ===========================================================================

  (define (with-syntax-errors thunk)
    (with-handlers ([exn:fail:javascript:syntax?
                     (lambda (exn)
                       (let* ([loc (exn:fail:javascript:syntax-location exn)]
                              [text (format "~a" (exn:fail:javascript:syntax-text exn))]
                              [stxloc (build-syntax (string->symbol text) loc)])
                         (raise-syntax-error 'parse (exn-message exn) stxloc stxloc)))])
      (thunk)))

  ;; compile-script : (listof SourceElement) -> syntax
  (define (compile-script elts)
    (let*-values ([(funs vars stmts) (hoist-script elts)]
                  [(definitions new-env) (compile-declarations #t funs vars)])
      (with-syntax ([defns definitions]
                    [scope-chain scope-chain]
                    [(s ...) (parameterize ([static-environment new-env])
                               (map compile-statement stmts))])
        #'(begin
            (push-completion-context!)
            (define scope-chain null)
            defns s ...
            (begin0 (previous-completion)
                    (pop-completion-context!))))))

  ;; compile-interaction : (listof SourceElement) -> syntax
  (define (compile-interaction elt)
    (let*-values ([(funs vars stmts) (hoist-script elt)]
                  [(definitions new-env) (compile-declarations #t funs vars)])
      (with-syntax ([defns definitions]
                    [scope-chain scope-chain]
                    [(s ...) (parameterize ([static-environment new-env])
                               (map compile-statement stmts))])
        (static-environment new-env)
        #'(begin
            (push-completion-context!)
            (define scope-chain null)
            defns s ...
            (begin0 (previous-completion)
                    (set-ref! (make-object-ref global-object "it") (previous-completion))
                    (pop-completion-context!))))))

  ;; compile-declarations : boolean (listof FunctionDeclaration/hoisted) (listof Identifier)
  ;;                     -> syntax
  ;;                        environment
  (define (compile-declarations in-global-object? funs vars)
    (let* ([fun-ids (map FunctionDeclaration-name funs)]
           [all-ids (append fun-ids vars)]
           [new-env (append (map (lambda (id)
                                   (cons id (and in-global-object?
                                                 (with-syntax ([key (Identifier->key id)])
                                                   #'(make-object-ref global-object key)))))
                                 all-ids)
                            (static-environment))])
      (with-syntax ([(var ...) (map Identifier->syntax all-ids)]
                    [(var-key ...) (map Identifier->key all-ids)]
                    [(init-e ...) (append (parameterize ([static-environment new-env])
                                            (map compile-function-declaration funs))
                                          (map (lambda (var) #'(void)) vars))])
        (values #'(begin
                    (define var (make-object-ref global-object var-key)) ...
                    (set-ref! var (deref init-e)) ...)
                new-env))))

  ;; ===========================================================================
  ;; COMPILER CORE
  ;; ===========================================================================

  ;; bind : region
  ;;        (listof (union Identifier symbol #f))
  ;;        (listof (optional syntax))
  ;;        ((listof syntax) -> syntax)
  ;;     -> syntax
  (define (bind loc ids inits body-k)
    (let ([new-static-environment (let f ([ids ids] [inits inits])
                                    (if (null? ids)
                                        (static-environment)
                                        (let ([id (car ids)]
                                              [init (car inits)])
                                          (cond
                                            [(not id)
                                             (f (cdr ids) (cdr inits))]
                                            [(symbol? id)
                                             (cons (cons (make-Identifier #f id) init)
                                                   (f (cdr ids) (cdr inits)))]
                                            [else
                                             (cons (cons id init)
                                                   (f (cdr ids) (cdr inits)))]))))]
          [stx-ids (map (lambda (id)
                          (cond
                            [(not id)
                             (car (generate-temporaries '(x)))]
                            [(symbol? id)
                             (datum->syntax-object #f id)]
                            [else
                             (Identifier->syntax id)]))
                        ids)])
      (if (current-with-statement)
          (with-syntax ([(v ...) stx-ids]
                        [scope-chain scope-chain]
                        [body (parameterize ([static-environment new-static-environment])
                                (body-k stx-ids))])
            (with-syntax ([(r ...) (map (lambda (init stx-id)
                                          (with-syntax ([key (symbol->string (syntax-object->datum stx-id))])
                                            (or init #'(make-scope-chain-ref scope-chain
                                                                             key
                                                                             (lambda ()
                                                                               (raise-reference-error stx-id key))))))
                                        inits
                                        stx-ids)])
              (syntax/loc* loc
                (let ([scope-chain (cons (make-frame (object-table [v (void)] ...)) scope-chain)])
                  (let ([v r] ...)
                    body)))))
          (with-syntax ([(v ...) stx-ids]
                        [body (parameterize ([static-environment new-static-environment])
                                (body-k stx-ids))])
            (with-syntax ([(r ...) (map (lambda (init)
                                          (or init #'(make-lexical-ref)))
                                        inits)])
              (syntax/loc* loc
                (let ([v r] ...)
                  body)))))))

  (define (compile-function-declaration decl)
    (match decl
      [($ FunctionDeclaration/hoisted loc name args body funs vars)
       (compile-function loc name args body funs vars)]))

  ;; TODO: handle return more gracefully (particularly invalid returns)

  ;; TODO: use compile-declarations for funs & vars?

  ;; compile-function : region
  ;;                    (optional Identifier)
  ;;                    (listof Identifier)
  ;;                    (listof Statement)
  ;;                    (listof FunctionDeclaration/hoisted)
  ;;                    (listof Identifier)
  ;;                 -> syntax
   (define (compile-function loc name args body funs vars)
     (bind loc (list name 'arguments 'return) (list #f #f #f)
       (lambda (stx-ids)
         (with-syntax ([(f arguments return) stx-ids]
                       [arity (length args)]
                       [(i ...) (iota (length args))]
                       [(r ...) (generate-temporaries (map Identifier-name args))])
           (with-syntax ([body
                          (bind loc args (syntax->list #'(r ...))
                            (lambda (arg-stx-ids)
                              (bind loc (map FunctionDeclaration-name funs) (map (lambda (fun) #f) funs)
                                (lambda (fun-stx-ids)
                                  (bind loc vars (map (lambda (var) #f) vars)
                                    (lambda (var-stx-ids)
                                      (with-syntax ([(x ...) arg-stx-ids]
                                                    [(g ...) fun-stx-ids]
                                                    [(ge ...) (map compile-function-declaration funs)]
                                                    [(v ...) var-stx-ids]
                                                    [(s ...) (parameterize ([enable-return? #t])
                                                               (map compile-statement body))])
                                        (syntax/loc* loc
                                          (with-completion-context
                                            (let/ec return
                                              (set-ref! g ge) ...
                                              s ...
                                              (void)))))))))))]
                         [(func-object args-object) (generate-temporaries '(func-object args-object))])
             (syntax/loc* loc
               (letrec ([func-object (build-function arity
                                       (lambda (arg-vec)
                                         (let* ([args-object (make-arguments-object func-object arg-vec)]
                                                [r (make-array-ref arg-vec i)]
                                                ...)
                                           (set-ref! arguments args-object)
                                           body)))])
                 (set-ref! f func-object)
                 func-object)))))))

  (define (compile-statement stmt)
    (match stmt
      [($ BlockStatement loc stmts)
       (with-syntax ([(s ...) (map compile-statement stmts)])
         (syntax/loc* loc
           (begin s ... (previous-completion))))]
      [($ EmptyStatement loc)
       (syntax/loc* loc
         #f)]
      [($ ExpressionStatement loc expr)
       (with-syntax ([e (compile-expression expr)])
         (syntax/loc* loc
           (complete! (deref e))))]
      ;; TODO: test IfStatement
      [($ IfStatement loc test consequent alternate)
       (with-syntax ([test-e (compile-expression test)]
                     [consequent-s (compile-statement consequent)]
                     [alternate-s (if alternate (compile-statement alternate) #'#f)])
         (syntax/loc* loc
           (if (true-value? (deref test-e))
               consequent-s
               alternate-s)))]
      ;; TODO: test loops
      [(? loop?)
       (with-syntax ([(break continue) (generate-temporaries '(break continue))])
         (parameterize ([current-labels (cons (list #f #'break #'continue)
                                              (current-labels))])
           (compile-loop stmt #'break #'continue)))]
      ;; TODO: test ContinueStatement
      [($ ContinueStatement loc #f)
       (cond
         [(ormap (lambda (tuple)
                   (and (pair? (cddr tuple))
                        (caddr tuple)))
                 (current-labels))
          => (lambda (continue-id)
               (with-syntax ([continue continue-id])
                 (syntax/loc* loc
                   (continue #f))))]
         [else (let ([stxloc (build-syntax 'continue loc)])
                 (raise-syntax-error 'continue "invalid continue" stxloc stxloc))])]
      [($ ContinueStatement loc label)
       (cond
         [(null? (current-labels))
          (raise-syntax-error 'continue "invalid continue" (build-syntax 'continue loc))]
         [(assq (Identifier-name label) (current-labels))
          => (lambda (tuple)
               (if (pair? (cddr tuple))
                   (with-syntax ([continue (caddr tuple)])
                     (syntax/loc* loc
                       (continue #f)))
                   (raise-syntax-error 'continue "invalid label" (Identifier->syntax label))))]
         [else (raise-syntax-error 'continue "invalid label" (Identifier->syntax label))])]
      ;; TODO: test BreakStatement
      [($ BreakStatement loc #f)
       (when (null? (current-labels))
         (let ([stxloc (build-syntax 'break loc)])
           (raise-syntax-error 'break "invalid break" stxloc stxloc)))
       (with-syntax ([break (cadar (current-labels))])
         (syntax/loc* loc
           (break (previous-completion))))]
      [($ BreakStatement loc label)
       (cond
         [(null? (current-labels))
          (raise-syntax-error 'break "invalid break" (build-syntax 'break loc))]
         [(assq (Identifier-name label) (current-labels))
          => (lambda (tuple)
               (with-syntax ([break (cadr tuple)])
                 (syntax/loc* loc
                   (break (previous-completion)))))]
         [else (raise-syntax-error 'break "invalid label" (Identifier->syntax label))])]
      [($ ReturnStatement loc value)
       (unless (enable-return?)
         (let ([stxloc (build-syntax 'return loc)])
           (raise-syntax-error 'return "invalid return" stxloc stxloc)))
       (with-syntax ([return (datum->syntax-object #f 'return)]
                     [e (if value
                            (compile-expression value)
                            #'(void))])
         (syntax/loc* loc
           (return (deref e))))]
      [($ WithStatement loc object body)
       (let* ([unique-entries (delete-duplicates (static-environment) (lambda (e1 e2)
                                                                        (Identifier=? (car e1) (car e2))))]
              [all-identifiers-in-scope (map car unique-entries)])
         (with-syntax ([scope-chain scope-chain]
                       ;; Shadow all bound variables with expressions that look them up in
                       ;; the dynamic environment, and have their binding arrows point to
                       ;; this with statement.
                       [(shadow-x ...) (map (lambda (id)
                                              (Identifier->syntax id (Term-location object)))
                                            all-identifiers-in-scope)]
                       ;; Uses of these variables will not be associated with source locations.
                       [(invisible-x ...) (map (lambda (id)
                                                 (Identifier->syntax id #f))
                                               all-identifiers-in-scope)]
                       [(x-value ...) (map (lambda (entry)
                                             (or (cdr entry)
                                                 (with-syntax ([inv-x (Identifier->syntax (car entry) #f)])
                                                   #'(deref inv-x))))
                                           unique-entries)]
                       [(x-key ...) (map Identifier->key all-identifiers-in-scope)]
                       ;; The expression is evaluated with the current lexical environment.
                       [e (compile-expression object)]
                       ;; The body is evaluated in the syntactic context of the with statement
                       ;; and has an empty initial static environment.
                       [s (parameterize ([static-environment null]
                                         [current-with-statement stmt])
                            (compile-statement body))]
                       [(base-frame) (generate-temporaries '(base-frame))])
           #'(let ([base-frame (make-frame
                                (object-table [invisible-x x-value] ...))])
               (let ([scope-chain (list (deref e) base-frame)])
                 (let ([shadow-x (make-object-ref base-frame x-key)] ...)
                   s)))))]
      ;; TODO: test SwitchStatement
      ;; TODO: what comparison is used on the values? any dynamic dispatch there?
      [($ SwitchStatement loc expr (($ CaseClause _ qs as) ...))
       (with-syntax ([e (compile-expression expr)]
                     [(x v break falling-through?) (generate-temporaries '(x v break falling-through?))])
         (with-syntax ([(q ...) (map (lambda (q)
                                       (if q
                                           (with-syntax ([test-e (compile-expression q)])
                                             #'(lambda (x)
                                                 (equal? x (deref test-e))))
                                           #'(lambda (x) #t)))
                                     qs)])
           (parameterize ([current-labels (cons (list #f #'break) (current-labels))])
             (with-syntax ([((a ...) ...) (map (lambda (stmts)
                                                 (map compile-statement stmts))
                                               as)])
               (syntax/loc* loc
                 (let ([v (deref e)])
                   (let/ec break
                     (let ([falling-through? #f])
                       (when (or falling-through? (q v))
                         (set! falling-through? #t)
                         a ...)
                       ...
                       (previous-completion)))))))))]
      ;; TODO: test LabelledStatement
      [($ LabelledStatement loc label (and loop (? loop?)))
       (let ([label-name (Identifier-name label)])
         (with-syntax ([(break continue) (generate-temporaries '(break continue))])
           (parameterize ([current-labels (cons (list label-name #'break #'continue)
                                                (current-labels))])
             (compile-loop loop #'break #'continue))))]
      [($ LabelledStatement loc label statement)
       (let ([label-name (Identifier-name label)])
         (with-syntax ([(break) (generate-temporaries '(break))])
           (parameterize ([current-labels (cons (list label-name #'break)
                                                (current-labels))])
             (with-syntax ([s (compile-statement statement)])
               (syntax/loc* loc
                 (let/ec break s))))))]
      ;; TODO: test ThrowStatement
      [($ ThrowStatement loc value)
       (with-syntax ([stxloc (region->syntax loc)]
                     [e (compile-expression value)])
         (syntax/loc* loc
           (raise-runtime-exception stxloc (deref e))))]
      ;; TODO: test TryStatement
      ;; TODO: add conditions to CatchClause ast and compile that too
      ;; TODO: need an error for try with no catch or finally
      ;; TODO: handle try/finally with return in finally
      [($ TryStatement loc body catches finally)
       (with-syntax ([body-s (compile-statement body)]
                     [(catch-e ...) (map compile-catch-clause catches)])
         (with-syntax ([try-catch #'(with-handlers ([exn:fail:javascript:runtime? catch-e]
                                                    ...)
                                       body-s)])
           (if finally
               (with-syntax ([finally-s (compile-statement finally)])
                 (syntax/loc* loc
                   (begin (dynamic-wind
                            void
                            (lambda () try-catch)
                            (lambda () finally-s))
                          (previous-completion))))
               (syntax/loc* loc try-catch))))]
      ))

  ;; TODO: this is a binding form; use `bind'
  (define (compile-catch-clause clause)
    (match clause
      [($ CatchClause loc exn catch)
       (with-syntax ([e (Identifier->syntax exn)]
                     [s (parameterize ([static-environment (cons (cons exn #f) (static-environment))])
                          (compile-statement catch))]
                     [(exn-value) (generate-temporaries '(exn-value))])
         (syntax/loc* loc
           (lambda (exn-value)
             (let ([e (exn:fail:javascript:runtime-value exn-value)])
               s))))]))

  ;; TODO: test loops
  (define (compile-loop stmt break-id continue-id)
    (match stmt
      [($ DoWhileStatement loc body test)
       (with-syntax ([body-s (compile-statement body)]
                     [test-e (parameterize ([current-labels '()])
                               (compile-expression test))]
                     [break break-id]
                     [continue continue-id])
         (syntax/loc* loc
           (let/ec break
             (let loop ()
               (let/ec continue body-s)
               (if (true-value? (deref test-e))
                   (loop)
                   (previous-completion))))))]
      [($ WhileStatement loc test body)
       (with-syntax ([test-e (parameterize ([current-labels '()])
                               (compile-expression test))]
                     [body-s (compile-statement body)]
                     [break break-id]
                     [continue continue-id])
         (syntax/loc* loc
           (let/ec break
             (let loop ()
               (if (true-value? (deref test-e))
                   (begin (let/ec continue body-s)
                          (loop))
                   (previous-completion))))))]
      [($ ForStatement loc init test incr body)
       (with-syntax ([init-e (if init
                                 (parameterize ([current-labels '()])
                                   (compile-expression init))
                                 #'(void))]
                     [test-e (if test
                                 (parameterize ([current-labels '()])
                                   (compile-expression test))
                                 #'(quote true))]
                     [incr-e (if incr
                                 (parameterize ([current-labels '()])
                                   (compile-expression incr))
                                 #'(void))]
                     [body-s (compile-statement body)]
                     [break break-id]
                     [continue continue-id]
                     [(loop) (generate-temporaries '(loop))])
         (syntax/loc* loc
           (begin
             (deref init-e)
             (let/ec break
               (let loop ()
                 (if (true-value? (deref test-e))
                     (begin (let/ec continue body-s)
                            (deref incr-e)
                            (loop))
                     (previous-completion)))))))]
      [($ ForInStatement loc lhs container body)
       (with-syntax ([stxloc (region->syntax (Term-location lhs))]
                     [container-e (parameterize ([current-labels '()])
                                    (compile-expression container))]
                     [lhs-e (parameterize ([current-labels '()])
                              (compile-expression lhs))]
                     [body-s (compile-statement body)]
                     [break break-id]
                     [continue continue-id]
                     [(object next-key key ref) (generate-temporaries '(object next-key key ref))])
         (syntax/loc* loc
           (let/ec break
             (let* ([object (deref container-e)]
                    [next-key (object-keys-stream object)])
               (let loop ()
                 (let ([key (next-key)])
                   (if key
                       (let ([ref lhs-e])
                         (unless (ref? ref)
                           (raise-assignment-error stxloc))
                         (set-ref! ref key)
                         (let/ec continue body-s)
                         (loop))
                       (previous-completion))))))))]
      ))

  (define (field-reference? x)
    (or (BracketReference? x)
        (DotReference? x)))

  ;; compile-field-reference : field-reference (syntax syntax -> syntax) -> syntax
  (define (compile-field-reference expr k)
    (match expr
      [($ BracketReference loc container key)
       (with-syntax ([container-e (compile-expression container)]
                     [key-e (compile-expression key)]
                     [(field-id container-id) (generate-temporaries '(field-id container-id))])
         (with-syntax ([body (k #'field-id #'container-id)])
           (syntax/loc* loc
             (let* ([container-id (value->object (deref container-e))]
                    [field-id (make-object-ref container-id (deref key-e))])
               body))))]
      [($ DotReference loc container id)
       (with-syntax ([container-e (compile-expression container)]
                     [key-e (Identifier->key id)])
         (with-syntax ([body (k #'field-id #'container-id)])
           (syntax/loc* loc
             (let* ([container-id (deref container-e)]
                    [field-id (make-object-ref container-id key-e)])
               body))))]))

  ;; TODO: test cases for all expression forms
  (define (compile-expression expr)
    (match expr
      [($ StringLiteral loc value)
       (build-syntax value loc)]
      [($ NumericLiteral loc value)
       (build-syntax value loc)]
      [($ BooleanLiteral loc value)
       (if value
           (syntax/loc* loc 'true)
           (syntax/loc* loc 'false))]
      [($ NullLiteral loc)
       (syntax/loc* loc '())]
      [($ RegexpLiteral loc pattern global? case-insensitive?)
       (begin (printf "expression not compiled: ~v~n" expr)
              #'"<<regular expression>>")]
      [($ ArrayLiteral loc elts)
       (with-syntax ([(e ...) (map compile-expression elts)])
         (syntax/loc* loc
           (build-array (evector (deref e) ...))))]
      [($ ObjectLiteral loc properties)
       (let ([names (map (lambda (prop)
                           (let ([name (car prop)])
                             (cond
                               [(NumericLiteral? name) (NumericLiteral-value name)]
                               [(StringLiteral? name) (StringLiteral-value name)]
                               [(Identifier? name) (Identifier->key name)])))
                         properties)]
             [values (map cdr properties)])
         (with-syntax ([(key ...) names]
                       [(e ...) (map compile-expression values)])
           (syntax/loc* loc
             (build-object
              (object-table [key (deref e)] ...)))))]
      [($ ThisReference loc)
       (syntax/loc* loc
         (deref (current-this)))]
      ;; TODO: binding forms should still introduce binding arrows under with
      ;;  - add name to static environment
      ;;  - compile ref to (if #f x (dynamic-lookup 'x))
      [($ VarReference loc id)
       ;(fprintf (current-error-port) "env: ~v, looking for ~v~n" (static-environment) id)
       (cond
         [(and (not (current-with-statement))
               (not (s:assoc id (static-environment) Identifier=?)))
          (with-syntax ([stxloc (region->syntax loc)]
                        [key (Identifier->key id)])
            (syntax/loc* loc
              (make-unknown-ref key (lambda ()
                                      (raise-reference-error stxloc key)))))]
         [(current-with-statement)
          (with-syntax ([scope-chain scope-chain]
                        [key (Identifier->key id)])
            (syntax/loc* loc
              (make-scope-chain-ref scope-chain key (lambda ()
                                                      (raise-reference-error stxloc key)))))]
         [else
          (Identifier->syntax id)])]
      [(? field-reference?)
       (compile-field-reference expr
         (lambda (field-id container-id)
           (with-syntax ([x field-id])
             (syntax/loc* (Term-location expr) x))))]
      [($ NewExpression loc constructor args)
       (with-syntax ([stxloc (region->syntax loc)]
                     [constructor-e (compile-expression constructor)]
                     [(e ...) (map compile-expression args)]
                     [(ctor) (generate-temporaries '(ctor))])
         (syntax/loc* loc
           (let ([ctor (deref constructor-e)])
             (unless (object? ctor)
               (raise-runtime-type-error stxloc "constructor" ctor))
             ((object-construct ctor) (evector (deref e) ...)))))]
      [($ PostfixExpression loc operand op)
       (with-syntax ([op-e (if (eq? op '++) #'js:+ #'js:-)]
                     [operand-e (compile-expression operand)]
                     [(operand-ref v) (generate-temporaries '(operand-ref v))])
         (syntax/loc* loc
           (let* ([operand-ref operand-e]
                  [v (value->number (deref operand-ref))])
             (set-ref! operand-ref (op-e v 1))
             v)))]
      [($ PrefixExpression loc op operand)
       (cond
         [(memq op '(++ --))
          (let ([op (if (eq? op '++) '+= '-=)])
            (compile-expression
             (make-AssignmentExpression loc operand op (make-NumericLiteral loc 1))))]
         [(eq? op 'delete)
          (with-syntax ([operand-e (compile-expression operand)])
            (syntax/loc* loc
              (js:delete operand-e)))]
         [else
          (with-syntax ([op-e (operator->syntax op)]
                        [operand-e (compile-expression operand)])
            (syntax/loc* loc
              (op-e (deref operand-e))))])]
      [($ InfixExpression loc left '&& right)
       (with-syntax ([left-e (compile-expression left)]
                     [right-e (compile-expression right)])
         (syntax/loc* loc
           (if (true-value? (deref left-e)) (deref right-e) 'false)))]
      [($ InfixExpression loc left '\|\| right)
       (with-syntax ([left-e (compile-expression left)]
                     [right-e (compile-expression right)]
                     [(tmp) (generate-temporaries '(tmp))])
         (syntax/loc* loc
           (let ([tmp (deref left-e)])
             (if (true-value? tmp) tmp (deref right-e)))))]
      [($ InfixExpression loc left op right)
       (with-syntax ([left-e (compile-expression left)]
                     [op-e (operator->syntax op)]
                     [right-e (compile-expression right)])
         (syntax/loc* loc
           (op-e (deref left-e) (deref right-e))))]
      [($ ConditionalExpression loc test consequent alternate)
       (with-syntax ([test-e (compile-expression test)]
                     [consequent-e (compile-expression consequent)]
                     [alternate-e (compile-expression alternate)])
         (syntax/loc* loc
           (if (deref test-e) (deref consequent-e) (deref alternate-e))))]
      [($ AssignmentExpression loc left '= right)
       (with-syntax ([stxloc (region->syntax (Term-location left))]
                     [left-e (compile-expression left)]
                     [right-e (compile-expression right)]
                     [(ref) (generate-temporaries '(ref))])
         (syntax/loc* loc
           (let ([ref left-e])
             (unless (ref? ref)
               ;; TODO: use (Term-location left) for source location
               (raise-assignment-error stxloc))
             (set-ref! ref (deref right-e)))))]
      [($ AssignmentExpression loc left op right)
       (compile-expression
        (make-AssignmentExpression loc
                                   left
                                   '=
                                   (make-InfixExpression (Term-location right)
                                                         left
                                                         (assignment-operator->infix-operator op)
                                                         right)))]
      [($ FunctionExpression/hoisted loc name args body funs vars)
       (compile-function loc name args body funs vars)]
      ;; TODO: use compile-declarations for funs & vars?
      #;[($ LetExpression/hoisted loc bindings body funs vars)
       (let ([bound-vars (map VariableDeclaration-id bindings)]
             [init-stxs (map (lambda (binding)
                               (cond
                                 [(VariableDeclaration-init binding) => compile-expression]
                                 [else #'(void)]))
                             bindings)])
         (bind loc bound-vars init-stxs
           (lambda (bound-var-stx-ids)
             (let* ([fun-ids (map FunctionDeclaration-name funs)]
                    [inner-ids (append fun-ids vars)])
               (with-syntax ([bind-s (bind loc inner-ids (map (lambda (id) #f) inner-ids)
                                       (lambda (inner-stx-ids)
                                         (with-syntax ([(f ...) (map Identifier->syntax fun-ids)]
                                                       [(fe ...) (map compile-function-declaration funs)]
                                                       [body-s (compile-statement body)])
                                           (syntax/loc* loc
                                             (begin
                                               (set-ref! f fe) ...
                                               body-s
                                               (completion->value (previous-completion)))))))])
                 (syntax/loc* loc
                   (with-completion-context bind-s)))))))]
      ;; TODO: inherit environment if definitely a call to `eval' (10.2.2)
      [($ CallExpression loc (and method (? field-reference?)) args)
       (compile-field-reference method
         (lambda (field-id container-id)
           (with-syntax ([stxloc (region->syntax loc)]
                         [field-id field-id]
                         [container-id container-id]
                         [(e ...) (map compile-expression args)]
                         [(f x ...) (generate-temporaries (cons 'f (map (lambda (x) 'x) args)))])
             (syntax/loc* loc
               (let ([f (deref field-id)]
                     [x (deref e)] ...)
                 (parameterize ([current-this container-id])
                   (call f
                         (evector x ...)
                         (lambda (str1 str2)
                           (raise-runtime-type-error stxloc str1 str2)))))))))]
      [($ CallExpression loc function args)
       (with-syntax ([stxloc (region->syntax loc)]
                     [function-e (compile-expression function)]
                     [(e ...) (map compile-expression args)]
                     [(f x ...) (generate-temporaries (cons 'f (map (lambda (x) 'x) args)))])
         (syntax/loc* loc
           (let ([f (deref function-e)]
                 [x (deref e)] ...)
             (parameterize ([current-this global-object])
               (call f
                     (evector x ...)
                     (lambda (str1 str2)
                       (raise-runtime-type-error stxloc str1 str2)))))))]
      [($ ParenExpression loc expr)
       (compile-expression expr)]
      [($ ListExpression loc ())
       #'(void)]
      [($ ListExpression loc exprs)
       (with-syntax ([(e ...) (map compile-expression exprs)])
         (syntax/loc* loc
           (begin (deref e) ...)))]
      ))

  (provide compile-script compile-interaction with-syntax-errors))