(module lexical-context mzscheme
  (require (planet "evector.scm" ("soegaard" "evector.plt" 1 0))
           (lib "etc.ss")
           "../syntax/ast.ss"
           "../runtime/runtime.ss"
           "helpers.ss")

  ;; static-environment : (parameterof (alistof Identifier (optional arguments-alias)))
  (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))

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

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

  (define-struct arguments-alias (vector-id offset) #f)

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

  ;; make-bindings : (listof symbol) * [(optional region) * (optional (listof arguments-alias))]
  (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))]
             [extend (lambda (env)
                       (extend-static-env ids static-bindings env))])
        (values stx-ids
                (cond
                  [(and (current-with-statement) aliases)
                   (lambda (body)
                     (with-syntax ([scope-chain scope-chain]
                                   [(v ...) stx-ids]
                                   [(vec ...) (map arguments-alias-vector-id aliases)]
                                   [(i ...) (map arguments-alias-offset aliases)]
                                   [body body])
                       (syntax/loc (region->syntax loc)
                         (let ([scope-chain (cons (make-frame (arguments-frame-table [v vec i] ...)) scope-chain)])
                           body))))]
                  [(current-with-statement)
                   (lambda (body)
                     (with-syntax ([scope-chain scope-chain]
                                   [(v ...) stx-ids]
                                   [(key ...) (map (compose symbol->string syntax-object->datum) stx-ids)]
                                   [body body])
                       (syntax/loc (region->syntax loc)
                         (let ([scope-chain (cons (make-frame (object-table [v (void)] ...)) scope-chain)])
                           body))))]
                  [aliases
                   (lambda (body)
                     (with-syntax ([(v ...) stx-ids]
                                   [(vec ...) (map arguments-alias-vector-id aliases)]
                                   [(i ...) (map arguments-alias-offset aliases)]
                                   [body body])
                       (syntax/loc (region->syntax loc)
                         (let-syntax ([v (syntax-id-rules (set!)
                                           [(set! v expr) (evector-set! vec i expr)]
                                           [v (evector-ref vec i)])]
                                      ...)
                           body))))]
                  [else
                   (lambda (body)
                     (with-syntax ([(v ...) stx-ids]
                                   [body body])
                       (syntax/loc (region->syntax loc)
                         (let ([v (void)] ...)
                           body))))])
                extend))))

  (provide (all-defined)))