First-class programs instead of having a "lux program" extension.

6 files changed, 144 insertions, 157 deletions

diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux
index 6d6704655..019edf1c5 100644
--- a/stdlib/source/library/lux/meta/compiler/default/init.lux
+++ b/stdlib/source/library/lux/meta/compiler/default/init.lux
@@ -27,7 +27,7 @@
    ["[1][0]" phase]
    [language
     [lux
-     [program (.only Program)]
+     ["[1][0]" program (.only Program)]
      ["[1][0]" syntax (.only Aliases)]
      ["[1][0]" synthesis]
      ["[1][0]" declaration (.only Requirements)]
@@ -47,6 +47,7 @@
         ["[0]D" lux]]]]]]
    [meta
     ["[0]" archive (.only Archive)
+     ["[0]" unit]
      ["[0]" registry (.only Registry)]
      ["[0]" module (.only)
       ["[0]" descriptor]
@@ -230,62 +231,93 @@
   (-> .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]}]))
+(with_expansions [<parameters> (these anchor expression declaration)]
+  (def (define_program! archive program global program_module program_definition)
+    (All (_ <parameters>)
+      (-> Archive
+          (Program expression declaration) (-> Archive Symbol (///generation.Operation <parameters> expression))
+          descriptor.Module Text
+          (///generation.Operation <parameters> Any)))
+    (do ///phase.monad
+      [ [@program _] (///generation.definition archive [program_module program_definition])
+        @self (///generation.learn [///program.name {.#None}] true (set.has @program (set.empty unit.hash)))
+
+        |program| (global archive [program_module program_definition])
+        @module (///phase.lifted (archive.id program_module archive))]
+      (///generation.save! @self {.#None} (program [@module @self] |program|))))
+
+  (def .public (compiler program global wrapper expander prelude write_declaration program_module program_definition)
+    (All (_ anchor expression declaration)
+      (-> (Program expression declaration) (-> Archive Symbol (///generation.Operation <parameters> expression))
+          ///phase.Wrapper Expander descriptor.Module (-> declaration Binary)
+          descriptor.Module (Maybe Text)
+          (Instancer (///declaration.State+ <parameters>) .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)
+                                         (do [! ///phase.monad]
+                                           [_ (if (text#= program_module module)
+                                                (case program_definition
+                                                  {.#Some program_definition}
+                                                  (///declaration.lifted_generation
+                                                   (define_program! archive program global program_module program_definition))
+                                                  
+                                                  {.#None}
+                                                  (in []))
+                                                (in []))]
+                                           (..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))))))]}]))
-                                )))))]))))
+                                  {.#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))))))]}]))
+                                  )))))]))))
+  )
diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux
index 436d6bac3..b0ce99018 100644
--- a/stdlib/source/library/lux/meta/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux
@@ -1,6 +1,6 @@
 (.require
  [library
-  [lux (.except)
+  [lux (.except Module)
    ["[0]" debug]
    [abstract
     ["[0]" monad (.only Monad do)]]
@@ -64,7 +64,7 @@
      ["[0]" registry (.only Registry)]
      ["[0]" artifact]
      ["[0]" module (.only)
-      ["[0]" descriptor (.only Descriptor)]
+      ["[0]" descriptor (.only Descriptor Module)]
       ["[0]" document (.only Document)]]]
     ["[0]" io
      ["_[1]" /]
@@ -693,11 +693,12 @@
              product.left)
          archive))
 
-      (def (compiler phase_wrapper expander platform)
+      (def (compiler program global phase_wrapper expander platform program_module program_definition)
         (All (_ <type_vars>)
-          (-> ///phase.Wrapper Expander <Platform>
+          (-> (Program expression declaration) (-> Archive Symbol (///generation.Operation <type_vars> expression))
+              ///phase.Wrapper Expander <Platform> Text (Maybe Module)
               (///.Compiler <State+> .Module Any)))
-        (let [instancer (//init.compiler phase_wrapper expander syntax.prelude (the #write platform))]
+        (let [instancer (//init.compiler program global phase_wrapper expander syntax.prelude (the #write platform) program_module program_definition)]
           (instancer $.key (list))))
 
       (def (custom_compiler import context platform compilation_sources compiler
@@ -868,11 +869,13 @@
                         {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)
+      (def .public (compile program global 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)
+          (-> (Program expression declaration) (-> Archive Symbol (///generation.Operation <type_vars> expression))
+              (-> Any ..Custom) ///phase.Wrapper Import context.Context Expander <Platform> Compilation Lux_Context
+              Lux_Return))
+        (let [[host_dependencies libraries compilers sources target program_module program_definition configuration] compilation
+              import! (|> (..compiler program global phase_wrapper expander platform program_module program_definition)
                           (serial_compiler import file_context platform sources)
                           (..parallel context))]
           (do [! ..monad]
@@ -884,5 +887,5 @@
                                                       lux_compiler
                                                       (function.on parameters))))))
                          (monad.all !))]
-            (import! customs descriptor.runtime module))))
+            (import! customs descriptor.runtime program_module))))
       )))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
index 5c0593b49..b127af8c6 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
@@ -271,7 +271,7 @@
                  (/////generation.log! (format tag " : Tag of " (%.type owner))))
                labels)))
 
-(def (deftype_tagged expander host_analysis)
+(def (def_type_tagged expander host_analysis)
   (-> Expander /////analysis.Bundle Handler)
   (..custom
    [(all <>.and <code>.local <code>.any
@@ -459,83 +459,27 @@
          (phase.except ///.invalid_syntax [extension_name %.code inputsC+]))))]
 
   ["Analysis"
-   defanalysis
+   def_analysis
    /////analysis.Handler /////analysis.Handler
    /////declaration.lifted_analysis
    ..analyser]
   ["Synthesis"
-   defsynthesis
+   def_synthesis
    /////synthesis.Handler /////synthesis.Handler
    /////declaration.lifted_synthesis
    ..synthesizer]
   ["Generation"
-   defgeneration
+   def_generation
    (/////generation.Handler anchorT expressionT declarationT) (/////generation.Handler anchor expression declaration)
    /////declaration.lifted_generation
    ..generator]
   ["Declaration"
-   defdeclaration
+   def_declaration
    (/////declaration.Handler anchorT expressionT declarationT) (/////declaration.Handler anchor expression declaration)
    (<|)
    ..declaration]
   )
 
-... TODO; Both "prepare-program" and "define-program" exist only
-... because the old compiler couldn't handle a fully-inlined definition
-... for "defprogram". Inline them ASAP.
-(def (prepare_program archive analyse synthesize programC)
-  (All (_ anchor expression declaration output)
-    (-> Archive
-        /////analysis.Phase
-        /////synthesis.Phase
-        Code
-        (Operation anchor expression declaration Synthesis)))
-  (do phase.monad
-    [[_ programA] (<| /////declaration.lifted_analysis
-                      scope.with
-                      typeA.fresh
-                      (typeA.expecting (type_literal (-> (List Text) (IO Any))))
-                      (analyse archive programC))]
-    (/////declaration.lifted_synthesis
-     (synthesize archive programA))))
-
-(def (define_program archive @module generate program programS)
-  (All (_ anchor expression declaration output)
-    (-> Archive
-        module.ID
-        (/////generation.Phase anchor expression declaration)
-        (Program expression declaration)
-        Synthesis
-        (/////generation.Operation anchor expression declaration Any)))
-  (do phase.monad
-    [dependencies (cache/artifact.dependencies archive programS)
-     [interim_artifacts programG] (/////generation.with_interim_artifacts archive
-                                    (generate archive programS))
-     @self (/////generation.learn [/////program.name {.#None}] true (list#mix set.has dependencies interim_artifacts))]
-    (/////generation.save! @self {.#None} (program [@module @self] programG))))
-
-(def (defprogram program)
-  (All (_ anchor expression declaration)
-    (-> (Program expression declaration) (Handler anchor expression declaration)))
-  (function (handler extension_name phase archive inputsC+)
-    (case inputsC+
-      (list programC)
-      (do phase.monad
-        [state (///.lifted phase.state)
-         .let [analyse (the [/////declaration.#analysis /////declaration.#phase] state)
-               synthesize (the [/////declaration.#synthesis /////declaration.#phase] state)
-               generate (the [/////declaration.#generation /////declaration.#phase] state)]
-         programS (prepare_program archive analyse synthesize programC)
-         current_module (/////declaration.lifted_analysis
-                         (///.lifted meta.current_module_name))
-         @module (phase.lifted (archive.id current_module archive))
-         _ (/////declaration.lifted_generation
-            (define_program archive @module generate program programS))]
-        (in /////declaration.no_requirements))
-
-      _
-      (phase.except ///.invalid_syntax [extension_name %.code inputsC+]))))
-
 (def (bundle::def expander host_analysis program anchorT,expressionT,declarationT extender)
   (All (_ anchor expression declaration)
     (-> Expander
@@ -548,12 +492,11 @@
       (|> ///bundle.empty
           (dictionary.has "module" defmodule)
           (dictionary.has "alias" defalias)
-          (dictionary.has "type tagged" (deftype_tagged expander host_analysis))
-          (dictionary.has "analysis" (defanalysis anchorT,expressionT,declarationT extender))
-          (dictionary.has "synthesis" (defsynthesis anchorT,expressionT,declarationT extender))
-          (dictionary.has "generation" (defgeneration anchorT,expressionT,declarationT extender))
-          (dictionary.has "declaration" (defdeclaration anchorT,expressionT,declarationT extender))
-          (dictionary.has "program" (defprogram program))
+          (dictionary.has "type tagged" (def_type_tagged expander host_analysis))
+          (dictionary.has "analysis" (def_analysis anchorT,expressionT,declarationT extender))
+          (dictionary.has "synthesis" (def_synthesis anchorT,expressionT,declarationT extender))
+          (dictionary.has "generation" (def_generation anchorT,expressionT,declarationT extender))
+          (dictionary.has "declaration" (def_declaration anchorT,expressionT,declarationT extender))
           )))
 
 (def .public (bundle expander host_analysis program anchorT,expressionT,declarationT extender)
diff --git a/stdlib/source/library/lux/meta/compiler/meta/cli.lux b/stdlib/source/library/lux/meta/compiler/meta/cli.lux
index 72e8b7ef1..21d0885ad 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/cli.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/cli.lux
@@ -56,6 +56,7 @@
     #sources (List Source)
     #target Target
     #module Module
+    #program (Maybe Text)
     #configuration Configuration]))
 
 (type .public Interpretation
@@ -84,6 +85,10 @@
   [configuration_parser "--configuration" Configuration (<text>.then configuration.parser <program>.any)]
   )
 
+(def program_parser
+  (Parser (Maybe Text))
+  (<>.maybe (<program>.named "--program" <program>.any)))
+
 (def .public service
   (Parser Service)
   (let [compilation (is (Parser Compilation)
@@ -94,6 +99,7 @@
                              (<>.some ..source_parser)
                              ..target_parser
                              ..module_parser
+                             ..program_parser
                              (<>.else configuration.empty ..configuration_parser)))]
     (all <>.or
          (<>.after (<program>.this "build")
diff --git a/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux
index 39bc028af..1c0d70dc2 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux
@@ -1,7 +1,6 @@
 (.require
  [library
   [lux (.except)
-   [type (.only sharing)]
    [abstract
     ["[0]" monad (.only do)]]
    [control
@@ -22,6 +21,7 @@
     [number
      ["[0]" nat]]]
    [meta
+    [type (.only sharing)]
     [target
      ["_" ruby]]]
    [world
diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux
index f7fd562eb..acfe5a74c 100644
--- a/stdlib/source/library/lux/program.lux
+++ b/stdlib/source/library/lux/program.lux
@@ -5,7 +5,7 @@
     [monad (.only do)]]
    [control
     ["<>" parser]
-    ["[0]" io]
+    ["[0]" io (.only IO)]
     [concurrency
      ["[0]" thread]]]
    [meta
@@ -16,6 +16,9 @@
      [syntax (.only syntax)]]]]]
  ["</>" \\parser])
 
+(type .public Program
+  (-> (List Text) (IO Any)))
+
 (type Arguments
   (Variant
    {#Raw Text}
@@ -26,7 +29,7 @@
   (<>.or <code>.local
          (<code>.tuple (<>.some <code>.any))))
 
-(def .public program:
+(def .public program
   (syntax (_ [args ..arguments^
               body <code>.any])
     (with_symbols [g!program g!args g!_ g!output g!message]
@@ -39,22 +42,22 @@
                                                [(, g!output) (, body)
                                                 (, g!_) (,! thread.run!)]
                                                ((,' in) (, g!output)))))]
-        (in (list (` ("lux def program"
-                      (, (case args
-                           {#Raw args}
-                           (` (.function ((, g!program) (, (code.symbol ["" args])))
-                                (, initialization+event_loop)))
-                           
-                           {#Parsed args}
-                           (` (.function ((, g!program) (, g!args))
-                                (case ((,! </>.result) (.is (,! (</>.Parser (io.IO .Any)))
-                                                            ((,! do) (,! <>.monad)
-                                                             [(,* args)
-                                                              (, g!_) (,! </>.end)]
-                                                             ((,' in) (, initialization+event_loop))))
-                                       (, g!args))
-                                  {.#Right (, g!output)}
-                                  (, g!output)
+        (in (list (` (is Program
+                         (, (case args
+                              {#Raw args}
+                              (` (.function ((, g!program) (, (code.symbol ["" args])))
+                                   (, initialization+event_loop)))
+                              
+                              {#Parsed args}
+                              (` (.function ((, g!program) (, g!args))
+                                   (case ((,! </>.result) (.is (,! (</>.Parser (io.IO .Any)))
+                                                               ((,! do) (,! <>.monad)
+                                                                [(,* args)
+                                                                 (, g!_) (,! </>.end)]
+                                                                ((,' in) (, initialization+event_loop))))
+                                          (, g!args))
+                                     {.#Right (, g!output)}
+                                     (, g!output)
 
-                                  {.#Left (, g!message)}
-                                  (.panic! (, g!message)))))))))))))))
+                                     {.#Left (, g!message)}
+                                     (.panic! (, g!message)))))))))))))))