(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"
           "../debug.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 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 ([(defn ...) definitions]
                    [scope-chain scope-chain]
                    [(s ...) (parameterize ([static-environment new-env])
                               (map compile-statement stmts))])
        #'(parameterize ([current-completion #f])
            (define scope-chain null)
            defn ... s ...
            (current-completion)))))

  ;; 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 ([(defn ...) definitions]
                    [scope-chain scope-chain]
                    [(s ...) (parameterize ([static-environment new-env])
                               (map compile-statement stmts))]
                    [(previous-completion) (generate-temporaries '(previous-completion))])
        (static-environment new-env)
        #'(begin
            (define previous-completion (current-completion))
            (current-completion #f)
            (define scope-chain null)
            defn ... s ...
            (begin0
              (cond
                [(current-completion)
                 => (lambda (v)
                      (set-ref! (make-object-ref global-object "it") v)
                      v)]
                [else #f])
              (current-completion previous-completion))))))

  ;; compile-declarations : boolean (listof FunctionDeclaration/hoisted) (listof Identifier)
  ;;                     -> (listof 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))]
           [definitions (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))])
                          (syntax->list #'((define var (make-object-ref global-object var-key)) ...
                                           (set-ref! var (deref init-e)) ...)))])
;        (for-each (lambda (defn)
;                    (fprintf (current-error-port) "defining: ~a~n" (syntax-object->datum defn)))
;                  definitions)
        (values definitions new-env)))

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

  ;; make-bindings : (listof (union Identifier symbol)) * [(optional region) * (optional (listof syntax))]
  ;;              -> (listof syntax)
  ;;                 (syntax -> syntax)
  ;;                 (env -> env)
  (define make-bindings
    (opt-lambda (names [loc #f] [aliases #f])
      (let* ([ids (map (lambda (name)
                         (if (symbol? name)
                             (make-Identifier loc name)
                             name))
                       names)]
             [stx-ids (map Identifier->syntax ids)]
             [static-bindings (or aliases (map (lambda (_) #f) stx-ids))]
             [generated-bindings (or aliases (generate-bindings stx-ids))]
             [extend (lambda (env)
                       (extend-static-env ids static-bindings env))])
        (with-syntax ([(v ...) stx-ids]
                      [(r ...) generated-bindings])
          (values stx-ids
                  (if (current-with-statement)
                      (lambda (body)
                        (with-syntax ([scope-chain scope-chain]
                                      [body body])
                          (syntax/loc (region->syntax loc)
                            (let ([scope-chain (cons (make-frame (object-table [v (void)] ...)) scope-chain)])
                              (let ([v r] ...)
                                body)))))
                      (lambda (body)
                        (with-syntax ([body body])
                          (syntax/loc (region->syntax loc)
                            (let ([v r] ...)
                              body)))))
                  extend)))))

  ;; extend-static-env : (listof Identifier) * (listof (optional syntax)) * env -> env
  (define (extend-static-env ids refs env)
    (append (map cons ids refs) env))

  ;; generate-bindings : (listof syntax-identifier) -> (listof syntax)
  (define (generate-bindings ids)
    (map (if (current-with-statement)
             (lambda (id)
               (with-syntax ([scope-chain scope-chain]
                             [key (symbol->string (syntax-object->datum id))])
                 #'(make-scope-chain-ref scope-chain
                                         key
                                         (lambda ()
                                           ;; TODO: is `id' an illegal cross-phase reference?
                                           (raise-reference-error id key)))))
             (lambda (id)
               #'(make-lexical-ref)))
         ids))

  (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)
    (with-syntax ([(i ...) (iota (length args))]
                  [(r ...) (generate-temporaries (map Identifier-name args))]
                  [arity (length args)])
      (let-values ([(arg-stx-ids add-args bind-args) (make-bindings args loc (syntax->list #'(r ...)))]
                   [(fun-stx-ids add-funs bind-funs) (make-bindings (map FunctionDeclaration-name funs) loc)]
                   [(var-stx-ids add-vars bind-vars) (make-bindings vars loc)]
                   [(unh-stx-ids add-unhs bind-unhs) (make-bindings '(arguments return) loc)]
                   [(name-stx-id add-name bind-name) (make-bindings (if name (list name) null) loc)])
        (let ([new-static-env (bind-name (bind-args (bind-funs (bind-vars (static-environment)))))])
          (with-syntax ([(g ...) fun-stx-ids]
                        [(arguments return) unh-stx-ids]
                        [(func-object arg-vec args-object) (generate-temporaries '(func-object arg-vec args-object))]
                        [(ge ...) (parameterize ([static-environment new-static-env])
                                    (map compile-function-declaration funs))]
                        [(s ...) (parameterize ([enable-return? #t]
                                                [static-environment (bind-unhs new-static-env)])
                                   (map compile-statement body))])
            (with-syntax ([body (quasisyntax/loc (region->syntax loc)
                                  (lambda (arg-vec)
                                    (let ([args-object (make-arguments-object func-object arg-vec)]
                                          [r (make-array-ref arg-vec i)]
                                          ...)
                                      #,(add-args
                                         (add-unhs
                                          (add-funs
                                           (add-vars
                                            (syntax/loc (region->syntax loc)
                                              (begin
                                                (set-ref! arguments args-object)
                                                (set-ref! g ge) ...
                                                (parameterize ([current-completion #f])
                                                  (let/ec return
                                                    s ...
                                                    (void))))))))))))])
              (if name
                  (with-syntax ([(f) name-stx-id])
                    (add-name
                     (syntax/loc (region->syntax loc)
                       (letrec ([func-object (build-function arity body)])
                         (set-ref! f func-object)
                         func-object))))
                  (syntax/loc (region->syntax loc)
                    (letrec ([func-object (build-function arity body)])
                      func-object)))))))))

  (define (compile-statement stmt)
    (match stmt
      [($ BlockStatement/hoisted loc stmts funs vars)
       (let-values ([(var-stx-ids add-args bind-args) (make-bindings vars loc)]
                    [(fun-stx-ids add-funs bind-funs) (make-bindings (map FunctionDeclaration-name funs) loc)])
         (let ([new-static-env (bind-args (bind-funs (static-environment)))])
           (with-syntax ([(f ...) fun-stx-ids]
                         [(fe ...) (parameterize ([static-environment new-static-env])
                                     (map compile-function-declaration funs))]
                         [(s ...) (parameterize ([static-environment new-static-env])
                                    (map compile-statement stmts))])
             (add-args
              (add-funs
               (syntax/loc (region->syntax loc)
                 (begin
                   (set-ref! f fe) ...
                   s ...
                   (current-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 (current-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 (current-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))))]
      [($ LetStatement loc bindings body)
       #'(raise-syntax-error 'let "not yet implemented, sorry!")]
;       (let ([bound-vars (map VariableInitializer-id bindings)]
;             [init-stxs (map (lambda (binding)
;                               (cond
;                                 [(VariableInitializer-init binding) => compile-expression]
;                                 [else #'(void)]))
;                             bindings)])
;         (bind loc bound-vars init-stxs
;           (lambda (bound-var-stx-ids)
;             (with-syntax ([body-e (compile-statement body)])
;               (syntax/loc* loc body-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 ...)
                       ...
                       (current-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))
                          (current-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)
                   (current-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))
                   (current-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))
                     (current-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))
                       (current-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)
       (print-struct #t)
       (debug 'scope-resolution "looking for ~a in ~v" (Identifier-name id) (static-environment))
       (cond
         [(and (not (current-with-statement))
               (not (s:assoc id (static-environment) Identifier=?)))
          (debug 'unbound-reference "~a unbound at ~a" (Identifier-name id) (region->string loc))
          (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)]
      [($ LetExpression loc bindings body)
       #'(raise-syntax-error 'let "not yet implemented, sorry!")]
;       (let ([bound-vars (map VariableInitializer-id bindings)]
;             [init-stxs (map (lambda (binding)
;                               (cond
;                                 [(VariableInitializer-init binding) => compile-expression]
;                                 [else #'(void)]))
;                             bindings)])
;         (bind loc bound-vars init-stxs
;           (lambda (bound-var-stx-ids)
;             (with-syntax ([body-e (compile-expression body)])
;               (syntax/loc* loc body-e)))))]
      ;; 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))