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

... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.

(.require
 [library
  [lux (.except Module #host)
   ["[0]" debug]
   [abstract
    ["[0]" monad (.only Monad do)]]
   [control
    ["[0]" function]
    ["[0]" maybe]
    ["[0]" try (.only Try) (.use "[1]#[0]" monad)]
    ["[0]" exception (.only Exception)]
    [concurrency
     ["[0]" async (.only Async Resolver) (.use "[1]#[0]" monad)]
     ["[0]" stm (.only Var STM)]]]
   [data
    ["[0]" bit]
    ["[0]" sum]
    ["[0]" product]
    ["[0]" binary (.only Binary)
     ["_" \\format (.only Format)]]
    ["[0]" text (.use "[1]#[0]" equivalence)
     ["%" \\format]]
    [collection
     ["[0]" dictionary (.only Dictionary)]
     ["[0]" sequence (.only Sequence) (.use "[1]#[0]" mix)]
     ["[0]" set (.only Set)]
     ["[0]" list (.use "[1]#[0]" monoid functor mix)]]]
   ["[0]" meta (.only)
    ["[0]" static]
    ["[0]" configuration (.only Configuration)]
    [type (.only sharing)
     ["[0]" check]]
    [compiler
     ["@" target]]]
   [world
    ["[0]" file (.only Path)]
    ["[0]" console]]]]
 ["[0]" //
  ["[1][0]" init]
  ["/[1]" // (.only)
   [language
    [lux
     [program (.only Program)]
     ["$" /]
     ["[0]" syntax]
     ["[1][0]" synthesis]
     ["[1][0]" translation (.only Buffer)]
     ["[1][0]" declaration (.only Extender)]
     ["[1][0]" analysis (.only)
      [macro (.only Expander)]
      ["[0]A" module]]
     ["[0]" phase (.only Phase) (.use "[1]#[0]" monad)
      ["[0]" extension]]]]
   [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 Module)]
      ["[0]" document (.only Document)]]]
    ["[0]" io
     ["_[1]" /]
     ["[1]" context]
     ["ioW" archive]]]]])

