;;;  --------------------------------------------------------------  ;;;
;;;                                                                  ;;;
;;;                    Loaded module data structure                  ;;;
;;;                                                                  ;;;
;;;  --------------------------------------------------------------  ;;;

(define-type loaded-module
  id: 08E43248-AC39-4DA1-863E-49AFA9FFE84E
  constructor: make-loaded-module/internal

  (invoke-runtime read-only:)
  (invoke-compiletime read-only:)
  (visit read-only:)
  (info read-only:)
  (stamp read-only:)
  ;; An absolute module reference object
  (reference read-only:)
  
  (runtime-invoked init: #f)
  ;; A weak hashtable of the currently loaded loaded-module objects
  ;; that directly depend on this loaded-module
  dependent-modules)

(define (make-loaded-module #!key
                            invoke-runtime
                            invoke-compiletime
                            visit
                            info
                            stamp
                            reference)
  (if (not (and (procedure? invoke-runtime)
                (or (procedure? invoke-compiletime)
                    (not invoke-compiletime))
                (procedure? visit)
                (module-info? info)
                (module-reference? reference)))
      (error "Invalid parameters"))
  (make-loaded-module/internal invoke-runtime
                               invoke-compiletime
                               visit
                               info
                               stamp
                               reference
                               (make-table weak-keys: #t)))

(define (loaded-module-loader mod)
  (module-reference-loader (loaded-module-reference mod)))

(define (loaded-module-path mod)
  (module-reference-path (loaded-module-reference mod)))

(define (loaded-module-stamp-is-fresh? lm)
  (loader-compare-stamp (loaded-module-loader lm)
                        (module-reference-path
                         (loaded-module-reference lm))
                        (loaded-module-stamp lm)))

(define *loaded-module-registry* (make-table))

;; Loads a module, regardless of whether it's already loaded or not.
(define (module-reference-load! ref)
  (let ((previously-loaded-module
         (table-ref *loaded-module-registry* ref #f))
        (loaded-module
         (loader-load-module (module-reference-loader ref)
                             (module-reference-path ref))))

    ;; Update the relevant dependent-modules fields
    (if previously-loaded-module
        (loaded-module-dependent-modules-set!
         loaded-module
         (loaded-module-dependent-modules previously-loaded-module)))
    (let ((action
           (lambda (dependency)
             (table-set!
              (loaded-module-dependent-modules
               (module-reference-ref dependency))
              loaded-module
              #t)))
          (info (loaded-module-info loaded-module)))
      (for-each action (module-info-runtime-dependencies info))
      (for-each action (module-info-compiletime-dependencies info)))
    
    (table-set! *loaded-module-registry* ref loaded-module)
    loaded-module))

;; This function will break if invoked when macroexpanding a module
(define (loaded-module-unload! lm) ;; This function isn't used or tested
  ;; First, de-instantiate the modules that depend on this module.
  (let rec ((lm lm))
    (table-for-each (lambda (k v)
                      (rec k))
                    (loaded-module-dependent-modules lm))

    (let ((ref (loaded-module-reference lm)))
      (vector-for-each
       (lambda (phase)
         (table-set! (expansion-phase-module-instances phase)
                     ref))
       (syntactic-tower-phases *repl-syntactic-tower*))))
  
  (table-set! *loaded-module-registry*
              (loaded-module-reference lm)))

(define (module-reference-ref ref #!key compare-stamps)
  (if (not (module-reference-absolute? ref))
      (error "Module reference must be absolute"))
  (or (let ((loaded-module (table-ref *loaded-module-registry* ref #f)))
        (if compare-stamps
            (and loaded-module
                 (loaded-module-stamp-is-fresh? loaded-module)
                 loaded-module)
            loaded-module))
      (module-reference-load! ref)))

;;;; Visiting and invoking functionality

;; Invoking a module means loading everything that needs to be loaded
;; to be able to use its exported variable bindings. Before invoking a
;; module, its runtime dependencies must be invoked.
;;
;; Visiting a module means loading everything that needs to be loaded
;; to be able to perform macro expansions on macros defined in that
;; module.  Before visiting a module, its compile time dependencies
;; must be invoked, and its runtime dependencies must be visited.
;;
;; When importing a module to the REPL the module should be invoked
;; and visited.

;; A module instance object implicitly belongs to an expansion phase
;; and to a module reference, because it's stored in the expansion
;; phase object's instance table, with a module reference as the key.
;;
;; Because of this, there's no need to store pointers back to these
;; objects.
(define-type module-instance
  id: F366DFDB-6F11-47EB-9558-04BF7B31225D

  (getter init: #f)
  (setter init: #f)
  
  (macros init: #f)
  (macro-env init: #f))

(define (module-instance-ref phase ref)
  (let ((table (expansion-phase-module-instances phase)))
    (and table
         (table-ref table ref #f))))

(define (module-instance-get! phase ref)
  (or (module-instance-ref phase ref)
      (let ((instance (make-module-instance)))
        (table-set! (expansion-phase-module-instances phase)
                    ref
                    instance)
        instance)))

(define (loaded-module-invoked? lm phase)
  (if (zero? (expansion-phase-number phase))
      (loaded-module-runtime-invoked lm)
      (let ((instance (module-instance-ref
                       phase
                       (loaded-module-reference lm))))
        (and instance
             (module-instance-getter instance)
             (module-instance-setter instance)
             #t))))

(define (loaded-module-visited? lm phase)
  (let ((instance (module-instance-ref
                   phase
                   (loaded-module-reference lm))))
    (and instance
         (module-instance-macros instance)
         (module-instance-macro-env instance)
         #t)))

;; This procedure doesn't make sure that the module's dependencies are
  invoked first , nor that the modules that depend on this module
;; are reinvoked or that the dependent-modules field of the
;; relevant loaded-module objects are kept up-to-date.
;;
;; It is not intended to be used directly, it is just a utility
  function for loaded - modules - invoke /  and
;; loaded-modules-reinvoke.
(define (loaded-module-invoke! lm phase)
  (if (zero? (expansion-phase-number phase))
      (begin
        ((loaded-module-invoke-runtime lm))
        (loaded-module-runtime-invoked-set! lm #t))
      (let ((invoke-compiletime
             (loaded-module-invoke-compiletime lm)))
        (if invoke-compiletime
            (let ((getter
                   setter
                   ((loaded-module-invoke-compiletime lm)
                    lm phase))
                  (instance (module-instance-get!
                             phase
                             (loaded-module-reference lm))))
              (module-instance-getter-set! instance getter)
              (module-instance-setter-set! instance setter)))))
  ;; It doesn't make sense to return anything, because
  ;; loaded-module-invoke-runtime doesn't return anything useful.
  (void))

;; Analogous to loaded-module-invoke!
(define (loaded-module-visit! lm phase)
  (let* ((next-phase (expansion-phase-next-phase phase))
         (phase-number (expansion-phase-number phase))
         (macro-procedures (list->table
                            ((loaded-module-visit lm) lm next-phase)))
         (macros (make-table))
         
         (module-ref (loaded-module-reference lm))
         (module-info (loaded-module-info lm))
         (namespace-string (module-info-namespace-string module-info))
         
         (env (make-top-environment module-ref))
         (memo-table (make-table
                      test: eq?
                      hash: eq?-hash)))
    (letrec
        ((make-env-from-letsyntax-environment
          (lambda (parent-env ls-env)
            (cond
             ((null? ls-env)
              parent-env)
             
             ((table-ref memo-table
                         ls-env
                         #f) =>
                         (lambda (result)
                           result))
             
             (else
              (let* ((env (make-environment parent-env)))
                (table-set! memo-table
                            ls-env
                            env)

                (for-each
                    (lambda (ls-def)
                      (let ((mac-name (car ls-def))
                            (unique-name (cadr ls-def))
                            (macro-ls-env (caddr ls-def)))
                        (ns-add! env
                                 0
                                 mac-name
                                 (list 'mac
  TODO Is this right ?
                                       (make-env-from-letsyntax-environment
                                        env
                                        macro-ls-env)
                                       unique-name))))
                  ls-env)
                
                env))))))
      
      (for-each
          (lambda (def)
            (cond
             ((eq? 'def (cadr def))
              ;; Regular define
              (let ((name (car def)))
                (environment-add-def!
                 env
                 ;; The name it's imported as
                 name
                 ;; The name it's imported from
                 (gen-symbol namespace-string name)
                 phase-number: phase-number)))
             ((eq? 'mac (cadr def))
  Macro
              (let ((name (car def)))
                (environment-add-mac!
                 env
                 name
                 (table-ref macro-procedures name)
                 (make-env-from-letsyntax-environment env (caddr def))
                 phase-number: phase-number)))
             (else
              (error "Internal error in Black Hole (loaded-module.scm)"))))
        (module-info-definitions module-info)))

    (module-add-defs-to-env (module-info-imports module-info)
                            env
                            phase: phase)

    (let ((instance (module-instance-get!
                     phase
                     (loaded-module-reference lm))))
      (module-instance-macros-set! instance macro-procedures)
      (module-instance-macro-env-set! instance env))
    
    env))

;; Utility procedure
(define (invoke-dependencies info->dependencies lm invoke)
  (for-each
      (lambda (dep-ref)
        (let ((dependency
               (module-reference-ref dep-ref)))
  Recurse
          (invoke dependency)))
    (info->dependencies
     (loaded-module-info lm))))

(define (loaded-module-invoke/deps lm phase
                                   #!key
                                   ;; Table of module-reference objects to #t
                                   (memo (make-table)))
  (cond
   ((and (not (table-ref memo
                         (loaded-module-reference lm)
                         #f))
         (not (loaded-module-invoked? lm phase)))
    ;; Flag that this module is to be invoked, to avoid
    ;; double-invocations and to improve the performance of this
    ;; function.
    (table-set! memo
                (loaded-module-reference lm)
                #t)
    
    ;; Invoke the module's runtime dependencies
    (invoke-dependencies module-info-runtime-dependencies
                         lm
                         (lambda (dependency)
                           (loaded-module-invoke/deps dependency phase
                                                      memo: memo)))
    
    ;; Invoke the module
( pp ( list ' invoking ; ; TODO Remove this
              (loaded-module-reference lm)
              phase))
    (loaded-module-invoke! lm phase))))

(define (loaded-modules-invoke/deps lms phase)
  (let ((memo (make-table)))
    (for-each (lambda (lm)
                (loaded-module-invoke/deps lm phase
                                           memo: memo))
      lms)))

(define (loaded-module-visit/deps lm phase
                                  #!key
                                  ;; Table of module-reference objects to #t
                                  (invoke-memo (make-table))
                                  (visit-memo (make-table)))
  (cond
   ((and (not (table-ref visit-memo
                         (loaded-module-reference lm)
                         #f))
         (not (loaded-module-visited? lm phase)))
    ;; Flag that this module is to be invoked, to avoid
    ;; double-visitations and to improve the performance of this
    ;; function.
    (table-set! visit-memo
                (loaded-module-reference lm)
                #t)
    
    ;; Invoke the module's compile time dependencies
    (let ((next-phase (expansion-phase-next-phase phase)))
      (invoke-dependencies module-info-compiletime-dependencies
                           lm
                           (lambda (dependency)
                             (loaded-module-invoke/deps dependency
                                                        next-phase
                                                        memo: invoke-memo))))
    
    ;; Visit the module's runtime dependencies
    (invoke-dependencies module-info-runtime-dependencies
                         lm
                         (lambda (dependency)
                           (loaded-module-visit/deps dependency
                                                     phase
                                                     visit-memo: visit-memo
                                                     invoke-memo: invoke-memo)))
    
    ;; Visit the module
( pp ( list ' visiting TODO Remove this
              (loaded-module-reference lm)
              phase))
    (loaded-module-visit! lm phase))))

(define (loaded-modules-visit/deps lms phase)
  (let ((invoke-memo (make-table))
        (visit-memo (make-table)))
    (for-each (lambda (lm)
                (loaded-module-visit/deps lm phase
                                          invoke-memo: invoke-memo
                                          visit-memo: visit-memo))
      lms)))

;; Returns #t if any module was reloaded
(define (module-load module-references
                     #!key
                     (phase (*expansion-phase*))
  One of # t , # f , ' force
                     (reload? 'force))
  (define (module-loaded-but-not-fresh? ref)
    ;; This function is not a closure. It is here because
    ;; it's only used here.
    (let ((lm (table-ref *loaded-module-registry* ref #f)))
      (and lm
           (not (loaded-module-stamp-is-fresh? lm)))))

  (define (loaded-modules-reinvoke lms phase)
    (letrec
        (;; Table of module-reference objects to #t
         (invoke-table (make-table))
         (rec (lambda (lm #!optional force?)
                (cond
                 ((and (not (table-ref invoke-table
                                       (loaded-module-reference lm)
                                       #f))
                       (or force?
                           (not (loaded-module-invoked? lm phase))))
                  ;; Flag that this module is to be invoked, to
                  ;; avoid double-instantiations.
                  (table-set! invoke-table
                              (loaded-module-reference lm)
                              #t)
                  
                  ;; Re-invoke and re-visit the module
                  (loaded-module-invoke! lm phase)
                  (loaded-module-visit! lm phase)
                  
                  ;; Re-invoke the dependent modules
                  (table-for-each
                   (lambda (k v)
                     (rec k #t))
                   (loaded-module-dependent-modules lm)))))))
      (for-each rec lms)))
  
  (let ((loaded-modules '())
        (reloaded-modules '()))
    
    (for-each
        (lambda (ref)
          (if (or (eq? 'force reload?)
                  (and reload?
                       (module-loaded-but-not-fresh? ref)))
              (push! reloaded-modules
                     (module-reference-load! ref))
              (push! loaded-modules
                     (module-reference-ref ref))))
      module-references)

    (loaded-modules-reinvoke reloaded-modules phase)
    (loaded-modules-invoke/deps loaded-modules phase)
    (loaded-modules-visit/deps loaded-modules phase)
    (pair? reloaded-modules)))

(define (module-import modules env phase)
  (let loop ()
    (let ((defs
           module-references
           (resolve-imports modules)))

      (let ((a-module-was-reloaded?
             (module-load module-references
                          phase: phase
                          reload?: (repl-environment? env))))
        
        (if (not a-module-was-reloaded?)
            (module-add-defs-to-env defs env
                                    phase: phase)
            ;; We need to re-resolve the imports, because the
            ;; reloads might have caused definitions to change.
            (loop))))))

(define module-module
  (let* ((repl-environment #f)
         (fn (lambda (mod)
               (let* ((module-reference (resolve-one-module mod))
                      (loaded-module (module-reference-ref
                                      module-reference))
                      (info (loaded-module-info loaded-module)))
                 (if (repl-environment? (*top-environment*))
                     (set! repl-environment (*top-environment*)))
                 
                 (*top-environment* (make-top-environment module-reference))
                 (loaded-modules-invoke/deps
                  (list loaded-module)
                  (syntactic-tower-first-phase
                   *repl-syntactic-tower*))
                 
                 (module-add-defs-to-env (module-info-imports info)
                                         (*top-environment*))))))
    (lambda (mod)
      (if mod
          (fn mod)
          (*top-environment* repl-environment))
      (void))))



;;;; ---------- Some environment creation stuff ----------

(define (module-add-defs-to-env defs
                                env
                                #!key
                                ;; phase can be #f to apply to all phases
                                (phase
                                 (*expansion-phase*)))
  (define (macro+env-from-module-ref phase ref)
    (loaded-module-visit/deps (module-reference-ref ref) phase)
    (let* ((mi (module-instance-ref phase ref))
           (macros (and mi (module-instance-macros mi)))
           (env (and mi (module-instance-macro-env mi))))
      (values macros
              env)))
  
  (let ((phase-number (and phase (expansion-phase-number phase))))
    (for-each
        (lambda (def)
          (if (eq? 'def (cadr def))
              ;; Regular define
              (environment-add-def!
               env
               (car def) ;; The name it's imported as
               (caddr def) ;; The name it's imported from
               module-reference: (cadddr def)
               phase-number: phase-number)
  Macro
              (let ((fn (caddr def)))
                (if (symbol? fn)
                    (let ((macros
                           macros-env
                           (macro+env-from-module-ref phase (cadddr def))))
                      (if (not (and macros macros-env))
                          (error "Internal error in Black Hole (loaded-module.scm)"))
                      (environment-add-mac! env
                                            ;; The name it's imported as
                                            (car def)
                                            ;; The macro procedure
                                            (table-ref macros fn)
                                            ;; The macro's environment
                                            macros-env
                                            phase-number: phase-number))
                    (let* ((env-or-ref
                            (cadddr def))
                           (macro-env
                            (if (env? env-or-ref)
                                env-or-ref
                                (let ((mi (module-instance-ref phase env-or-ref)))
                                  (or (and mi (module-instance-macro-env mi))
                                      (error "Internal error in Black Hole (loaded-module.scm)"))))))
                      (environment-add-mac! env
                                            ;; The name it's imported as
                                            (car def)
                                            ;; The macro procedure
                                            fn
                                            ;; The macro's environment
                                            macro-env
                                            phase-number: phase-number))))))
      defs)))

(define module-env-table
  (let* ((ns (make-table))
         (env (make-environment #f ns: ns)))
    (module-add-defs-to-env module-exports-list
                            env
                            phase: #f)
    ns))


(define builtin-ns
  (let* ((builtin-pair
          (cons (env-ns builtin-environment)
                gambit-builtin-table))
         (inside-letrec-table
          (env-ns inside-letrec-environment))
         (inside-letrec-pair
          (cons inside-letrec-table
                builtin-pair)))
    (lambda ()
      (let ((ns
             (if (inside-letrec)
                 inside-letrec-pair
                 builtin-pair)))
        (values (if (or (not (zero? (expansion-phase-number
                                     (*expansion-phase*))))
                        (not (environment-module-reference
                              (*top-environment*))))
                    (cons module-env-table ns)
                    ns)
                #f)))))

(define (make-top-environment module-reference)
  (let ((ns (cons (make-table)
                  builtin-ns)))
    (make-environment module-reference ns: ns)))

(define empty-environment
  (make-top-environment #f))

(*top-environment* (make-top-environment #f))

  --------------------------------------------------------------  ;;;
                                                                  ;;;
                    Loaded module data structure                  ;;;
                                                                  ;;;
  --------------------------------------------------------------  ;;;
 An absolute module reference object
 A weak hashtable of the currently loaded loaded-module objects
 that directly depend on this loaded-module
 Loads a module, regardless of whether it's already loaded or not.
 Update the relevant dependent-modules fields
 This function will break if invoked when macroexpanding a module
 This function isn't used or tested
 First, de-instantiate the modules that depend on this module.
 Visiting and invoking functionality
 Invoking a module means loading everything that needs to be loaded
 to be able to use its exported variable bindings. Before invoking a
 module, its runtime dependencies must be invoked.

 Visiting a module means loading everything that needs to be loaded
 to be able to perform macro expansions on macros defined in that
 module.  Before visiting a module, its compile time dependencies
 must be invoked, and its runtime dependencies must be visited.

 When importing a module to the REPL the module should be invoked
 and visited.
 A module instance object implicitly belongs to an expansion phase
 and to a module reference, because it's stored in the expansion
 phase object's instance table, with a module reference as the key.

 Because of this, there's no need to store pointers back to these
 objects.
 This procedure doesn't make sure that the module's dependencies are
 are reinvoked or that the dependent-modules field of the
 relevant loaded-module objects are kept up-to-date.

 It is not intended to be used directly, it is just a utility
 loaded-modules-reinvoke.
 It doesn't make sense to return anything, because
 loaded-module-invoke-runtime doesn't return anything useful.
 Analogous to loaded-module-invoke!
 Regular define
 The name it's imported as
 The name it's imported from
 Utility procedure
 Table of module-reference objects to #t
 Flag that this module is to be invoked, to avoid
 double-invocations and to improve the performance of this
 function.
 Invoke the module's runtime dependencies
 Invoke the module
 ; TODO Remove this
 Table of module-reference objects to #t
 Flag that this module is to be invoked, to avoid
 double-visitations and to improve the performance of this
 function.
 Invoke the module's compile time dependencies
 Visit the module's runtime dependencies
 Visit the module
 Returns #t if any module was reloaded
 This function is not a closure. It is here because
 it's only used here.
 Table of module-reference objects to #t
 Flag that this module is to be invoked, to
 avoid double-instantiations.
 Re-invoke and re-visit the module
 Re-invoke the dependent modules
 We need to re-resolve the imports, because the
 reloads might have caused definitions to change.
 ---------- Some environment creation stuff ----------
 phase can be #f to apply to all phases
 Regular define
 The name it's imported as
 The name it's imported from
 The name it's imported as
 The macro procedure
 The macro's environment
 The name it's imported as
 The macro procedure
 The macro's environment

(define-type loaded-module
  id: 08E43248-AC39-4DA1-863E-49AFA9FFE84E
  constructor: make-loaded-module/internal

  (invoke-runtime read-only:)
  (invoke-compiletime read-only:)
  (visit read-only:)
  (info read-only:)
  (stamp read-only:)
  (reference read-only:)
  
  (runtime-invoked init: #f)
  dependent-modules)

(define (make-loaded-module #!key
                            invoke-runtime
                            invoke-compiletime
                            visit
                            info
                            stamp
                            reference)
  (if (not (and (procedure? invoke-runtime)
                (or (procedure? invoke-compiletime)
                    (not invoke-compiletime))
                (procedure? visit)
                (module-info? info)
                (module-reference? reference)))
      (error "Invalid parameters"))
  (make-loaded-module/internal invoke-runtime
                               invoke-compiletime
                               visit
                               info
                               stamp
                               reference
                               (make-table weak-keys: #t)))

(define (loaded-module-loader mod)
  (module-reference-loader (loaded-module-reference mod)))

(define (loaded-module-path mod)
  (module-reference-path (loaded-module-reference mod)))

(define (loaded-module-stamp-is-fresh? lm)
  (loader-compare-stamp (loaded-module-loader lm)
                        (module-reference-path
                         (loaded-module-reference lm))
                        (loaded-module-stamp lm)))

(define *loaded-module-registry* (make-table))

(define (module-reference-load! ref)
  (let ((previously-loaded-module
         (table-ref *loaded-module-registry* ref #f))
        (loaded-module
         (loader-load-module (module-reference-loader ref)
                             (module-reference-path ref))))

    (if previously-loaded-module
        (loaded-module-dependent-modules-set!
         loaded-module
         (loaded-module-dependent-modules previously-loaded-module)))
    (let ((action
           (lambda (dependency)
             (table-set!
              (loaded-module-dependent-modules
               (module-reference-ref dependency))
              loaded-module
              #t)))
          (info (loaded-module-info loaded-module)))
      (for-each action (module-info-runtime-dependencies info))
      (for-each action (module-info-compiletime-dependencies info)))
    
    (table-set! *loaded-module-registry* ref loaded-module)
    loaded-module))

  (let rec ((lm lm))
    (table-for-each (lambda (k v)
                      (rec k))
                    (loaded-module-dependent-modules lm))

    (let ((ref (loaded-module-reference lm)))
      (vector-for-each
       (lambda (phase)
         (table-set! (expansion-phase-module-instances phase)
                     ref))
       (syntactic-tower-phases *repl-syntactic-tower*))))
  
  (table-set! *loaded-module-registry*
              (loaded-module-reference lm)))

(define (module-reference-ref ref #!key compare-stamps)
  (if (not (module-reference-absolute? ref))
      (error "Module reference must be absolute"))
  (or (let ((loaded-module (table-ref *loaded-module-registry* ref #f)))
        (if compare-stamps
            (and loaded-module
                 (loaded-module-stamp-is-fresh? loaded-module)
                 loaded-module)
            loaded-module))
      (module-reference-load! ref)))



(define-type module-instance
  id: F366DFDB-6F11-47EB-9558-04BF7B31225D

  (getter init: #f)
  (setter init: #f)
  
  (macros init: #f)
  (macro-env init: #f))

(define (module-instance-ref phase ref)
  (let ((table (expansion-phase-module-instances phase)))
    (and table
         (table-ref table ref #f))))

(define (module-instance-get! phase ref)
  (or (module-instance-ref phase ref)
      (let ((instance (make-module-instance)))
        (table-set! (expansion-phase-module-instances phase)
                    ref
                    instance)
        instance)))

(define (loaded-module-invoked? lm phase)
  (if (zero? (expansion-phase-number phase))
      (loaded-module-runtime-invoked lm)
      (let ((instance (module-instance-ref
                       phase
                       (loaded-module-reference lm))))
        (and instance
             (module-instance-getter instance)
             (module-instance-setter instance)
             #t))))

(define (loaded-module-visited? lm phase)
  (let ((instance (module-instance-ref
                   phase
                   (loaded-module-reference lm))))
    (and instance
         (module-instance-macros instance)
         (module-instance-macro-env instance)
         #t)))

  invoked first , nor that the modules that depend on this module
  function for loaded - modules - invoke /  and
(define (loaded-module-invoke! lm phase)
  (if (zero? (expansion-phase-number phase))
      (begin
        ((loaded-module-invoke-runtime lm))
        (loaded-module-runtime-invoked-set! lm #t))
      (let ((invoke-compiletime
             (loaded-module-invoke-compiletime lm)))
        (if invoke-compiletime
            (let ((getter
                   setter
                   ((loaded-module-invoke-compiletime lm)
                    lm phase))
                  (instance (module-instance-get!
                             phase
                             (loaded-module-reference lm))))
              (module-instance-getter-set! instance getter)
              (module-instance-setter-set! instance setter)))))
  (void))

(define (loaded-module-visit! lm phase)
  (let* ((next-phase (expansion-phase-next-phase phase))
         (phase-number (expansion-phase-number phase))
         (macro-procedures (list->table
                            ((loaded-module-visit lm) lm next-phase)))
         (macros (make-table))
         
         (module-ref (loaded-module-reference lm))
         (module-info (loaded-module-info lm))
         (namespace-string (module-info-namespace-string module-info))
         
         (env (make-top-environment module-ref))
         (memo-table (make-table
                      test: eq?
                      hash: eq?-hash)))
    (letrec
        ((make-env-from-letsyntax-environment
          (lambda (parent-env ls-env)
            (cond
             ((null? ls-env)
              parent-env)
             
             ((table-ref memo-table
                         ls-env
                         #f) =>
                         (lambda (result)
                           result))
             
             (else
              (let* ((env (make-environment parent-env)))
                (table-set! memo-table
                            ls-env
                            env)

                (for-each
                    (lambda (ls-def)
                      (let ((mac-name (car ls-def))
                            (unique-name (cadr ls-def))
                            (macro-ls-env (caddr ls-def)))
                        (ns-add! env
                                 0
                                 mac-name
                                 (list 'mac
  TODO Is this right ?
                                       (make-env-from-letsyntax-environment
                                        env
                                        macro-ls-env)
                                       unique-name))))
                  ls-env)
                
                env))))))
      
      (for-each
          (lambda (def)
            (cond
             ((eq? 'def (cadr def))
              (let ((name (car def)))
                (environment-add-def!
                 env
                 name
                 (gen-symbol namespace-string name)
                 phase-number: phase-number)))
             ((eq? 'mac (cadr def))
  Macro
              (let ((name (car def)))
                (environment-add-mac!
                 env
                 name
                 (table-ref macro-procedures name)
                 (make-env-from-letsyntax-environment env (caddr def))
                 phase-number: phase-number)))
             (else
              (error "Internal error in Black Hole (loaded-module.scm)"))))
        (module-info-definitions module-info)))

    (module-add-defs-to-env (module-info-imports module-info)
                            env
                            phase: phase)

    (let ((instance (module-instance-get!
                     phase
                     (loaded-module-reference lm))))
      (module-instance-macros-set! instance macro-procedures)
      (module-instance-macro-env-set! instance env))
    
    env))

(define (invoke-dependencies info->dependencies lm invoke)
  (for-each
      (lambda (dep-ref)
        (let ((dependency
               (module-reference-ref dep-ref)))
  Recurse
          (invoke dependency)))
    (info->dependencies
     (loaded-module-info lm))))

(define (loaded-module-invoke/deps lm phase
                                   #!key
                                   (memo (make-table)))
  (cond
   ((and (not (table-ref memo
                         (loaded-module-reference lm)
                         #f))
         (not (loaded-module-invoked? lm phase)))
    (table-set! memo
                (loaded-module-reference lm)
                #t)
    
    (invoke-dependencies module-info-runtime-dependencies
                         lm
                         (lambda (dependency)
                           (loaded-module-invoke/deps dependency phase
                                                      memo: memo)))
    
              (loaded-module-reference lm)
              phase))
    (loaded-module-invoke! lm phase))))

(define (loaded-modules-invoke/deps lms phase)
  (let ((memo (make-table)))
    (for-each (lambda (lm)
                (loaded-module-invoke/deps lm phase
                                           memo: memo))
      lms)))

(define (loaded-module-visit/deps lm phase
                                  #!key
                                  (invoke-memo (make-table))
                                  (visit-memo (make-table)))
  (cond
   ((and (not (table-ref visit-memo
                         (loaded-module-reference lm)
                         #f))
         (not (loaded-module-visited? lm phase)))
    (table-set! visit-memo
                (loaded-module-reference lm)
                #t)
    
    (let ((next-phase (expansion-phase-next-phase phase)))
      (invoke-dependencies module-info-compiletime-dependencies
                           lm
                           (lambda (dependency)
                             (loaded-module-invoke/deps dependency
                                                        next-phase
                                                        memo: invoke-memo))))
    
    (invoke-dependencies module-info-runtime-dependencies
                         lm
                         (lambda (dependency)
                           (loaded-module-visit/deps dependency
                                                     phase
                                                     visit-memo: visit-memo
                                                     invoke-memo: invoke-memo)))
    
( pp ( list ' visiting TODO Remove this
              (loaded-module-reference lm)
              phase))
    (loaded-module-visit! lm phase))))

(define (loaded-modules-visit/deps lms phase)
  (let ((invoke-memo (make-table))
        (visit-memo (make-table)))
    (for-each (lambda (lm)
                (loaded-module-visit/deps lm phase
                                          invoke-memo: invoke-memo
                                          visit-memo: visit-memo))
      lms)))

(define (module-load module-references
                     #!key
                     (phase (*expansion-phase*))
  One of # t , # f , ' force
                     (reload? 'force))
  (define (module-loaded-but-not-fresh? ref)
    (let ((lm (table-ref *loaded-module-registry* ref #f)))
      (and lm
           (not (loaded-module-stamp-is-fresh? lm)))))

  (define (loaded-modules-reinvoke lms phase)
    (letrec
         (invoke-table (make-table))
         (rec (lambda (lm #!optional force?)
                (cond
                 ((and (not (table-ref invoke-table
                                       (loaded-module-reference lm)
                                       #f))
                       (or force?
                           (not (loaded-module-invoked? lm phase))))
                  (table-set! invoke-table
                              (loaded-module-reference lm)
                              #t)
                  
                  (loaded-module-invoke! lm phase)
                  (loaded-module-visit! lm phase)
                  
                  (table-for-each
                   (lambda (k v)
                     (rec k #t))
                   (loaded-module-dependent-modules lm)))))))
      (for-each rec lms)))
  
  (let ((loaded-modules '())
        (reloaded-modules '()))
    
    (for-each
        (lambda (ref)
          (if (or (eq? 'force reload?)
                  (and reload?
                       (module-loaded-but-not-fresh? ref)))
              (push! reloaded-modules
                     (module-reference-load! ref))
              (push! loaded-modules
                     (module-reference-ref ref))))
      module-references)

    (loaded-modules-reinvoke reloaded-modules phase)
    (loaded-modules-invoke/deps loaded-modules phase)
    (loaded-modules-visit/deps loaded-modules phase)
    (pair? reloaded-modules)))

(define (module-import modules env phase)
  (let loop ()
    (let ((defs
           module-references
           (resolve-imports modules)))

      (let ((a-module-was-reloaded?
             (module-load module-references
                          phase: phase
                          reload?: (repl-environment? env))))
        
        (if (not a-module-was-reloaded?)
            (module-add-defs-to-env defs env
                                    phase: phase)
            (loop))))))

(define module-module
  (let* ((repl-environment #f)
         (fn (lambda (mod)
               (let* ((module-reference (resolve-one-module mod))
                      (loaded-module (module-reference-ref
                                      module-reference))
                      (info (loaded-module-info loaded-module)))
                 (if (repl-environment? (*top-environment*))
                     (set! repl-environment (*top-environment*)))
                 
                 (*top-environment* (make-top-environment module-reference))
                 (loaded-modules-invoke/deps
                  (list loaded-module)
                  (syntactic-tower-first-phase
                   *repl-syntactic-tower*))
                 
                 (module-add-defs-to-env (module-info-imports info)
                                         (*top-environment*))))))
    (lambda (mod)
      (if mod
          (fn mod)
          (*top-environment* repl-environment))
      (void))))




(define (module-add-defs-to-env defs
                                env
                                #!key
                                (phase
                                 (*expansion-phase*)))
  (define (macro+env-from-module-ref phase ref)
    (loaded-module-visit/deps (module-reference-ref ref) phase)
    (let* ((mi (module-instance-ref phase ref))
           (macros (and mi (module-instance-macros mi)))
           (env (and mi (module-instance-macro-env mi))))
      (values macros
              env)))
  
  (let ((phase-number (and phase (expansion-phase-number phase))))
    (for-each
        (lambda (def)
          (if (eq? 'def (cadr def))
              (environment-add-def!
               env
               module-reference: (cadddr def)
               phase-number: phase-number)
  Macro
              (let ((fn (caddr def)))
                (if (symbol? fn)
                    (let ((macros
                           macros-env
                           (macro+env-from-module-ref phase (cadddr def))))
                      (if (not (and macros macros-env))
                          (error "Internal error in Black Hole (loaded-module.scm)"))
                      (environment-add-mac! env
                                            (car def)
                                            (table-ref macros fn)
                                            macros-env
                                            phase-number: phase-number))
                    (let* ((env-or-ref
                            (cadddr def))
                           (macro-env
                            (if (env? env-or-ref)
                                env-or-ref
                                (let ((mi (module-instance-ref phase env-or-ref)))
                                  (or (and mi (module-instance-macro-env mi))
                                      (error "Internal error in Black Hole (loaded-module.scm)"))))))
                      (environment-add-mac! env
                                            (car def)
                                            fn
                                            macro-env
                                            phase-number: phase-number))))))
      defs)))

(define module-env-table
  (let* ((ns (make-table))
         (env (make-environment #f ns: ns)))
    (module-add-defs-to-env module-exports-list
                            env
                            phase: #f)
    ns))


(define builtin-ns
  (let* ((builtin-pair
          (cons (env-ns builtin-environment)
                gambit-builtin-table))
         (inside-letrec-table
          (env-ns inside-letrec-environment))
         (inside-letrec-pair
          (cons inside-letrec-table
                builtin-pair)))
    (lambda ()
      (let ((ns
             (if (inside-letrec)
                 inside-letrec-pair
                 builtin-pair)))
        (values (if (or (not (zero? (expansion-phase-number
                                     (*expansion-phase*))))
                        (not (environment-module-reference
                              (*top-environment*))))
                    (cons module-env-table ns)
                    ns)
                #f)))))

(define (make-top-environment module-reference)
  (let ((ns (cons (make-table)
                  builtin-ns)))
    (make-environment module-reference ns: ns)))

(define empty-environment
  (make-top-environment #f))

(*top-environment* (make-top-environment #f))
