From 647d18fde762b0797b5b31b69421d50ed326dcc5 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 29 Dec 2019 23:49:53 -0400
Subject: Committing to Promise as the base monad for the compiler.

---
 new-luxc/source/program.lux                        |  36 ++---
 .../source/lux/tool/compiler/default/platform.lux  | 104 +++++++--------
 .../source/lux/tool/compiler/meta/io/context.lux   |  56 ++++----
 .../source/lux/tool/compiler/phase/generation.lux  |   7 +-
 stdlib/source/lux/world/file.lux                   |   3 +-
 stdlib/source/program/compositor.lux               | 145 +++++++++++----------
 6 files changed, 175 insertions(+), 176 deletions(-)

diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 51f817b6f..507073ead 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -8,7 +8,9 @@
     ["." io (#+ IO)]
     ["." try (#+ Try)]
     [parser
-     [cli (#+ program:)]]]
+     [cli (#+ program:)]]
+    [concurrency
+     [promise (#+ Promise)]]]
    [data
     [text
      ["%" format (#+ format)]]
@@ -98,13 +100,12 @@
               apply-method))))
 
 (def: #export platform
-  ## (IO (Platform IO Anchor (Bytecode Any) Definition))
-  (IO (Platform IO _.Anchor _.Inst _.Definition))
+  ## (IO (Platform Anchor (Bytecode Any) Definition))
+  (IO (Platform _.Anchor _.Inst _.Definition))
   (do io.monad
     [## host jvm/host.host
      host jvm.host]
-    (wrap {#platform.&monad io.monad
-           #platform.&file-system file.system
+    (wrap {#platform.&file-system (file.async file.system)
            #platform.host host
            ## #platform.phase jvm.generate
            #platform.phase expression.translate
@@ -144,15 +145,16 @@
                                                (#/cli.Compilation configuration) configuration
                                                (#/cli.Interpretation configuration) configuration)
         jar-path (format target (:: file.system separator) "program.jar")]
-    (/.compiler @.jvm
-                ".jvm"
-                ..expander
-                analysis.bundle
-                ..platform
-                ## generation.bundle
-                translation.bundle
-                (directive.bundle extender)
-                jvm/program.program
-                ..extender
-                service
-                [(packager.package jvm/program.class) jar-path])))
+    (exec (/.compiler @.jvm
+                      ".jvm"
+                      ..expander
+                      analysis.bundle
+                      ..platform
+                      ## generation.bundle
+                      translation.bundle
+                      (directive.bundle extender)
+                      jvm/program.program
+                      ..extender
+                      service
+                      [(packager.package jvm/program.class) jar-path])
+      (io.io []))))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index aea0ca787..753ab8f5c 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -4,7 +4,9 @@
    [abstract
     ["." monad (#+ Monad do)]]
    [control
-    ["." try (#+ Try)]]
+    ["." try (#+ Try)]
+    [concurrency
+     ["." promise (#+ Promise)]]]
    [data
     ["." bit]
     ["." product]
@@ -36,9 +38,8 @@
    [compositor
     ["." cli (#+ Configuration)]]])
 
-(type: #export (Platform ! anchor expression directive)
-  {#&monad (Monad !)
-   #&file-system (file.System !)
+(type: #export (Platform anchor expression directive)
+  {#&file-system (file.System Promise)
    #host (generation.Host expression directive)
    #phase (generation.Phase anchor expression directive)
    #runtime (generation.Operation anchor expression directive Any)})
@@ -52,8 +53,8 @@
 ##                (format module-name "/" cache.descriptor-name)
 ##                (encoding.to-utf8 (%.code (cache/description.write file-name module))))))
 
-(with-expansions [<type-vars> (as-is [! anchor expression directive])
-                  <Platform> (as-is (Platform ! anchor expression directive))
+(with-expansions [<type-vars> (as-is [anchor expression directive])
+                  <Platform> (as-is (Platform anchor expression directive))
                   <State+> (as-is (///directive.State+ anchor expression directive))
                   <Bundle> (as-is (generation.Bundle anchor expression directive))]
 
@@ -68,6 +69,24 @@
     (set@ [#extension.state #///directive.generation #///directive.state #extension.state #generation.context]
           context
           state))
+
+  ## TODO: Inline ASAP
+  (def: initialize-buffer!
+    (All <type-vars>
+      (generation.Operation anchor expression directive Any))
+    (generation.set-buffer generation.empty-buffer))
+
+  ## TODO: Inline ASAP
+  (def: compile-runtime!
+    (All <type-vars>
+      (-> <Platform> (generation.Operation anchor expression directive Any)))
+    (get@ #runtime))
+
+  ## TODO: Inline ASAP
+  (def: save-runtime-buffer!
+    (All <type-vars>
+      (generation.Operation anchor expression directive (Buffer directive)))
+    (generation.save-buffer! ""))
   
   (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)
     (All <type-vars>
@@ -79,39 +98,24 @@
           (///directive.Bundle anchor expression directive)
           (-> expression directive)
           Extender
-          (! (Try <State+>))))
-    (|> (do ///phase.monad
-          [_ (:share [anchor expression directive]
-                     {(///directive.Bundle anchor expression directive)
-                      host-directive-bundle}
-                     {(generation.Operation anchor expression directive Any)
-                      (generation.set-buffer (:share [anchor expression directive]
-                                                     {(///directive.Bundle anchor expression directive)
-                                                      host-directive-bundle}
-                                                     {(Buffer directive)
-                                                      generation.empty-buffer}))})
-           _ (:share [anchor expression directive]
-                     {(///directive.Bundle anchor expression directive)
-                      host-directive-bundle}
-                     {(generation.Operation anchor expression directive Any)
-                      (get@ #runtime platform)})]
-          (:share [anchor expression directive]
-                  {(///directive.Bundle anchor expression directive)
-                   host-directive-bundle}
-                  {(generation.Operation anchor expression directive Any)
-                   (generation.save-buffer! "")}))
-        ///directive.lift-generation
-        (///phase.run' (//init.state target
-                                     expander
-                                     host-analysis
-                                     (get@ #host platform)
-                                     (get@ #phase platform)
-                                     generation-bundle
-                                     host-directive-bundle
-                                     program
-                                     extender))
-        (:: try.functor map product.left)
-        (:: (get@ #&monad platform) wrap))
+          (Promise (Try <State+>))))
+    (let [state (//init.state target
+                              expander
+                              host-analysis
+                              (get@ #host platform)
+                              (get@ #phase platform)
+                              generation-bundle
+                              host-directive-bundle
+                              program
+                              extender)]
+      (|> (do ///phase.monad
+            [_ ..initialize-buffer!
+             _ (..compile-runtime! platform)]
+            ..save-runtime-buffer!)
+          ///directive.lift-generation
+          (///phase.run' state)
+          (:: try.functor map product.left)
+          (:: promise.monad wrap)))
 
     ## (case (runtimeT.generate ## (initL.compiler (io.run js.init))
     ##        (initL.compiler (io.run hostL.init-host))
@@ -141,10 +145,9 @@
 
   (def: #export (compile partial-host-extension expander platform configuration archive state)
     (All <type-vars>
-      (-> Text Expander <Platform> Configuration Archive <State+> (! (Try [Archive <State+>]))))
-    (let [monad (get@ #&monad platform)
-          source-module (get@ #cli.module configuration)
-          compiler (:share [anchor expression directive]
+      (-> Text Expander <Platform> Configuration Archive <State+> (Promise (Try [Archive <State+>]))))
+    (let [source-module (get@ #cli.module configuration)
+          compiler (:share <type-vars>
                            {<State+>
                             state}
                            {(///.Compiler <State+> .Module Any)
@@ -152,16 +155,15 @@
       (loop [module source-module
              [archive state] [archive state]]
         (if (archive.archived? archive module)
-          (:: monad wrap (#try.Success [archive state]))
+          (:: promise.monad wrap (#try.Success [archive state]))
           (let [import! (:share <type-vars>
                                 {<Platform>
                                  platform}
                                 {(-> Module [Archive <State+>]
-                                     (! (Try [Archive <State+>])))
+                                     (Promise (Try [Archive <State+>])))
                                  recur})]
-            (do (try.with monad)
-              [input (context.read monad
-                                   (get@ #&file-system platform)
+            (do (try.with promise.monad)
+              [input (context.read (get@ #&file-system platform)
                                    (get@ #cli.sources configuration)
                                    partial-host-extension
                                    module)
@@ -189,7 +191,7 @@
                                            {<Platform>
                                             platform}
                                            {(-> Archive <State+> (///.Compilation <State+> .Module Any)
-                                                (! (Try [Archive <State+>])))
+                                                (Promise (Try [Archive <State+>])))
                                             recur})]]
                   (case ((get@ #///.process compilation)
                          (case dependencies
@@ -216,8 +218,8 @@
                         (wrap [archive state])
                         
                         (#try.Failure error)
-                        (:: monad wrap (#try.Failure error))))
+                        (:: promise.monad wrap (#try.Failure error))))
 
                     (#try.Failure error)
-                    (:: monad wrap (#try.Failure error)))))))))))
+                    (:: promise.monad wrap (#try.Failure error)))))))))))
   )
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index cc23f11be..1313386d5 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -7,15 +7,16 @@
     ["." try (#+ Try)]
     ["ex" exception (#+ Exception exception:)]
     [security
-     ["!" capability]]]
+     ["!" capability]]
+    [concurrency
+     ["." promise (#+ Promise)]]]
    [data
     [binary (#+ Binary)]
     ["." text ("#;." hash)
      ["%" format (#+ format)]
      ["." encoding]]]
    [world
-    ["." file (#+ Path File)]]
-   [type (#+ :share)]]
+    ["." file (#+ Path File)]]]
   ["." // (#+ Context Code)
    ["#/" // #_
     [archive
@@ -42,16 +43,15 @@
       (//.sanitize system)
       (format context (:: system separator))))
 
-(def: (find-source-file monad system contexts module extension)
-  (All [!]
-    (-> (Monad !) (file.System !) (List Context) Module Extension
-        (! (Try [Path (File !)]))))
+(def: (find-source-file system contexts module extension)
+  (-> (file.System Promise) (List Context) Module Extension
+      (Promise (Try [Path (File Promise)])))
   (case contexts
     #.Nil
-    (:: monad wrap (ex.throw ..cannot-find-module [module]))
+    (:: promise.monad wrap (ex.throw ..cannot-find-module [module]))
 
     (#.Cons context contexts')
-    (do monad
+    (do promise.monad
       [#let [path (format (..path system context module) extension)]
        file (!.use (:: system file) path)]
       (case file
@@ -59,38 +59,26 @@
         (wrap (#try.Success [path file]))
 
         (#try.Failure _)
-        (find-source-file monad system contexts' module extension)))))
+        (find-source-file system contexts' module extension)))))
 
-(def: #export (find-any-source-file monad system contexts partial-host-extension module)
-  (All [!]
-    (-> (Monad !) (file.System !) (List Context) Text Module
-        (! (Try [Path (File !)]))))
+(def: #export (find-any-source-file system contexts partial-host-extension module)
+  (-> (file.System Promise) (List Context) Text Module
+      (Promise (Try [Path (File Promise)])))
   (let [full-host-extension (format partial-host-extension lux-extension)]
-    (do monad
-      [outcome (find-source-file monad system contexts module full-host-extension)]
+    (do promise.monad
+      [outcome (find-source-file system contexts module full-host-extension)]
       (case outcome
         (#try.Success output)
         (wrap outcome)
 
         (#try.Failure _)
-        (find-source-file monad system contexts module ..lux-extension)))))
+        (find-source-file system contexts module ..lux-extension)))))
 
-(def: #export (read monad system contexts partial-host-extension module)
-  (All [!]
-    (-> (Monad !) (file.System !) (List Context) Text Module
-        (! (Try Input))))
-  (do (try.with monad)
-    [## TODO: Get rid of both ":share"s ASAP
-     path,file (:share [!]
-                       {(Monad !)
-                        monad}
-                       {(! (Try [Path (File !)]))
-                        (find-any-source-file monad system contexts partial-host-extension module)})
-     #let [[path file] (:share [!]
-                               {(Monad !)
-                                monad}
-                               {[Path (File !)]
-                                path,file})]
+(def: #export (read system contexts partial-host-extension module)
+  (-> (file.System Promise) (List Context) Text Module
+      (Promise (Try Input)))
+  (do (try.with promise.monad)
+    [[path file] (..find-any-source-file system contexts partial-host-extension module)
      binary (!.use (:: file content) [])]
     (case (encoding.from-utf8 binary)
       (#try.Success code)
@@ -100,4 +88,4 @@
              #////.code code})
       
       (#try.Failure _)
-      (:: monad wrap (ex.throw ..cannot-read-module [module])))))
+      (:: promise.monad wrap (ex.throw ..cannot-read-module [module])))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux
index 35fa850be..ca2d76965 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation.lux
@@ -263,10 +263,11 @@
 
 (def: #export (save-buffer! target)
   (All [anchor expression directive]
-    (-> Module (Operation anchor expression directive Any)))
+    (-> Module (Operation anchor expression directive (Buffer directive))))
   (do //.monad
-    [buffer ..buffer]
-    (extension.update (update@ #output (row.add [target buffer])))))
+    [buffer ..buffer
+     _ (extension.update (update@ #output (row.add [target buffer])))]
+    (wrap buffer)))
 
 (def: #export (remember lux-name)
   (All [anchor expression directive]
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 6ed752f74..6310a47b9 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -348,7 +348,8 @@
                                         (function (discard _)
                                           (!delete path cannot-discard-directory)))))
 
-                                   (structure: #export system (System IO)
+                                   (structure: #export system
+                                     (System IO)
                                      (~~ (template [<name> <method> <capability> <exception>]
                                            [(def: <name>
                                               (..can-open
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 31f018081..53598f8b5 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -9,7 +9,9 @@
     [parser
      [cli (#+ program:)]]
     [security
-     ["!" capability]]]
+     ["!" capability]]
+    [concurrency
+     ["." promise (#+ Promise)]]]
    [data
     [binary (#+ Binary)]
     ["." product]
@@ -44,84 +46,87 @@
 
 (def: (or-crash! failure-description action)
   (All [a]
-    (-> Text (IO (Try a)) (IO a)))
-  (do io.monad
+    (-> Text (Promise (Try a)) (Promise a)))
+  (do promise.monad
     [?output action]
     (case ?output
       (#try.Failure error)
       (exec (log! (format text.new-line
                           failure-description text.new-line
                           error text.new-line))
-        (io.exit +1))
+        (io.run (io.exit +1)))
 
       (#try.Success output)
       (wrap output))))
 
-(def: (save-artifacts! system state [packager package])
-  (All [anchor expression directive]
-    (-> (file.System IO)
-        (directive.State+ anchor expression directive)
-        [(-> (generation.Output directive) Binary) Path]
-        (IO (Try Any))))
-  (let [?outcome (phase.run' state
-                             (:share [anchor expression directive]
-                                     {(directive.State+ anchor expression directive)
-                                      state}
-                                     {(directive.Operation anchor expression directive
-                                                           (generation.Output directive))
-                                      (directive.lift-generation generation.output)}))]
-    (case ?outcome
-      (#try.Success [state output])
-      (do (try.with io.monad)
-        [file (: (IO (Try (File IO)))
-                 (file.get-file io.monad system package))]
-        (!.use (:: file over-write) (packager output)))
+(with-expansions [<parameters> (as-is anchor expression artifact)]
+  (def: (save-artifacts! system state [packager package])
+    (All [<parameters>]
+      (-> (file.System Promise)
+          (directive.State+ <parameters>)
+          [(-> (generation.Output artifact) Binary) Path]
+          (Promise (Try Any))))
+    (let [?outcome (phase.run' state
+                               (:share [<parameters>]
+                                       {(directive.State+ <parameters>)
+                                        state}
+                                       {(directive.Operation <parameters>
+                                                             (generation.Output artifact))
+                                        (directive.lift-generation generation.output)}))]
+      (case ?outcome
+        (#try.Success [state output])
+        (do (try.with promise.monad)
+          [file (: (Promise (Try (File Promise)))
+                   (file.get-file promise.monad system package))]
+          (!.use (:: file over-write) (packager output)))
 
-      (#try.Failure error)
-      (:: io.monad wrap (#try.Failure error)))))
+        (#try.Failure error)
+        (:: promise.monad wrap (#try.Failure error)))))
 
-(def: #export (compiler target partial-host-extension
-                        expander host-analysis platform generation-bundle host-directive-bundle program extender
-                        service
-                        packager,package)
-  (All [anchor expression directive]
-    (-> Text
-        Text
-        Expander
-        analysis.Bundle
-        (IO (Platform IO anchor expression directive))
-        (generation.Bundle anchor expression directive)
-        (directive.Bundle anchor expression directive)
-        (-> expression directive)
-        Extender
-        Service
-        [(-> (generation.Output directive) Binary) Path]
-        (IO Any)))
-  (do io.monad
-    [platform platform
-     console (:: @ map try.assume console.system)]
-    (case service
-      (#cli.Compilation configuration)
-      (<| (or-crash! "Compilation failed:")
-          (do (try.with io.monad)
-            [state (:share [anchor expression directive]
-                           {(Platform IO anchor expression directive)
-                            platform}
-                           {(IO (Try (directive.State+ anchor expression directive)))
-                            (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)})
-             [archive state] (:share [anchor expression directive]
-                                     {(Platform IO anchor expression directive)
-                                      platform}
-                                     {(IO (Try [Archive (directive.State+ anchor expression directive)]))
-                                      (platform.compile partial-host-extension expander platform configuration archive.empty state)})
-             _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
-             ## _ (cache/io.clean target ...)
-             ]
-            (wrap (log! "Compilation complete!"))))
-      
-      (#cli.Interpretation configuration)
-      ## TODO: Fix the interpreter...
-      (undefined)
-      ## (<| (or-crash! "Interpretation failed:")
-      ##     (interpreter.run (try.with io.monad) console platform configuration generation-bundle))
-      )))
+  (def: #export (compiler target partial-host-extension
+                          expander host-analysis platform generation-bundle host-directive-bundle program extender
+                          service
+                          packager,package)
+    (All [<parameters>]
+      (-> Text
+          Text
+          Expander
+          analysis.Bundle
+          (IO (Platform <parameters>))
+          (generation.Bundle <parameters>)
+          (directive.Bundle <parameters>)
+          (-> expression artifact)
+          Extender
+          Service
+          [(-> (generation.Output artifact) Binary) Path]
+          (Promise Any)))
+    (do promise.monad
+      [platform (promise.future platform)
+       console (|> console.system
+                   promise.future
+                   (:: @ map (|>> try.assume console.async)))]
+      (case service
+        (#cli.Compilation configuration)
+        (<| (or-crash! "Compilation failed:")
+            (do (try.with promise.monad)
+              [state (:share [<parameters>]
+                             {(Platform <parameters>)
+                              platform}
+                             {(Promise (Try (directive.State+ <parameters>)))
+                              (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)})
+               [archive state] (:share [<parameters>]
+                                       {(Platform <parameters>)
+                                        platform}
+                                       {(Promise (Try [Archive (directive.State+ <parameters>)]))
+                                        (platform.compile partial-host-extension expander platform configuration archive.empty state)})
+               _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
+               ## _ (cache/io.clean target ...)
+               ]
+              (wrap (log! "Compilation complete!"))))
+        
+        (#cli.Interpretation configuration)
+        ## TODO: Fix the interpreter...
+        (undefined)
+        ## (<| (or-crash! "Interpretation failed:")
+        ##     (interpreter.run (try.with promise.monad) console platform configuration generation-bundle))
+        ))))
-- 
cgit v1.2.3