Moved compiler machinery under lux/meta.

1 files changed, 291 insertions, 0 deletions

diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux
new file mode 100644
index 000000000..6d6704655
--- /dev/null
+++ b/stdlib/source/library/lux/meta/compiler/default/init.lux
@@ -0,0 +1,291 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    ["[0]" monad (.only do)]]
+   [control
+    ["[0]" try (.only Try)]
+    ["[0]" exception]]
+   [data
+    [binary (.only Binary)]
+    ["[0]" product]
+    ["[0]" text (.use "[1]#[0]" hash)
+     ["%" \\format (.only format)]]
+    [collection
+     ["[0]" list (.use "[1]#[0]" functor)]
+     ["[0]" dictionary]
+     ["[0]" set]
+     ["[0]" sequence (.use "[1]#[0]" functor)]]]
+   ["[0]" meta (.only)
+    ["@" target (.only Target)]
+    ["[0]" configuration (.only Configuration)]
+    ["[0]" version]]
+   [world
+    ["[0]" file]]]]
+ ["[0]" //
+  ["/[1]" // (.only Instancer)
+   ["[1][0]" phase]
+   [language
+    [lux
+     [program (.only Program)]
+     ["[1][0]" syntax (.only Aliases)]
+     ["[1][0]" synthesis]
+     ["[1][0]" declaration (.only Requirements)]
+     ["[1][0]" generation]
+     ["[1][0]" analysis (.only)
+      [macro (.only Expander)]
+      ["[1]/[0]" evaluation]
+      ["[0]A" module]]
+     [phase
+      ["[0]P" analysis]
+      ["[0]P" synthesis]
+      ["[0]P" declaration]
+      ["[0]" extension (.only Extender)
+       ["[0]E" analysis]
+       ["[0]E" synthesis]
+       [declaration
+        ["[0]D" lux]]]]]]
+   [meta
+    ["[0]" archive (.only Archive)
+     ["[0]" registry (.only Registry)]
+     ["[0]" module (.only)
+      ["[0]" descriptor]
+      ["[0]" document]]]]]])
+
+(def .public (state target module configuration expander host_analysis host generate generation_bundle)
+  (All (_ anchor expression declaration)
+    (-> Target
+        descriptor.Module
+        Configuration
+        Expander
+        ///analysis.Bundle
+        (///generation.Host expression declaration)
+        (///generation.Phase anchor expression declaration)
+        (///generation.Bundle anchor expression declaration)
+        (///declaration.State+ anchor expression declaration)))
+  (let [synthesis_state [synthesisE.bundle ///synthesis.init]
+        generation_state [generation_bundle (///generation.state host module)]
+        eval (///analysis/evaluation.evaluator expander synthesis_state generation_state generate)
+        analysis_state [(analysisE.bundle eval host_analysis)
+                        (///analysis.state (///analysis.info version.latest target configuration))]]
+    [extension.empty
+     [///declaration.#analysis [///declaration.#state analysis_state
+                                ///declaration.#phase (analysisP.phase expander)]
+      ///declaration.#synthesis [///declaration.#state synthesis_state
+                                 ///declaration.#phase synthesisP.phase]
+      ///declaration.#generation [///declaration.#state generation_state
+                                  ///declaration.#phase generate]]]))
+
+(def .public (with_default_declarations expander host_analysis program anchorT,expressionT,declarationT extender)
+  (All (_ anchor expression declaration)
+    (-> Expander
+        ///analysis.Bundle
+        (Program expression declaration)
+        [Type Type Type]
+        Extender
+        (-> (///declaration.State+ anchor expression declaration)
+            (///declaration.State+ anchor expression declaration))))
+  (function (_ [declaration_extensions sub_state])
+    [(dictionary.composite declaration_extensions
+                           (luxD.bundle expander host_analysis program anchorT,expressionT,declarationT extender))
+     sub_state]))
+
+(type Reader
+  (-> Source (Either [Source Text] [Source Code])))
+
+(def (reader current_module aliases [location offset source_code])
+  (-> descriptor.Module Aliases Source (///analysis.Operation Reader))
+  (function (_ [bundle state])
+    {try.#Success [[bundle state]
+                   (///syntax.parse current_module aliases ("lux text size" source_code))]}))
+
+(def (read source reader)
+  (-> Source Reader (///analysis.Operation [Source Code]))
+  (function (_ [bundle compiler])
+    (case (reader source)
+      {.#Left [source' error]}
+      {try.#Failure error}
+
+      {.#Right [source' output]}
+      (let [[location _] output]
+        {try.#Success [[bundle (|> compiler
+                                   (has .#source source')
+                                   (has .#location location))]
+                       [source' output]]}))))
+
+(type (Operation a)
+  (All (_ anchor expression declaration)
+    (///declaration.Operation anchor expression declaration a)))
+
+(type (Payload declaration)
+  [(///generation.Buffer declaration)
+   Registry])
+
+(def (begin dependencies hash input)
+  (-> (List descriptor.Module) Nat ///.Input
+      (All (_ anchor expression declaration)
+        (///declaration.Operation anchor expression declaration
+                                  [Source (Payload declaration)])))
+  (do ///phase.monad
+    [.let [module (the ///.#module input)]
+     _ (///declaration.set_current_module module)]
+    (///declaration.lifted_analysis
+     (do [! ///phase.monad]
+       [_ (moduleA.create hash module)
+        _ (monad.each ! moduleA.import dependencies)
+        .let [source (///analysis.source (the ///.#module input) (the ///.#code input))]
+        _ (///analysis.set_source_code source)]
+       (in [source [///generation.empty_buffer
+                    registry.empty]])))))
+
+(def (end module)
+  (-> descriptor.Module
+      (All (_ anchor expression declaration)
+        (///declaration.Operation anchor expression declaration [.Module (Payload declaration)])))
+  (do ///phase.monad
+    [_ (///declaration.lifted_analysis
+        (moduleA.set_compiled module))
+     analysis_module (<| (is (Operation .Module))
+                         ///declaration.lifted_analysis
+                         extension.lifted
+                         meta.current_module)
+     final_buffer (///declaration.lifted_generation
+                   ///generation.buffer)
+     final_registry (///declaration.lifted_generation
+                     ///generation.get_registry)]
+    (in [analysis_module [final_buffer
+                          final_registry]])))
+
+... TODO: Inline ASAP
+(def (get_current_payload _)
+  (All (_ declaration)
+    (-> (Payload declaration)
+        (All (_ anchor expression)
+          (///declaration.Operation anchor expression declaration
+                                    (Payload declaration)))))
+  (do ///phase.monad
+    [buffer (///declaration.lifted_generation
+             ///generation.buffer)
+     registry (///declaration.lifted_generation
+               ///generation.get_registry)]
+    (in [buffer registry])))
+
+... TODO: Inline ASAP
+(def (process_declaration wrapper archive expander pre_payoad code)
+  (All (_ declaration)
+    (-> ///phase.Wrapper Archive Expander (Payload declaration) Code
+        (All (_ anchor expression)
+          (///declaration.Operation anchor expression declaration
+                                    [Requirements (Payload declaration)]))))
+  (do ///phase.monad
+    [.let [[pre_buffer pre_registry] pre_payoad]
+     _ (///declaration.lifted_generation
+        (///generation.set_buffer pre_buffer))
+     _ (///declaration.lifted_generation
+        (///generation.set_registry pre_registry))
+     requirements (let [execute! (declarationP.phase wrapper expander)]
+                    (execute! archive code))
+     post_payload (..get_current_payload pre_payoad)]
+    (in [requirements post_payload])))
+
+(def (iteration' wrapper archive expander reader source pre_payload)
+  (All (_ declaration)
+    (-> ///phase.Wrapper Archive Expander Reader Source (Payload declaration)
+        (All (_ anchor expression)
+          (///declaration.Operation anchor expression declaration
+                                    [Source Requirements (Payload declaration)]))))
+  (do ///phase.monad
+    [[source code] (///declaration.lifted_analysis
+                    (..read source reader))
+     [requirements post_payload] (process_declaration wrapper archive expander pre_payload code)]
+    (in [source requirements post_payload])))
+
+(def (iteration wrapper archive expander module source pre_payload aliases)
+  (All (_ declaration)
+    (-> ///phase.Wrapper Archive Expander descriptor.Module Source (Payload declaration) Aliases
+        (All (_ anchor expression)
+          (///declaration.Operation anchor expression declaration
+                                    (Maybe [Source Requirements (Payload declaration)])))))
+  (do ///phase.monad
+    [reader (///declaration.lifted_analysis
+             (..reader module aliases source))]
+    (function (_ state)
+      (case (///phase.result' state (..iteration' wrapper archive expander reader source pre_payload))
+        {try.#Success [state source&requirements&buffer]}
+        {try.#Success [state {.#Some source&requirements&buffer}]}
+
+        {try.#Failure error}
+        (if (exception.match? ///syntax.end_of_file error)
+          {try.#Success [state {.#None}]}
+          (exception.with ///.cannot_compile module {try.#Failure error}))))))
+
+(def (default_dependencies prelude input)
+  (-> descriptor.Module ///.Input (List descriptor.Module))
+  (list.partial descriptor.runtime
+                (if (text#= prelude (the ///.#module input))
+                  (list)
+                  (list prelude))))
+
+(def module_aliases
+  (-> .Module Aliases)
+  (|>> (the .#module_aliases) (dictionary.of_list text.hash)))
+
+(def .public (compiler wrapper expander prelude write_declaration)
+  (All (_ anchor expression declaration)
+    (-> ///phase.Wrapper Expander descriptor.Module (-> declaration Binary)
+        (Instancer (///declaration.State+ anchor expression declaration) .Module)))
+  (let [execute! (declarationP.phase wrapper expander)]
+    (function (_ key parameters input)
+      (let [dependencies (default_dependencies prelude input)]
+        [///.#dependencies dependencies
+         ///.#process (function (_ state archive)
+                        (do [! try.monad]
+                          [.let [hash (text#hash (the ///.#code input))]
+                           [state [source buffer]] (<| (///phase.result' state)
+                                                       (..begin dependencies hash input))
+                           .let [module (the ///.#module input)]]
+                          (loop (again [iteration (<| (///phase.result' state)
+                                                      (..iteration wrapper archive expander module source buffer ///syntax.no_aliases))])
+                            (do !
+                              [[state ?source&requirements&temporary_payload] iteration]
+                              (case ?source&requirements&temporary_payload
+                                {.#None}
+                                (do !
+                                  [[state [analysis_module [final_buffer final_registry]]] (///phase.result' state (..end module))
+                                   .let [descriptor [descriptor.#hash hash
+                                                     descriptor.#name module
+                                                     descriptor.#file (the ///.#file input)
+                                                     descriptor.#references (set.of_list text.hash dependencies)
+                                                     descriptor.#state {.#Compiled}]]]
+                                  (in [state
+                                       {.#Right [[module.#id (try.else module.runtime (archive.id module archive))
+                                                  module.#descriptor descriptor
+                                                  module.#document (document.document key analysis_module)]
+                                                 (sequence#each (function (_ [artifact_id custom declaration])
+                                                                  [artifact_id custom (write_declaration declaration)])
+                                                                final_buffer)
+                                                 final_registry]}]))
+
+                                {.#Some [source requirements temporary_payload]}
+                                (let [[temporary_buffer temporary_registry] temporary_payload]
+                                  (in [state
+                                       {.#Left [///.#dependencies (|> requirements
+                                                                      (the ///declaration.#imports)
+                                                                      (list#each product.left))
+                                                ///.#process (function (_ state archive)
+                                                               (again (<| (///phase.result' state)
+                                                                          (do [! ///phase.monad]
+                                                                            [analysis_module (<| (is (Operation .Module))
+                                                                                                 ///declaration.lifted_analysis
+                                                                                                 extension.lifted
+                                                                                                 meta.current_module)
+                                                                             _ (///declaration.lifted_generation
+                                                                                (///generation.set_buffer temporary_buffer))
+                                                                             _ (///declaration.lifted_generation
+                                                                                (///generation.set_registry temporary_registry))
+                                                                             _ (|> requirements
+                                                                                   (the ///declaration.#referrals)
+                                                                                   (monad.each ! (execute! archive)))
+                                                                             temporary_payload (..get_current_payload temporary_payload)]
+                                                                            (..iteration wrapper archive expander module source temporary_payload (..module_aliases analysis_module))))))]}]))
+                                )))))]))))