path: root/stdlib/source/library/lux/tool/compiler/default/platform.lux

(.using
 [library
  [lux (.except)
   ["@" target]
   ["[0]" debug]
   ["[0]" static]
   [abstract
    ["[0]" monad (.only Monad do)]]
   [control
    ["[0]" function]
    ["[0]" maybe]
    ["[0]" try (.only Try) (.open: "[1]#[0]" monad)]
    ["[0]" exception (.only exception:)]
    [concurrency
     ["[0]" async (.only Async Resolver) (.open: "[1]#[0]" monad)]
     ["[0]" stm (.only Var STM)]]]
   [data
    ["[0]" binary (.only Binary)]
    ["[0]" bit]
    ["[0]" product]
    ["[0]" text (.open: "[1]#[0]" equivalence)
     ["%" format (.only format)]]
    [collection
     ["[0]" dictionary (.only Dictionary)]
     ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" mix)]
     ["[0]" set (.only Set)]
     ["[0]" list (.open: "[1]#[0]" monoid functor mix)]]
    [format
     ["_" binary (.only Writer)]]]
   ["[0]" meta (.only)
    ["[0]" configuration (.only Configuration)]]
   [type (.only sharing)
    ["[0]" check]]
   [world
    ["[0]" file (.only Path)]
    ["[0]" console]]]]
 ["[0]" //
  ["[1][0]" init]
  ["/[1]" // (.only)
   ["[1][0]" phase (.only Phase)]
   [language
    [lux
     [program (.only Program)]
     ["$" /]
     ["[0]" syntax]
     ["[1][0]" synthesis]
     ["[1][0]" generation (.only Buffer)]
     ["[1][0]" directive]
     ["[1][0]" analysis (.only)
      [macro (.only Expander)]
      ["[0]A" module]]
     [phase
      ["[0]" extension (.only Extender)]]]]
   [meta
    [import (.only Import)]
    ["[0]" context]
    ["[0]" cache (.only)
     ["[1]/[0]" archive]
     ["[1]/[0]" module]
     ["[1]/[0]" artifact]]
    [cli (.only Compilation Library)
     ["[0]" compiler]]
    ["[0]" archive (.only Output Archive)
     [key (.only Key)]
     ["[0]" registry (.only Registry)]
     ["[0]" artifact]
     ["[0]" module (.only)
      ["[0]" descriptor (.only Descriptor)]
      ["[0]" document (.only Document)]]]
    ["[0]" io
     ["_[1]" /]
     ["[1]" context]
     ["ioW" archive]]]]])