(with_expansions [<type_vars> (these anchor expression declaration)
                  <Operation> (these ///translation.Operation <type_vars>)]
  (type .public (Platform <type_vars>)
    (Record
     [#file_system (file.System Async)
      #host (///translation.Host expression declaration)
      #phase (-> extension.Extender Lux (///translation.Phase <type_vars>))
      #runtime (<Operation> [Registry Output])
      #phase_wrapper phase.Wrapper
      #write (-> declaration 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 (///declaration.State <type_vars>))]

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

    (def (cache_module context platform @module key format entry)
      (All (_ <type_vars> document)
        (-> context.Context <Platform> module.ID (Key document) (Format 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 (of 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 (..format format))
                  (cache/module.cache! system context @module))))))

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

    ... TODO: Inline ASAP
    (def (compile_runtime! platform)
      (All (_ <type_vars>)
        (-> <Platform>
            (///translation.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>
            (///declaration.Operation <type_vars>
                                      [Archive (archive.Entry .Module)])))
      (do phase.monad
        [[registry payload] (///declaration.of_translation
                             (..compile_runtime! platform))
         .let [entry [..runtime_module payload registry]]
         archive (phase.of_try (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 analysis_state all_extensions)
      (All (_ <type_vars>)
        (-> .Lux (//init.Extensions <type_vars>)
            (///declaration.Operation <type_vars> Any)))
      (do [! phase.monad]
        [_ (///declaration.of_analysis
            (///analysis.set_state analysis_state))]
        (//init.with_defaults .prelude all_extensions)))

    (def (with_extended_prelude state archive)
      (-> Lux Archive
          Archive)
      (|> (do try.monad
            [prelude (meta.result state (meta.module .prelude))
             entry (archive.find .prelude archive)
             .let [entry (has [archive.#module module.#document]
                              (document.document $.key prelude)
                              entry)]]
            (archive.has! .prelude entry archive))
          (try.else archive)))

    (def .public (initialize context module expander platform program extender
                             import compilation_sources compilation_configuration
                             all_extensions)
      (All (_ <type_vars>)
        (-> context.Context
            descriptor.Module
            Expander
            <Platform>
            (Program expression declaration)
            extension.Extender
            Import (List _io.Context) Configuration
            (//init.Extensions <type_vars>)
            (Async (Try [<State> Archive phase.Wrapper]))))
      (do [! ..monad]
        [.let [phase_wrapper (the #phase_wrapper platform)
               state (//init.state (the context.#host context)
                                   module
                                   compilation_configuration
                                   extender
                                   expander
                                   (the #host platform)
                                   (the #phase platform))]
         _ (is (Async (Try Any))
               (cache.enable! async.monad (the #file_system platform) context))
         [archive analysis_state] (ioW.thaw (list) compilation_configuration (the #host platform) (the #file_system platform) context import compilation_sources)
         .let [with_missing_extensions
               (is (All (_ <type_vars>)
                     (-> (//init.Extensions <type_vars>) <State>
                         (Async (Try <State>))))
                   (function (_ all_extensions state)
                     (|> (initialize_state analysis_state all_extensions)
                         (phase.result' state)
                         (try#each product.left)
                         async#in)))]]
        (if (archive.archived? archive descriptor.runtime)
          (do !
            [state (with_missing_extensions all_extensions state)
             .let [archive (with_extended_prelude (the [///declaration.#analysis ///declaration.#state] state) archive)]]
            (in [state archive phase_wrapper]))
          (do !
            [[state [archive payload]] (|> (..process_runtime archive platform)
                                           (phase.result' state)
                                           async#in)
             _ (..cache_module context platform 0 $.key $.format payload)]
            (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 [///declaration.#translation
                 ///declaration.#state
                 ///translation.#log])
           (sequence#mix (function (_ right left)
                           (%.format left ..compilation_log_separator right))
                         module)))

    (def with_reset_log
      (All (_ <type_vars>)
        (-> <State>
            <State>))
      (has [///declaration.#translation
            ///declaration.#state
            ///translation.#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.def .public (module_cannot_import_itself module)
      (Exception descriptor.Module)
      (exception.report
       (list ["Module" (%.text module)])))

    (exception.def .public (cannot_import_circular_dependency [importer importee])
      (Exception [descriptor.Module descriptor.Module])
      (exception.report
       (list ["Importer" (%.text importer)]
             ["Importee" (%.text importee)])))

    (exception.def .public (cannot_import_twice [importer duplicates])
      (Exception [descriptor.Module (Set descriptor.Module)])
      (exception.report
       (list ["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 []}))

    (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>]
                        (is Lux_Context
                            initial)
                        (is (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>]
                                   (is Lux_Context
                                       initial)
                                   (is (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)))]
                                           (when (..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)]
                                                   (when (dictionary.value module @pending)
                                                     {.#Some [return signal]}
                                                     (in [return
                                                          {.#None}])
                                                     
                                                     {.#None}
                                                     (when (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>]
                                                                                  (is Lux_Context
                                                                                      initial)
                                                                                  (is 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}]))))))))))))
                 _ (when signal
                     {.#None}
                     (in [])
                     
                     {.#Some [context @module resolver]}
                     (do !
                       [result (compile customs importer import! @module context module)
                        result (when 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 [///declaration.#analysis
                                            ///declaration.#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)))))]]
          (in (with_modules state))))

      (def (set_current_module module state)
        (All (_ <type_vars>)
          (-> descriptor.Module <State>
              <State>))
        (|> (///declaration.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 .require 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 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 (after_imports customs import! module duplicates new_dependencies archive)
        (All (_ <type_vars>
                state)
          (-> (List ///.Custom) (..Importer state) descriptor.Module (Set descriptor.Module) (List descriptor.Module) Archive
              (Async (Try [Archive (List state) (List Text)]))))
        (if (set.empty? duplicates)
          (when new_dependencies
            {.#End}
            (of ..monad in [archive (list) (list)])

            {.#Item _}
            (do [! async.monad]
              [attempts (|> new_dependencies
                            (list#each (import! customs module))
                            (monad.all !))
               .let [[failures successes] (sum.partition attempts)]]
              (in {try.#Success [(|> successes
                                     (list#each product.left)
                                     (list#mix archive.composite archive))
                                 (list#each product.right successes)
                                 failures]})))
          (async#in (exception.except ..cannot_import_twice [module duplicates]))))

      (def (after_lux_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
              (..Return [<State> (List Text)])))
        (do ..monad
          [[archive state/* errors] (after_imports customs import! module duplicates new_dependencies archive)]
          (when errors
            (list.partial error _)
            (async#in {try.#Failure error})

            _
            (in [archive
                 (when state/*
                   {.#End}
                   state

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

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

      (def (compiler program global phase_wrapper extender expander platform program_module program_definition
                     all_extensions)
        (All (_ <type_vars>)
          (-> (Program expression declaration) (-> Archive Symbol (///translation.Operation <type_vars> expression))
              phase.Wrapper (Extender <type_vars>) Expander <Platform> Text (Maybe Module)
              (//init.Extensions <type_vars>)
              (///.Compiler <State> .Module)))
        (let [instancer (//init.compiler program global phase_wrapper extender expander syntax.prelude (the #write platform) program_module program_definition
                                         all_extensions)]
          (instancer $.key (list))))

      (def (custom_compiler import context platform compilation_sources configuration
                            compiler custom_key custom_format custom_compilation)
        (All (_ <type_vars>
                state document)
          (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State> .Module)
              (Key document) (Format document) (///.Compilation state document)
              (-> (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 [! ..monad]
              [.let [new_dependencies (the ///.#dependencies compilation)
                     [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)]
               [archive _ errors] (after_imports customs import! module duplicates new_dependencies archive)]
              (with_expansions [<cache_and_fail> (these (do !
                                                          [_ (cache/archive.cache! (the #file_system platform) configuration context archive)]
                                                          (async#in {try.#Failure error})))]
                (when errors
                  (list.partial error _)
                  <cache_and_fail>

                  _
                  (when ((the ///.#process compilation) state archive)
                    {try.#Success [state more|done]}
                    (when more|done
                      {.#Left more}
                      (again [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}
                    <cache_and_fail>)))))))

      (def (complete_lux_compilation context platform
                                     all_dependencies
                                     @module module entry
                                     archive state)
        (All (_ <type_vars>)
          (-> context.Context <Platform>
              (Set descriptor.Module)
              module.ID Text (archive.Entry Any)
              Archive <State>
              (Return <State>)))
        (do ..monad
          [_ (let [report (..module_compilation_log module state)]
               (with_expansions [<else> (in (debug.log! report))]
                 (for @.js (is (Async (Try Any))
                               (when 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 $.format (as (archive.Entry .Module) entry))]
          (async#in (do try.monad
                      [archive (archive.has module entry archive)]
                      (in [archive
                           (..with_reset_log state)])))))

      (def (lux_compiler import context platform compilation_sources configuration compiler compilation)
        (All (_ <type_vars>)
          (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State> .Module)
              (///.Compilation <State> .Module)
              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 [! ..monad]
              [.let [new_dependencies (the ///.#dependencies compilation)
                     [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)]
               [archive state errors] (after_lux_imports customs import! module duplicates new_dependencies [archive state])]
              (with_expansions [<cache_and_fail> (these (do !
                                                          [_ (cache/archive.cache! (the #file_system platform) configuration context archive)]
                                                          (async#in {try.#Failure error})))]
                (when errors
                  (list.partial error _)
                  <cache_and_fail>

                  _
                  (when (next_compilation module [archive state] compilation)
                    {try.#Success [state more|done]}
                    (when more|done
                      {.#Left more}
                      (again [archive state] more all_dependencies)

                      {.#Right entry}
                      (complete_lux_compilation context platform
                                                all_dependencies
                                                @module module entry
                                                archive state))

                    {try.#Failure error}
                    <cache_and_fail>)))))))

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

                        (def Fake_Document
                          Type
                          {.#Nominal (%.nat (static.random_nat)) (list)}))
           (these))

      (def (serial_compiler import context platform compilation_sources configuration compiler)
        (All (_ <type_vars>)
          (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State> .Module)
              Lux_Compiler))
        (function (_ all_customs importer import! @module [archive lux_state] module)
          (do [! ..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))
                                                 all_customs)
                                       all_customs)])
              (when customs
                {.#End}
                ((..lux_compiler import context platform compilation_sources configuration compiler (compiler input))
                 all_customs importer import! @module [archive lux_state] module)
                
                {.#Item [custom_state custom_key custom_format custom_parser custom_compiler] tail}
                (when (custom_compiler input)
                  {try.#Failure _}
                  (again tail)
                  
                  {try.#Success custom_compilation}
                  (do !
                    [[archive' custom_state'] ((..custom_compiler import context platform compilation_sources configuration
                                                                  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_literal
         (-> (List Text)
             (Try ///.Custom))))

      (exception.def .public (invalid_custom_compiler [definition type])
        (Exception [Symbol Type])
        (exception.report
         (list ["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 [///declaration.#analysis
                                    ///declaration.#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 program global lux_compiler phase_wrapper import file_context extender expander platform compilation context
                            all_extensions)
        (All (_ <type_vars>)
          (-> (Program expression declaration) (-> Archive Symbol (///translation.Operation <type_vars> expression))
              (-> Any ..Custom) phase.Wrapper Import context.Context (Extender <type_vars>) Expander <Platform> Compilation Lux_Context
              (//init.Extensions <type_vars>)
              Lux_Return))
        (do [! ..monad]
          [.let [[host_dependencies libraries compilers sources target program_module program_definition configuration] compilation
                 import! (|> (..compiler program global phase_wrapper extender expander platform program_module program_definition
                                         all_extensions)
                             (serial_compiler import file_context platform sources configuration)
                             (..parallel context))]
           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 program_module)))
      )))