#lang racket/base
(require "../common/promise.rkt"
         "../common/performance.rkt"
         "../common/parameter-like.rkt"
         "../namespace/namespace.rkt"
         "../namespace/module.rkt"
         "../namespace/inspector.rkt"
         "../common/phase.rkt"
         "../compile/module-use.rkt"
         "../compile/reserved-symbol.rkt"
         "../common/module-path.rkt"
         "../compile/serialize.rkt"
         "../host/linklet.rkt"
         "../compile/linklet.rkt"
         "../compile/instance.rkt"
         "../compile/compiled-in-memory.rkt"
         "../compile/correlated-linklet.rkt"
         "../expand/context.rkt"
         "../expand/portal-syntax.rkt"
         "../expand/root-expand-context.rkt"
         "root-context.rkt"
         "protect.rkt"
         "module-cache.rkt")

;; Run a representation of top-level code as produced by `compile-module`;
;; see "compile/main.rkt" and "compile/module.rkt"

(provide eval-module
         compiled-module->declaration-instance
         compiled-module->h+declaration-instance
         compiled-module->h
         current-module-declare-as-predefined)

;; Modules that are defined via `embedded-load` can be "predefined",
;; because they can be defined in every place as the embedded load
;; is replayed in each place
(define current-module-declare-as-predefined (make-parameter #f #f 'current-module-declare-as-predefined))

(define (eval-module c
                     #:namespace [ns (current-namespace)]
                     #:with-submodules? [with-submodules? #t]
                     #:supermodule-name [supermodule-name #f]) ; for submodules declared with module
  (performance-region
   ['eval 'module]

   (define-values (dh h data-instance declaration-instance)
     (compiled-module->dh+h+data-instance+declaration-instance c))

   (define syntax-literals-data-instance
     (if (compiled-in-memory? c)
         (make-syntax-literal-data-instance-from-compiled-in-memory c)
         (let ([l (hash-ref h 'stx-data #f)])
           (cond
            [l (instantiate-linklet (eval-linklet* l)
                                    (list deserialize-instance
                                          data-instance))]
            [(eq? (hash-ref h 'module->namespace #f) 'empty)
             empty-syntax-literals-instance/empty-namespace]
            [else
             empty-syntax-literals-data-instance]))))
   
   (define (decl key)
     (instance-variable-value declaration-instance key))
   
   (define pre-submodule-names (hash-ref h 'pre null))
   (define post-submodule-names (hash-ref h 'post null))
   (define default-name (hash-ref h 'name 'module))
   
   (define cache-key (make-module-cache-key
                      (and
                       ;; We expect a hash code only for a module
                       ;; loaded independently from its submodules:
                       (null? pre-submodule-names)
                       (null? post-submodule-names)
                       (hash-ref h 'hash-code #f))))

   (define cross-phase-persistent? (hash-ref h 'cross-phase-persistent? #f))
   (define min-phase (hash-ref h 'min-phase 0))
   (define max-phase (hash-ref h 'max-phase 0))
   (define language-info (hash-ref h 'language-info #f))
   (define realm (hash-ref h 'realm 'racket))

   ;; Evaluate linklets, so that they're JITted just once (on demand).
   ;; Also, filter the bundle hash to just the phase-specific linklets, so that
   ;; we don't retain other info --- especially the syntax-literals linklet.
   (define phases-h (for*/hash ([phase-level (in-range min-phase (add1 max-phase))]
                                [v (in-value (hash-ref h phase-level #f))]
                                #:when v)
                      (values phase-level (eval-linklet* v))))
   (define syntax-literals-linklet (let ([l (hash-ref h 'stx #f)])
                                     (and l (eval-linklet* l))))

   (define extra-inspector (and (compiled-in-memory? c)
                                (compiled-in-memory-compile-time-inspector c)))
   (define phase-to-link-extra-inspectorsss
     (if (compiled-in-memory? c)
         (compiled-in-memory-phase-to-link-extra-inspectorsss c)
         #hasheqv()))

   (define requires (decl 'requires))
   (define recur-requires (decl 'recur-requires))
   (define provides (decl 'provides))
   (define original-self (decl 'self-mpi))
   (define phase-to-link-modules (decl 'phase-to-link-modules))
   (define portal-stxes (decl 'portal-stxes))

   (define create-root-expand-context-from-module ; might be used to create root-expand-context
     (make-create-root-expand-context-from-module requires phases-h))
   
   (define declare-submodules
     ;; If there's no `dh`, then it's important not to retain a reference to
     ;; `c`, which could cause the serialized form of syntax objects to
     ;; be retained after deserialization and reachable from the module cache;
     ;; if it's there's a `dh`, though, then we won't be in the module cache
     (if dh
         ;; Callback to declare submodules:
         (lambda (ns names declare-name pre?)
           (if (compiled-in-memory? c)
               (for ([c (in-list (if pre?
                                     (compiled-in-memory-pre-compiled-in-memorys c)
                                     (compiled-in-memory-post-compiled-in-memorys c)))])
                 (eval-module c #:namespace ns #:supermodule-name declare-name))
               (for ([name (in-list names)])
                 (define sm-cd (hash-ref dh name #f))
                 (unless sm-cd (error "missing submodule declaration:" name))
                 (eval-module sm-cd #:namespace ns #:supermodule-name declare-name))))
         ;; Dummy callback to avoid retaining anything:
         void))

   ;; At this point, we've prepared everything anout the module that we
   ;; can while staying independent of a specific declaration or
   ;; specific instance. If we have a hash key for this module, we can
   ;; stash `declare-this-module` for potential reuse later.
   (define declare-this-module
     (lambda (ns) ; namespace for declaration
       (define m (make-module #:source-name (current-module-declare-source)
                              #:self original-self
                              #:requires requires
                              #:recur-requires recur-requires
                              #:provides provides
                              #:language-info language-info
                              #:realm realm
                              #:min-phase-level min-phase
                              #:max-phase-level max-phase
                              #:cross-phase-persistent? cross-phase-persistent?
                              #:predefined? (current-module-declare-as-predefined)
                              #:submodule-names (append pre-submodule-names post-submodule-names)
                              #:supermodule-name supermodule-name
                              #:get-all-variables (lambda () (get-all-variables phases-h))
                              #:phase-level-linklet-info-callback
                              (lambda (phase-level ns insp)
                                (module-linklet-info (hash-ref phases-h phase-level #f)
                                                     (hash-ref phase-to-link-modules phase-level #f)
                                                     original-self
                                                     insp
                                                     extra-inspector
                                                     (hash-ref phase-to-link-extra-inspectorsss phase-level #f)))
                              #:force-bulk-binding-callback
                              (lambda (bulk-binding-registry)
                                ;; Avoids a leak of some namespace's bulk-binding registry into the
                                ;; deserialized syntax of the module, but module caching can still allow
                                ;; a namespace's bulk-binding registry to get saved by the module's
                                ;; deserialized syntax.
                                (force-syntax-deserialize syntax-literals-data-instance bulk-binding-registry))
                              #:prepare-instance-callback
                              (lambda (data-box ns phase-shift self bulk-binding-registry insp)
                                (unless (unbox data-box)
                                  (init-instance-data! data-box cache-key ns
                                                       syntax-literals-linklet data-instance syntax-literals-data-instance
                                                       phase-shift original-self self bulk-binding-registry insp
                                                       create-root-expand-context-from-module)))
                              #:get-portal-syntax-callback
                              (lambda (data-box phase sym)
                                (define ht (hash-ref portal-stxes phase #hasheq()))
                                (define pos (hash-ref ht sym #f))
                                (cond
                                  [pos
                                   (define syntax-literals-instance (instance-data-syntax-literals-instance
                                                                     (unbox data-box)))
                                   ((instance-variable-value syntax-literals-instance get-syntax-literal!-id) pos)]
                                  [else #f]))
                              #:instantiate-phase-callback
                              (lambda (data-box ns phase-shift phase-level self bulk-binding-registry insp)
                                (performance-region
                                 ['eval 'instantiate]
                                 (define syntax-literals-instance (instance-data-syntax-literals-instance
                                                                   (unbox data-box)))

                                 ;; create portal-syntax bindings
                                 (define phase-portal-stxes (hash-ref portal-stxes (sub1 phase-level) #hasheq()))
                                 (unless (zero? (hash-count phase-portal-stxes))
                                   (define get-syntax-literal! (instance-variable-value syntax-literals-instance get-syntax-literal!-id))
                                   (for ([(key pos) (in-hash phase-portal-stxes)])
                                     (when (symbol? key)
                                       (define portal-stx (get-syntax-literal! pos))
                                       (namespace-set-transformer! ns (sub1 phase-level) key (portal-syntax portal-stx)))))
                                 
                                 (define phase-linklet (hash-ref phases-h phase-level #f))                                 
                                 (when phase-linklet
                                   (define module-uses (hash-ref phase-to-link-modules phase-level))
                                   (define-values (import-module-instances import-instances)
                                     (for/lists (mis is) ([mu (in-list module-uses)])
                                       (namespace-module-use->module+linklet-instances
                                        ns mu
                                        #:shift-from original-self
                                        #:shift-to self
                                        #:phase-shift
                                        (phase+ (phase- phase-level (module-use-phase mu))
                                                phase-shift))))

                                   (check-require-access phase-linklet #:skip-imports 2
                                                         module-uses import-module-instances insp
                                                         extra-inspector
                                                         (hash-ref phase-to-link-extra-inspectorsss phase-level #f))

                                   (define module-body-instance-instance
                                     (make-module-body-instance-instance
                                      #:set-transformer! (cond
                                                          [(zero-phase? phase-level)
                                                           (lambda (name val)
                                                             (error 'define-syntax "should not happen at phase level 0"))]
                                                          [else
                                                           (lambda (name val)
                                                             (namespace-set-transformer! ns (sub1 phase-level) name val))])))

                                   (define (instantiate-body)
                                     (instantiate-linklet phase-linklet
                                                          (list* syntax-literals-instance
                                                                 module-body-instance-instance
                                                                 import-instances)
                                                          (namespace->instance ns phase-level)))

                                   (cond
                                    [(zero-phase? phase-level)
                                     (cond
                                      [(zero-phase? phase-shift)
                                       (instantiate-body)]
                                      [else
                                       ;; Need to set the current namespace so that it has the
                                       ;; right phase
                                       (parameterize ([current-namespace ns])
                                         (instantiate-body))])]
                                    [else
                                     ;; For phase level 1 and up, set the expansion context
                                     ;; to point back to the module's info:
                                     (define ns-1 (namespace->namespace-at-phase ns (phase+ phase-shift (sub1 phase-level))))
                                     (parameterize ([current-namespace ns])
                                       (parameterize-like
                                        #:with ([current-expand-context (delay (make-expand-context
                                                                                ns-1
                                                                                ;; Turn off on-demand instantiation, because
                                                                                ;; we're already trying to instantiate modules,
                                                                                ;; and anything that should be relevant by being
                                                                                ;; imported here should be instantiated already:
                                                                                #:skip-visit-available? #t))]
                                                [current-module-code-inspector insp])
                                        (instantiate-body)))]))))))

       (define declare-name (substitute-module-declare-name default-name))
       
       (when with-submodules?
         (declare-submodules ns pre-submodule-names declare-name #t))

       (declare-module! ns
                        m
                        declare-name
                        #:with-submodules? with-submodules?)

       (when with-submodules?
         (declare-submodules ns post-submodule-names declare-name #f))))
   
   ;; ----------------------------------------
   
   ;; If we have a hash code, save the prepare module in the cache
   ;; so it can be found by that hash code:
   (when cache-key
     (module-cache-set! cache-key declare-this-module))
   
   (declare-this-module ns)))

;; ----------------------------------------

;; Value in a declaration's `data-box`:
(struct instance-data (syntax-literals-instance cache-key))

(define (init-instance-data! data-box cache-key ns
                             syntax-literals-linklet data-instance syntax-literals-data-instance
                             phase-shift original-self self bulk-binding-registry insp
                             create-root-expand-context-from-module)
  (when (not (load-on-demand-enabled))
    (force-syntax-deserialize syntax-literals-data-instance bulk-binding-registry))
  
  (define inst
    (make-instance-instance
     #:namespace ns
     #:phase-shift phase-shift
     #:self self 
     #:inspector insp
     #:bulk-binding-registry bulk-binding-registry
     #:set-transformer! (lambda (name val) (error "shouldn't get here for the root-ctx linklet"))))
  
  (define syntax-literals-instance
    (if syntax-literals-linklet
        (instantiate-linklet syntax-literals-linklet
                             (list deserialize-instance
                                   data-instance
                                   syntax-literals-data-instance
                                   inst))
        empty-syntax-literals-instance))

  (set-box! data-box (instance-data syntax-literals-instance cache-key))
  
  (define get-encoded-root-expand-ctx
    (instance-variable-value syntax-literals-instance 'get-encoded-root-expand-ctx))
  
  (cond
   [(eq? get-encoded-root-expand-ctx 'empty)
    ;; A `#:empty-namespace` declaration requested a namespace with no initial bindings
    (namespace-set-root-expand-ctx! ns (delay (shift-to-inside-root-context
                                               (make-root-expand-context #:self-mpi self))))]
   [(procedure? get-encoded-root-expand-ctx)
    ;; Root expand context has been preserved; deserialize it on demand
    (namespace-set-root-expand-ctx! ns (delay (shift-to-inside-root-context
                                               (root-expand-context-decode-for-module
                                                (get-encoded-root-expand-ctx)
                                                self))))]
   [else
    ;; Root expand context has not been preserved, because it can be reconstructed
    ;; from module metadata; do that on demand
    (namespace-set-root-expand-ctx! ns (delay (shift-to-inside-root-context
                                               (create-root-expand-context-from-module
                                                ns phase-shift original-self self))))]))

;; ----------------------------------------

(define (force-syntax-deserialize syntax-literals-data-instance bulk-binding-registry)
  (unless (or (eq? syntax-literals-data-instance empty-syntax-literals-data-instance)
              (eq? syntax-literals-data-instance empty-syntax-literals-instance/empty-namespace))
    ;; Since on-demand loading is disabled, force deserialization
    (let ([deserialize-syntax (instance-variable-value syntax-literals-data-instance deserialize-syntax-id)])
      ;; We need to make sure there's something to deserialize; if it's already done
      ;; `deserialize-syntax` has been set to #f
      (when deserialize-syntax
        (deserialize-syntax bulk-binding-registry)))))

;; ----------------------------------------

;; Returns:
;;
;;   dh - hash from linklet directory to access submodules, or #f if
;;   no submodules
;;
;;   h - hash from the module's linklet bundle
;;
(define (compiled-module->dh+h c)
  (define ld/h (if (compiled-in-memory? c)
                   (compiled-in-memory-linklet-directory c)
                   c))
  (define dh (cond
              [(linklet-directory? ld/h)
               ;; has submodules
               (linklet-directory->hash ld/h)]
              [else
               ;; no submodules
               #f]))
  (define h (linklet-bundle->hash (if dh
                                      (hash-ref dh #f)
                                      ld/h)))
  
  (values dh h))

(define (compiled-module->h c)
  (define-values (dh h)
    (compiled-module->dh+h c))
  h)

;; Additionally returns:
;;
;;  data-instance - provides data, either extracted from
;;  compiled-in-memory or instantiated from the bundle
;;
;;  declaration-instance - provides metadata, extracted from the
;;  bundle and linked with `data-instance`
(define (compiled-module->dh+h+data-instance+declaration-instance c)
  (define-values (dh h) (compiled-module->dh+h c))

  (define data-instance
    (if (compiled-in-memory? c)
        (make-data-instance-from-compiled-in-memory c)
        (instantiate-linklet (eval-linklet* (hash-ref h 'data))
                             (list deserialize-instance))))

  (define declaration-instance
    (if (and (compiled-in-memory? c)
             (compiled-in-memory-original-self c))
        (make-declaration-instance-from-compiled-in-memory c)
        (instantiate-linklet (eval-linklet* (hash-ref h 'decl))
                             (list deserialize-instance
                                   data-instance))))
  
  (values dh h data-instance declaration-instance))

(define (compiled-module->declaration-instance c)
  (define-values (dh h data-instance declaration-instance)
    (compiled-module->dh+h+data-instance+declaration-instance c))
  declaration-instance)

(define (compiled-module->h+declaration-instance c)
  (define-values (dh h data-instance declaration-instance)
    (compiled-module->dh+h+data-instance+declaration-instance c))
  (values h declaration-instance))

;; ----------------------------------------

(define (make-data-instance-from-compiled-in-memory cim)
  (make-instance 'data #f 'constant
                 mpi-vector-id (compiled-in-memory-mpis cim)))

(define (make-declaration-instance-from-compiled-in-memory cim)
  (make-instance 'decl #f 'constant
                 'self-mpi (compiled-in-memory-original-self cim)
                 'requires (compiled-in-memory-requires cim)
                 'recur-requires (compiled-in-memory-recur-requires cim)
                 'provides (compiled-in-memory-provides cim)
                 'phase-to-link-modules (compiled-in-memory-phase-to-link-module-uses cim)
                 'portal-stxes (compiled-in-memory-portal-stxes cim)))

(define (make-syntax-literal-data-instance-from-compiled-in-memory cim)
  (make-instance 'syntax-literal-data #f #f
                 deserialize-syntax-id void
                 deserialized-syntax-vector-id (compiled-in-memory-syntax-literals cim)))

(define empty-syntax-literals-instance/empty-namespace
  (make-instance 'empty-stx/empty-ns #f 'constant
                 get-syntax-literal!-id (lambda (pos) #f)
                 'get-encoded-root-expand-ctx 'empty))

;; ----------------------------------------

(define (get-all-variables phases-h)
  (for/hash ([(phase linklet) (in-hash phases-h)])
    (values phase
            (linklet-export-variables linklet))))

;; ----------------------------------------

(define (eval-linklet* l)
  (eval-linklet (force-compile-linklet l)))