(with_expansions [<type_vars> (these anchor expression directive)
                  <Operation> (these ///generation.Operation <type_vars>)]
  (type: .public (Platform <type_vars>)
    (Record
     [#file_system (file.System Async)
      #host (///generation.Host expression directive)
      #phase (///generation.Phase <type_vars>)
      #runtime (<Operation> [Registry Output])
      #phase_wrapper (-> Archive (<Operation> ///phase.Wrapper))
      #write (-> directive Binary)]))

  ... TODO: Get rid of this
  (type: (Action a)
    (Async (Try a)))

  ... TODO: Get rid of this
  (def: monad
    (as (Monad Action)
        (try.with async.monad)))

  (with_expansions [<Platform> (these (Platform <type_vars>))
                    <State+> (these (///directive.State+ <type_vars>))
                    <Bundle> (these (///generation.Bundle <type_vars>))]

    (def: (writer //)
      (All (_ a)
        (-> (Writer a)
            (Writer [(module.Module a) Registry])))
      (all _.and
           (all _.and
                _.nat
                descriptor.writer
                (document.writer //))
           registry.writer
           ))

    (def: (cache_module context platform @module key format entry)
      (All (_ <type_vars> document)
        (-> context.Context <Platform> module.ID (Key document) (Writer document) (archive.Entry document)
            (Async (Try Any))))
      (let [system (the #file_system platform)
            write_artifact! (is (-> [artifact.ID (Maybe Text) Binary] (Action Any))
                                (function (_ [artifact_id custom content])
                                  (is (Async (Try Any))
                                      (cache/artifact.cache! system context @module artifact_id content))))]
        (do [! ..monad]
          [_ (is (Async (Try Any))
                 (cache/module.enable! async.monad system context @module))
           _ (for @.python (|> entry
                               (the archive.#output)
                               sequence.list
                               (list.sub 128)
                               (monad.each ! (monad.each ! write_artifact!))
                               (is (Action (List (List Any)))))
                  (|> entry
                      (the archive.#output)
                      sequence.list
                      (monad.each ..monad write_artifact!)
                      (is (Action (List Any)))))
           document (at async.monad in
                        (document.marked? key (the [archive.#module module.#document] entry)))]
          (is (Async (Try Any))
              (|> [(|> entry
                       (the archive.#module)
                       (has module.#document document))
                   (the archive.#registry entry)]
                  (_.result (..writer format))
                  (cache/module.cache! system context @module))))))

    ... TODO: Inline ASAP
    (def: initialize_buffer!
      (All (_ <type_vars>)
        (///generation.Operation <type_vars> Any))
      (///generation.set_buffer ///generation.empty_buffer))

    ... TODO: Inline ASAP
    (def: (compile_runtime! platform)
      (All (_ <type_vars>)
        (-> <Platform> (///generation.Operation <type_vars> [Registry Output])))
      (do ///phase.monad
        [_ ..initialize_buffer!]
        (the #runtime platform)))

    (def: runtime_descriptor
      Descriptor
      [descriptor.#hash 0
       descriptor.#name descriptor.runtime
       descriptor.#file ""
       descriptor.#references (set.empty text.hash)
       descriptor.#state {.#Compiled}])
    
    (def: runtime_document
      (Document .Module)
      (document.document $.key (moduleA.empty 0)))

    (def: runtime_module
      (module.Module .Module)
      [module.#id module.runtime
       module.#descriptor runtime_descriptor
       module.#document runtime_document])

    (def: (process_runtime archive platform)
      (All (_ <type_vars>)
        (-> Archive <Platform>
            (///directive.Operation <type_vars>
                                    [Archive (archive.Entry .Module)])))
      (do ///phase.monad
        [[registry payload] (///directive.lifted_generation
                             (..compile_runtime! platform))
         .let [entry [..runtime_module payload registry]]
         archive (///phase.lifted (if (archive.reserved? archive descriptor.runtime)
                                    (archive.has descriptor.runtime entry archive)
                                    (do try.monad
                                      [[_ archive] (archive.reserve descriptor.runtime archive)]
                                      (archive.has descriptor.runtime entry archive))))]
        (in [archive entry])))

    (def: (initialize_state extender
                            [analysers
                             synthesizers
                             generators
                             directives]
                            analysis_state
                            state)
      (All (_ <type_vars>)
        (-> Extender
            [(Dictionary Text ///analysis.Handler)
             (Dictionary Text ///synthesis.Handler)
             (Dictionary Text (///generation.Handler <type_vars>))
             (Dictionary Text (///directive.Handler <type_vars>))]
            .Lux
            <State+>
            (Try <State+>)))
      (|> (sharing [<type_vars>]
                   <State+>
                   state
                   
                   (///directive.Operation <type_vars> Any)
                   (do [! ///phase.monad]
                     [_ (///directive.lifted_analysis
                         (do !
                           [_ (///analysis.set_state analysis_state)]
                           (extension.with extender analysers)))
                      _ (///directive.lifted_synthesis
                         (extension.with extender synthesizers))
                      _ (///directive.lifted_generation
                         (extension.with extender (as_expected generators)))
                      _ (extension.with extender (as_expected directives))]
                     (in [])))
          (///phase.result' state)
          (at try.monad each product.left)))

    (def: (phase_wrapper archive platform state)
      (All (_ <type_vars>)
        (-> Archive <Platform> <State+> (Try [<State+> ///phase.Wrapper])))
      (|> archive
          ((the #phase_wrapper platform))
          ///directive.lifted_generation
          (///phase.result' state)))

    (def: (complete_extensions host_directive_bundle phase_wrapper [analysers synthesizers generators directives])
      (All (_ <type_vars>)
        (-> (-> ///phase.Wrapper (///directive.Bundle <type_vars>))
            ///phase.Wrapper
            [(Dictionary Text ///analysis.Handler)
             (Dictionary Text ///synthesis.Handler)
             (Dictionary Text (///generation.Handler <type_vars>))
             (Dictionary Text (///directive.Handler <type_vars>))]
            [(Dictionary Text ///analysis.Handler)
             (Dictionary Text ///synthesis.Handler)
             (Dictionary Text (///generation.Handler <type_vars>))
             (Dictionary Text (///directive.Handler <type_vars>))]))
      [analysers
       synthesizers
       generators
       (dictionary.composite directives (host_directive_bundle phase_wrapper))])

    (def: .public (initialize context module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender
                              import compilation_sources compilation_configuration)
      (All (_ <type_vars>)
        (-> context.Context
            descriptor.Module
            Expander
            ///analysis.Bundle
            <Platform>
            <Bundle>
            (-> ///phase.Wrapper (///directive.Bundle <type_vars>))
            (Program expression directive)
            [Type Type Type] (-> ///phase.Wrapper Extender)
            Import (List _io.Context) Configuration
            (Async (Try [<State+> Archive ///phase.Wrapper]))))
      (do [! (try.with async.monad)]
        [.let [state (//init.state (the context.#host context)
                                   module
                                   compilation_configuration
                                   expander
                                   host_analysis
                                   (the #host platform)
                                   (the #phase platform)
                                   generation_bundle)]
         _ (is (Async (Try Any))
               (cache.enable! async.monad (the #file_system platform) context))
         [archive analysis_state bundles] (ioW.thaw (list) compilation_configuration (the #host platform) (the #file_system platform) context import compilation_sources)
         .let [with_missing_extensions
               (is (All (_ <type_vars>)
                     (-> <Platform> (Program expression directive) <State+>
                         (Async (Try [///phase.Wrapper <State+>]))))
                   (function (_ platform program state)
                     (async#in
                      (do try.monad
                        [[state phase_wrapper] (..phase_wrapper archive platform state)]
                        (|> state
                            (initialize_state (extender phase_wrapper)
                                              (as_expected (..complete_extensions host_directive_bundle phase_wrapper (as_expected bundles)))
                                              analysis_state)
                            (try#each (|>> (//init.with_default_directives expander host_analysis program anchorT,expressionT,directiveT (extender phase_wrapper))
                                           [phase_wrapper])))))))]]
        (if (archive.archived? archive descriptor.runtime)
          (do !
            [[phase_wrapper state] (with_missing_extensions platform program state)]
            (in [state archive phase_wrapper]))
          (do !
            [[state [archive payload]] (|> (..process_runtime archive platform)
                                           (///phase.result' state)
                                           async#in)
             _ (..cache_module context platform 0 $.key $.writer payload)
             
             [phase_wrapper state] (with_missing_extensions platform program state)]
            (in [state archive phase_wrapper])))))

    (def: compilation_log_separator
      (format text.new_line text.tab))

    (def: (module_compilation_log module)
      (All (_ <type_vars>)
        (-> descriptor.Module <State+> Text))
      (|>> (the [extension.#state
                 ///directive.#generation
                 ///directive.#state
                 extension.#state
                 ///generation.#log])
           (sequence#mix (function (_ right left)
                           (format left ..compilation_log_separator right))
                         module)))

    (def: with_reset_log
      (All (_ <type_vars>)
        (-> <State+> <State+>))
      (has [extension.#state
            ///directive.#generation
            ///directive.#state
            extension.#state
            ///generation.#log]
           sequence.empty))

    (def: empty
      (Set descriptor.Module)
      (set.empty text.hash))

    (type: Mapping
      (Dictionary descriptor.Module (Set descriptor.Module)))

    (type: Dependence
      (Record
       [#depends_on Mapping
        #depended_by Mapping]))

    (def: independence
      Dependence
      (let [empty (dictionary.empty text.hash)]
        [#depends_on empty
         #depended_by empty]))

    (def: (depend module import dependence)
      (-> descriptor.Module descriptor.Module Dependence Dependence)
      (let [transitive_dependency (is (-> (-> Dependence Mapping) descriptor.Module (Set descriptor.Module))
                                      (function (_ lens module)
                                        (|> dependence
                                            lens
                                            (dictionary.value module)
                                            (maybe.else ..empty))))
            transitive_depends_on (transitive_dependency (the #depends_on) import)
            transitive_depended_by (transitive_dependency (the #depended_by) module)
            update_dependence (is (-> [descriptor.Module (Set descriptor.Module)] [descriptor.Module (Set descriptor.Module)]
                                      (-> Mapping Mapping))
                                  (function (_ [source forward] [target backward])
                                    (function (_ mapping)
                                      (let [with_dependence+transitives
                                            (|> mapping
                                                (dictionary.revised' source ..empty (set.has target))
                                                (dictionary.revised source (set.union forward)))]
                                        (list#mix (function (_ previous)
                                                    (dictionary.revised' previous ..empty (set.has target)))
                                                  with_dependence+transitives
                                                  (set.list backward))))))]
        (|> dependence
            (revised #depends_on
                     (update_dependence
                      [module transitive_depends_on]
                      [import transitive_depended_by]))
            (revised #depended_by
                     ((function.flipped update_dependence)
                      [module transitive_depends_on]
                      [import transitive_depended_by])))))

    (def: (circular_dependency? module import dependence)
      (-> descriptor.Module descriptor.Module Dependence Bit)
      (let [dependence? (is (-> descriptor.Module (-> Dependence Mapping) descriptor.Module Bit)
                            (function (_ from relationship to)
                              (let [targets (|> dependence
                                                relationship
                                                (dictionary.value from)
                                                (maybe.else ..empty))]
                                (set.member? targets to))))]
        (or (dependence? import (the #depends_on) module)
            (dependence? module (the #depended_by) import))))

    (exception: .public (module_cannot_import_itself [module descriptor.Module])
      (exception.report
       "Module" (%.text module)))

    (exception: .public (cannot_import_circular_dependency [importer descriptor.Module
                                                            importee descriptor.Module])
      (exception.report
       "Importer" (%.text importer)
       "importee" (%.text importee)))

    (exception: .public (cannot_import_twice [importer descriptor.Module
                                              duplicates (Set descriptor.Module)])
      (exception.report
       "Importer" (%.text importer)
       "Duplicates" (%.list %.text (set.list duplicates))))

    (def: (verify_dependencies importer importee dependence)
      (-> descriptor.Module descriptor.Module Dependence (Try Any))
      (cond (text#= importer importee)
            (exception.except ..module_cannot_import_itself [importer])

            (..circular_dependency? importer importee dependence)
            (exception.except ..cannot_import_circular_dependency [importer importee])

            ... else
            {try.#Success []}))

    (exception: .public (cannot_overwrite_extension [extension extension.Name])
      (exception.report
       "Extension" (%.text extension)))

    (def: (with_extensions from to)
      (All (_ state input output)
        (-> (extension.Bundle state input output)
            (extension.Bundle state input output)
            (Try (extension.Bundle state input output))))
      (monad.mix try.monad
                 (function (_ [extension expected] output)
                   (with_expansions [<inherited> (dictionary.has extension expected output)]
                     (case (dictionary.value extension output)
                       {.#None}
                       {try.#Success <inherited>}
                       
                       {.#Some actual}
                       (if (same? expected actual)
                         {try.#Success <inherited>}
                         (exception.except ..cannot_overwrite_extension [extension])))))
                 to
                 ... TODO: Come up with something better. This is not an ideal solution because it can mask overwrites happening across multiple imported modules.
                 (list.only (|>> product.left (dictionary.key? to) not)
                            (dictionary.entries from))))

    (template [<name> <path>]
      [(def: (<name> from state)
         (All (_ <type_vars>)
           (-> <State+> <State+> (Try <State+>)))
         (do try.monad
           [inherited (with_extensions (the <path> from) (the <path> state))]
           (in (has <path> inherited state))))]

      [with_analysis_extensions [extension.#state ///directive.#analysis ///directive.#state extension.#bundle]]
      [with_synthesis_extensions [extension.#state ///directive.#synthesis ///directive.#state extension.#bundle]]
      [with_generation_extensions [extension.#state ///directive.#generation ///directive.#state extension.#bundle]]
      [with_directive_extensions [extension.#bundle]]
      )

    (def: (with_all_extensions from state)
      (All (_ <type_vars>)
        (-> <State+> <State+> (Try <State+>)))
      (do try.monad
        [state (with_analysis_extensions from state)
         state (with_synthesis_extensions from state)
         state (with_generation_extensions from state)]
        (with_directive_extensions from state)))

    (type: (Context state)
      [Archive state])

    (type: (Result state)
      (Try (Context state)))

    (type: (Return state)
      (Async (Result state)))

    (type: (Signal state)
      (Resolver (Result state)))

    (type: (Pending state)
      [(Return state)
       (Signal state)])

    (type: (Importer state)
      (-> (List ///.Custom) descriptor.Module descriptor.Module (Return state)))

    (type: (Compiler state)
      (-> (List ///.Custom) descriptor.Module (Importer state) module.ID (Context state) descriptor.Module (Return state)))
    
    (with_expansions [Lux_Context (..Context <State+>)
                      Lux_Return (..Return <State+>)
                      Lux_Signal (..Signal <State+>)
                      Lux_Pending (..Pending <State+>)
                      Lux_Importer (..Importer <State+>)
                      Lux_Compiler (..Compiler <State+>)]
      (def: (parallel initial)
        (All (_ <type_vars>)
          (-> Lux_Context
              (-> Lux_Compiler Lux_Importer)))
        (let [current (stm.var initial)
              pending (sharing [<type_vars>]
                               Lux_Context
                               initial
                               
                               (Var (Dictionary descriptor.Module Lux_Pending))
                               (as_expected (stm.var (dictionary.empty text.hash))))
              dependence (is (Var Dependence)
                             (stm.var ..independence))]
          (function (_ compile)
            (function (import! customs importer module)
              (do [! async.monad]
                [[return signal] (sharing [<type_vars>]
                                          Lux_Context
                                          initial
                                          
                                          (Async [Lux_Return (Maybe [Lux_Context
                                                                     module.ID
                                                                     Lux_Signal])])
                                          (as_expected
                                           (stm.commit!
                                            (do [! stm.monad]
                                              [dependence (if (text#= descriptor.runtime importer)
                                                            (stm.read dependence)
                                                            (do !
                                                              [[_ dependence] (stm.update (..depend importer module) dependence)]
                                                              (in dependence)))]
                                              (case (..verify_dependencies importer module dependence)
                                                {try.#Failure error}
                                                (in [(async.resolved {try.#Failure error})
                                                     {.#None}])

                                                {try.#Success _}
                                                (do !
                                                  [[archive state] (stm.read current)]
                                                  (if (archive.archived? archive module)
                                                    (in [(async#in {try.#Success [archive state]})
                                                         {.#None}])
                                                    (do !
                                                      [@pending (stm.read pending)]
                                                      (case (dictionary.value module @pending)
                                                        {.#Some [return signal]}
                                                        (in [return
                                                             {.#None}])
                                                        
                                                        {.#None}
                                                        (case (if (archive.reserved? archive module)
                                                                (do try.monad
                                                                  [@module (archive.id module archive)]
                                                                  (in [@module archive]))
                                                                (archive.reserve module archive))
                                                          {try.#Success [@module archive]}
                                                          (do !
                                                            [_ (stm.write [archive state] current)
                                                             .let [[return signal] (sharing [<type_vars>]
                                                                                            Lux_Context
                                                                                            initial
                                                                                            
                                                                                            Lux_Pending
                                                                                            (async.async []))]
                                                             _ (stm.update (dictionary.has module [return signal]) pending)]
                                                            (in [return
                                                                 {.#Some [[archive state]
                                                                          @module
                                                                          signal]}]))
                                                          
                                                          {try.#Failure error}
                                                          (in [(async#in {try.#Failure error})
                                                               {.#None}])))))))))))
                 _ (case signal
                     {.#None}
                     (in [])
                     
                     {.#Some [context @module resolver]}
                     (do !
                       [result (compile customs importer import! @module context module)
                        result (case result
                                 {try.#Failure error}
                                 (in result)

                                 {try.#Success [resulting_archive resulting_state]}
                                 (stm.commit! (do stm.monad
                                                [[_ [merged_archive _]] (stm.update (function (_ [archive state])
                                                                                      [(archive.composite resulting_archive archive)
                                                                                       state])
                                                                                    current)]
                                                (in {try.#Success [merged_archive resulting_state]}))))]
                       (async.future (resolver result))))]
                return)))))

      ... TODO: Find a better way, as this only works for the Lux compiler.
      (def: (updated_state archive extended_states state)
        (All (_ <type_vars>)
          (-> Archive (List <State+>) <State+> (Try <State+>)))
        (do [! try.monad]
          [modules (monad.each ! (function (_ module)
                                   (do !
                                     [entry (archive.find module archive)
                                      lux_module (|> entry
                                                     (the [archive.#module module.#document])
                                                     (document.content $.key))]
                                     (in [module lux_module])))
                               (archive.archived archive))
           .let [additions (|> modules
                               (list#each product.left)
                               (set.of_list text.hash))
                 with_modules (is (All (_ <type_vars>)
                                    (-> <State+> <State+>))
                                  (revised [extension.#state
                                            ///directive.#analysis
                                            ///directive.#state
                                            extension.#state]
                                           (is (All (_ a) (-> a a))
                                               (function (_ analysis_state)
                                                 (|> analysis_state
                                                     (as .Lux)
                                                     (revised .#modules (function (_ current)
                                                                          (list#composite (list.only (|>> product.left
                                                                                                          (set.member? additions)
                                                                                                          not)
                                                                                                     current)
                                                                                          modules)))
                                                     as_expected)))))]
           state (monad.mix ! with_all_extensions state extended_states)]
          (in (with_modules state))))

      (def: (set_current_module module state)
        (All (_ <type_vars>)
          (-> descriptor.Module <State+> <State+>))
        (|> (///directive.set_current_module module)
            (///phase.result' state)
            try.trusted
            product.left))

      ... TODO: Come up with a less hacky way to prevent duplicate imports.
      ... This currently assumes that all imports will be specified once in a single .using form.
      ... This might not be the case in the future.
      (def: (with_new_dependencies new_dependencies all_dependencies)
        (-> (List descriptor.Module) (Set descriptor.Module) [(Set descriptor.Module) (Set descriptor.Module)])
        (let [[all_dependencies duplicates _] (is [(Set descriptor.Module) (Set descriptor.Module) Bit]
                                                  (list#mix (function (_ new [all duplicates seen_prelude?])
                                                              (if (set.member? all new)
                                                                (if (text#= .prelude_module new)
                                                                  (if seen_prelude?
                                                                    [all (set.has new duplicates) seen_prelude?]
                                                                    [all duplicates true])
                                                                  [all (set.has new duplicates) seen_prelude?])
                                                                [(set.has new all) duplicates seen_prelude?]))
                                                            (is [(Set descriptor.Module) (Set descriptor.Module) Bit]
                                                                [all_dependencies ..empty (set.empty? all_dependencies)])
                                                            new_dependencies))]
          [all_dependencies duplicates]))

      (def: (any|after_imports customs import! module duplicates new_dependencies archive)
        (All (_ <type_vars>
                state document object)
          (-> (List ///.Custom) (..Importer state) descriptor.Module (Set descriptor.Module) (List descriptor.Module) Archive
              (Async (Try [Archive (List state)]))))
        (do [! (try.with async.monad)]
          []
          (if (set.empty? duplicates)
            (case new_dependencies
              {.#End}
              (in [archive (list)])

              {.#Item _}
              (do !
                [archive,state/* (|> new_dependencies
                                     (list#each (import! customs module))
                                     (monad.all ..monad))]
                (in [(|> archive,state/*
                         (list#each product.left)
                         (list#mix archive.composite archive))
                     (list#each product.right archive,state/*)])))
            (async#in (exception.except ..cannot_import_twice [module duplicates])))))

      (def: (lux|after_imports customs import! module duplicates new_dependencies [archive state])
        (All (_ <type_vars>)
          (-> (List ///.Custom) Lux_Importer descriptor.Module (Set descriptor.Module) (List descriptor.Module) Lux_Context Lux_Return))
        (do (try.with async.monad)
          [[archive state/*] (any|after_imports customs import! module duplicates new_dependencies archive)]
          (in [archive (case state/*
                         {.#End}
                         state

                         {.#Item _}
                         (try.trusted (..updated_state archive state/* state)))])))

      (def: (next_compilation module [archive state] compilation)
        (All (_ <type_vars>)
          (-> descriptor.Module Lux_Context (///.Compilation <State+> .Module Any)
              (Try [<State+> (Either (///.Compilation <State+> .Module Any)
                                     (archive.Entry Any))])))
        ((the ///.#process compilation)
         ... TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP.
         ... TODO: The context shouldn't need to be re-set either.
         (|> (///directive.set_current_module module)
             (///phase.result' state)
             try.trusted
             product.left)
         archive))

      (def: (compiler phase_wrapper expander platform)
        (All (_ <type_vars>)
          (-> ///phase.Wrapper Expander <Platform>
              (///.Compiler <State+> .Module Any)))
        (let [instancer (//init.compiler phase_wrapper expander syntax.prelude (the #write platform))]
          (instancer $.key (list))))

      (def: (custom_compiler import context platform compilation_sources compiler
                             custom_key custom_format custom_compilation)
        (All (_ <type_vars>
                state document object)
          (-> Import context.Context <Platform> (List _io.Context) (///.Compiler <State+> .Module Any)
              (Key document) (Writer document) (///.Compilation state document object)
              (-> (List ///.Custom) descriptor.Module Lux_Importer module.ID (..Context state) descriptor.Module (..Return state))))
        (function (_ customs importer import! @module [archive state] module)
          (loop (again [[archive state] [archive state]
                        compilation custom_compilation
                        all_dependencies (is (Set descriptor.Module)
                                             (set.of_list text.hash (list)))])
            (do [! (try.with async.monad)]
              [.let [new_dependencies (the ///.#dependencies compilation)
                     [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)]
               [archive _] (any|after_imports customs import! module duplicates new_dependencies archive)]
              (case ((the ///.#process compilation) state archive)
                {try.#Success [state more|done]}
                (case more|done
                  {.#Left more}
                  (let [continue! (sharing [state document object]
                                           (///.Compilation state document object)
                                           custom_compilation
                                           
                                           (-> (..Context state) (///.Compilation state document object) (Set descriptor.Module)
                                               (..Return state))
                                           (as_expected again))]
                    (continue! [archive state] more all_dependencies))

                  {.#Right entry}
                  (do !
                    [.let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)]
                     _ (..cache_module context platform @module custom_key custom_format entry)]
                    (async#in (do try.monad
                                [archive (archive.has module entry archive)]
                                (in [archive state])))))

                {try.#Failure error}
                (do !
                  [_ (cache/archive.cache! (the #file_system platform) context archive)]
                  (async#in {try.#Failure error})))))))

      (def: (lux_compiler import context platform compilation_sources compiler compilation)
        (All (_ <type_vars>)
          (-> Import context.Context <Platform> (List _io.Context) (///.Compiler <State+> .Module Any)
              (///.Compilation <State+> .Module Any)
              Lux_Compiler))
        (function (_ customs importer import! @module [archive state] module)
          (loop (again [[archive state] [archive (..set_current_module module state)]
                        compilation compilation
                        all_dependencies (is (Set descriptor.Module)
                                             (set.of_list text.hash (list)))])
            (do [! (try.with async.monad)]
              [.let [new_dependencies (the ///.#dependencies compilation)
                     [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)]
               [archive state] (lux|after_imports customs import! module duplicates new_dependencies [archive state])]
              (case (next_compilation module [archive state] compilation)
                {try.#Success [state more|done]}
                (case more|done
                  {.#Left more}
                  (let [continue! (sharing [<type_vars>]
                                           <Platform>
                                           platform
                                           
                                           (-> Lux_Context (///.Compilation <State+> .Module Any) (Set descriptor.Module)
                                               (Action [Archive <State+>]))
                                           (as_expected again))]
                    (continue! [archive state] more all_dependencies))

                  {.#Right entry}
                  (do !
                    [_ (let [report (..module_compilation_log module state)]
                         (with_expansions [<else> (in (debug.log! report))]
                           (for @.js (is (Async (Try Any))
                                         (case console.default
                                           {.#None}
                                           <else>
                                           
                                           {.#Some console}
                                           (console.write_line report console)))
                                <else>)))
                     .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)]
                     _ (..cache_module context platform @module $.key $.writer (as (archive.Entry .Module) entry))]
                    (async#in (do try.monad
                                [archive (archive.has module entry archive)]
                                (in [archive
                                     (..with_reset_log state)])))))

                {try.#Failure error}
                (do !
                  [_ (cache/archive.cache! (the #file_system platform) context archive)]
                  (async#in {try.#Failure error})))))))

      (for @.old (these (def: Fake_State
                          Type
                          {.#Primitive (%.nat (static.random_nat)) (list)})

                        (def: Fake_Document
                          Type
                          {.#Primitive (%.nat (static.random_nat)) (list)})

                        (def: Fake_Object
                          Type
                          {.#Primitive (%.nat (static.random_nat)) (list)}))
           (these))

      (def: (serial_compiler import context platform compilation_sources compiler)
        (All (_ <type_vars>)
          (-> Import context.Context <Platform> (List _io.Context) (///.Compiler <State+> .Module Any)
              Lux_Compiler))
        (function (_ all_customs importer import! @module [archive lux_state] module)
          (do [! (try.with async.monad)]
            [input (io.read (the #file_system platform)
                            importer
                            import
                            compilation_sources
                            (the context.#host_module_extension context)
                            module)]
            (loop (again [customs (for @.old (as (List (///.Custom Fake_State Fake_Document Fake_Object))
                                                 all_customs)
                                       all_customs)])
              (case customs
                {.#End}
                ((..lux_compiler import context platform compilation_sources compiler (compiler input))
                 all_customs importer import! @module [archive lux_state] module)
                
                {.#Item [custom_state custom_key custom_format custom_parser custom_compiler] tail}
                (case (custom_compiler input)
                  {try.#Failure _}
                  (again tail)
                  
                  {try.#Success custom_compilation}
                  (do !
                    [[archive' custom_state'] ((..custom_compiler import context platform compilation_sources compiler
                                                                  custom_key custom_format custom_compilation)
                                               all_customs importer import! @module [archive custom_state] module)]
                    (in [archive' lux_state]))))))))

      (def: .public Custom
        Type
        (type (-> (List Text) (Try ///.Custom))))

      (exception: .public (invalid_custom_compiler [definition Symbol
                                                    type Type])
        (exception.report
         "Definition" (%.symbol definition)
         "Expected Type" (%.type ..Custom)
         "Actual Type" (%.type type)))

      (def: (custom import! it)
        (All (_ <type_vars>)
          (-> Lux_Importer compiler.Compiler (Async (Try [Lux_Context (List Text) Any]))))
        (let [/#definition (the compiler.#definition it)
              [/#module /#name] /#definition]
          (do ..monad
            [context (import! (list) descriptor.runtime /#module)
             .let [[archive state] context
                   meta_state (the [extension.#state
                                    ///directive.#analysis
                                    ///directive.#state
                                    extension.#state]
                                   state)]
             [_ /#type /#value] (|> /#definition
                                    meta.export
                                    (meta.result meta_state)
                                    async#in)]
            (async#in (if (check.subsumes? ..Custom /#type)
                        {try.#Success [context (the compiler.#parameters it) /#value]}
                        (exception.except ..invalid_custom_compiler [/#definition /#type]))))))

      (def: .public (compile lux_compiler phase_wrapper import file_context expander platform compilation context)
        (All (_ <type_vars>)
          (-> (-> Any ..Custom) ///phase.Wrapper Import context.Context Expander <Platform> Compilation Lux_Context Lux_Return))
        (let [[host_dependencies libraries compilers sources target module configuration] compilation
              import! (|> (..compiler phase_wrapper expander platform)
                          (serial_compiler import file_context platform sources)
                          (..parallel context))]
          (do [! ..monad]
            [customs (|> compilers
                         (list#each (function (_ it)
                                      (do !
                                        [[context parameters custom] (..custom import! it)]
                                        (async#in (|> custom
                                                      lux_compiler
                                                      (function.on parameters))))))
                         (monad.all !))]
            (import! customs descriptor.runtime module))))
      )))