Committing to Promise as the base monad for the compiler.

3 files changed, 79 insertions, 88 deletions

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]