Made some adjustments to fit stdlib's compiler infrastructure to new-luxc.

10 files changed, 212 insertions, 156 deletions

diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index 33ded893b..ff31157b0 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -5,7 +5,7 @@
      format]
     ["." product]
     [collection
-     ["a" array]
+     ["." array (#+ Array)]
      ["." list ("list/." Functor<List>)]]]
    ["." host (#+ import: do-to)]
    ["." function]]
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 62c3ad03d..7cb10b457 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -5,48 +5,59 @@
     ["p" parser]]
    [concurrency
     ["." promise (#+ Promise)]
-    [task (#+ Task)]]
+    ["." task (#+ Task)]]
    [data
     ["e" error]
     [text
      format]]
-   ["." io (#- run)]
+   ["." io (#+ IO Process io)]
    [time
     ["." instant]]
    ["." cli (#+ CLI program:)]
    [world
-    [file (#+ File)]]]
+    ["." file (#+ File)]]
+   [compiler
+    ["." default (#+ Configuration Platform)]]]
   [luxc
-   ["." repl]
+   ## ["." repl]
    [lang
-    [".L" translation]]])
+    ["." host/jvm]
+    [translation
+     ["." jvm
+      ["." runtime]
+      ["." expression]]]]])
 
 (type: Build
-  {#build-sources (List File)
-   #build-target File
-   #build-program Text})
+  [Configuration Text])
 
 (type: REPL
-  {#repl-sources (List File)
-   #repl-target File})
+  Configuration)
 
-(def: (param [short long])
-  (-> [Text Text] (CLI Text))
-  (cli.somewhere (p.after (p.either (cli.this short) (cli.this long))
-                          cli.any)))
+(do-template [<name> <short> <long>]
+  [(def: <name>
+     (CLI Text)
+     (cli.parameter [<short> <long>]))]
+
+  [source  "-s" "--source"]
+  [target  "-t" "--target"]
+  [program "-p" "--program"]
+  )
+
+(def: configuration
+  (CLI Configuration)
+  ($_ p.and
+      (p.some ..source)
+      ..target))
 
 (def: build
   (CLI Build)
-  ($_ p.seq
-      (p.some (param ["-s" "--source"]))
-      (param ["-t" "--target"])
-      (param ["-p" "--program"])))
+  ($_ p.and
+      configuration
+      ..program))
 
 (def: repl
   (CLI REPL)
-  ($_ p.seq
-      (p.some (param ["-s" "--source"]))
-      (param ["-t" "--target"])))
+  ..configuration)
 
 (type: Service
   (#Build Build)
@@ -58,7 +69,8 @@
         (p.after (cli.this "repl") repl)))
 
 (def: (or-crash! failure-describer action)
-  (All [a] (-> Text (Task a) (Promise a)))
+  (All [a]
+    (-> Text (Task a) (Promise a)))
   (do promise.Monad<Promise>
     [?output action]
     (case ?output
@@ -66,24 +78,44 @@
       (exec (log! (format "\n"
                           failure-describer "\n"
                           error "\n"))
-        ("lux io exit" 1))
+        (io.run (io.exit +1)))
 
       (#e.Success output)
       (wrap output))))
 
+(def: (timed action)
+  (All [a]
+    (-> (Process a) (Process a)))
+  (do io.Monad<Process>
+    [start (io.from-io instant.now)
+     result action
+     finish (io.from-io instant.now)
+     #let [elapsed-time (instant.span start finish)
+           _ (log! (format "\n" "Elapsed time: " (%duration elapsed-time)))]]
+    (wrap result)))
+
+(def: jvm-platform
+  (IO (Platform Process host/jvm.Anchor host/jvm.Inst host/jvm.Definition))
+  (do io.Monad<IO>
+    [host jvm.init]
+    (wrap {#default.host host
+           #default.phase expression.translate
+           #default.runtime runtime.translate
+           #default.file-system file.JVM@System})))
+
 (program: [{service ..service}]
-  (exec (case service
-          (#Build [sources target program])
-          (<| (or-crash! "Compilation failed:")
-              (promise.future
-               (do io.Monad<Process>
-                 [#let [start (io.run instant.now)]
-                  result (translationL.translate-program sources target program)
-                  #let [end (io.run instant.now)
-                        _ (log! (format "\n" "Elapsed time: " (%duration (instant.span start end))))]]
-                 (wrap result))))
-          
-          (#REPL [sources target])
-          (<| (or-crash! "REPL failed:")
-              (repl.run sources target)))
-    (io [])))
+  (do io.Monad<IO>
+    [platform ..jvm-platform]
+    (wrap (: (Promise Any)
+             (case service
+               (#Build [configuration program])
+               (<| (or-crash! "Compilation failed:")
+                   promise.future
+                   ..timed
+                   (default.compile platform configuration program))
+               
+               (#REPL configuration)
+               (undefined)
+               ## (<| (or-crash! "REPL failed:")
+               ##     (repl.run sources target))
+               )))))
diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux
index 12292e08c..08fab78aa 100644
--- a/new-luxc/test/test/luxc/lang/translation/primitive.lux
+++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux
@@ -43,7 +43,8 @@
             ))))
 
 (context: "[JVM] Primitives."
-  (<| (times 100)
+  (<| (seed 7147645721729046766)
+      ## (times 100)
       (spec run-jvm)))
 
 ## (context: "[JS] Primitives."
diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux
index cd1b88c9d..c92b132e2 100644
--- a/new-luxc/test/test/luxc/lang/translation/structure.lux
+++ b/new-luxc/test/test/luxc/lang/translation/structure.lux
@@ -9,7 +9,7 @@
     [text ("text/." Equivalence<Text>)
      format]
     [collection
-     ["." array]
+     ["." array (#+ Array)]
      ["." list ("list/." Functor<List>)]]]
    [math
     ["r" random]]
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index 1ad54189c..abb1d0c38 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -9,10 +9,14 @@
     ["." text ("text/." Equivalence<Text>)
      format]
     ["E" error]]
-   ["." io]
    [macro (#+ with-gensyms)
     ["." code]
-    ["s" syntax (#+ syntax: Syntax)]]])
+    ["s" syntax (#+ syntax: Syntax)]]
+   [compiler
+    ["." host]]
+   ["." io]
+   [concurrency
+    ["." process]]])
 
 ## [Types]
 (type: #export (CLI a)
@@ -92,6 +96,12 @@
       #.Nil (#E.Success [inputs []])
       _     (#E.Error (format "Unknown parameters: " (text.join-with " " inputs))))))
 
+(def: #export (parameter [short long])
+  (-> [Text Text] (CLI Text))
+  (|> ..any
+      (p.after (p.either (..this short) (..this long)))
+      ..somewhere))
+
 ## [Syntax]
 (type: Program-Args
   (#Raw Text)
@@ -144,14 +154,18 @@
                                               list/join))
                                       (~ g!_) ..end]
                                      ((~' wrap) ((~! do) (~! io.Monad<IO>)
-                                                 []
-                                                 (~ body)))))
+                                                 [(~ g!output) (~ body)
+                                                  (~+ (`` (for {(~~ (static host.jvm))
+                                                                (list)}
+                                                               (list g!_
+                                                                     (` process.run!)))))]
+                                                 ((~' wrap) (~ g!output))))))
                                  (~ g!args))
                             (#E.Success [(~ g!_) (~ g!output)])
                             (~ g!output)
 
                             (#E.Error (~ g!message))
-                            (error! (~ g!message))
+                            (.error! (~ g!message))
                             ))))
                     )))
       )))
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index d5b97ad36..c85df80c1 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #*
+  [lux (#- Source)
    [control
     [monad (#+ do)]
     ["ex" exception (#+ exception:)]]
@@ -13,9 +13,6 @@
      ["." dictionary]]]
    [type (#+ :share)]
    ["." macro]
-   [concurrency
-    ["." promise ("promise/." Monad<Promise>)]
-    ["." task (#+ Task)]]
    [world
     ["." file (#+ File)]]]
   [//
@@ -67,28 +64,32 @@
 ## ##                (format module-name "/" cache.descriptor-name)
 ## ##                (encoding.to-utf8 (%code (cache/description.write file-name module))))))
 
-(type: Configuration
+(type: #export Configuration
   {#sources (List File)
    #target File})
 
-(type: (Platform anchor expression statement)
+(type: #export (Platform fs anchor expression statement)
   {#host (Host expression statement)
    #phase (translation.Phase anchor expression statement)
    #runtime (translation.Operation anchor expression statement Any)
-   #file-system (file.System Task)})
+   #file-system (file.System fs)})
 
-(with-expansions [<Platform> (as-is (Platform anchor expression statement))
+(type: #export Source
+  {#name Text
+   #code Text})
+
+(with-expansions [<Platform> (as-is (Platform fs anchor expression statement))
                   <Operation> (as-is (statement.Operation anchor expression statement Any))
                   <Compiler> (as-is (statement.State+ anchor expression statement))]
   
-  (def: (begin-module-compilation module-name file-name source-code)
+  (def: (begin-module-compilation module-name source)
     (All [anchor expression statement]
-      (-> Text Text Text <Operation>))
+      (-> Text Source <Operation>))
     (statement.lift-analysis!
      (do phase.Monad<Operation>
-       [_ (module.create (text/hash source-code) module-name)
+       [_ (module.create (text/hash (get@ #code source)) module-name)
         _ (analysis.set-current-module module-name)]
-       (analysis.set-source-code (init.source file-name source-code)))))
+       (analysis.set-source-code (init.source (get@ #name source) (get@ #code source))))))
 
   (def: (end-module-compilation module-name)
     (All [anchor expression statement]
@@ -111,75 +112,76 @@
           _ (totalS.phase code)]
          (forgive-eof (recur []))))))
 
-  (def: (perform-module-compilation module-name file-name source-code)
+  (def: (perform-module-compilation module-name source)
     (All [anchor expression statement]
-      (-> Text Text Text <Operation>))
+      (-> Text Source <Operation>))
     (do phase.Monad<Operation>
-      [_ (begin-module-compilation module-name file-name source-code)
+      [_ (begin-module-compilation module-name source)
        _ (loop-module-compilation module-name)]
       (end-module-compilation module-name)))
 
   (def: #export (compile-module platform configuration module-name compiler)
-    (All [anchor expression statement]
-      (-> <Platform> Configuration Text <Compiler> (Task <Compiler>)))
-    (do task.Monad<Task>
-      [[file-name source-code] (context.read (get@ #file-system platform)
-                                             (get@ #sources configuration)
-                                             module-name)
-       [compiler' _] (<| promise/wrap
-                         (phase.run' compiler)
-                         (:share [anchor expression statement]
-                                 {<Platform>
-                                  platform}
-                                 {<Operation>
-                                  (perform-module-compilation module-name file-name source-code)}))
+    (All [fs anchor expression statement]
+      (-> <Platform> Configuration Text <Compiler> (fs <Compiler>)))
+    (do (:: (get@ #file-system platform) &monad)
+      [source (context.read (get@ #file-system platform)
+                            (get@ #sources configuration)
+                            module-name)
        ## _ (&io.prepare-module target-dir module-name)
        ## _ (write-module target-dir file-name module-name module artifacts)
        ]
-      (wrap compiler')))
-
-  (def: (initialize platform configuration)
-    (All [anchor expression statement]
-      (-> <Platform> Configuration (Task <Compiler>)))
-    (do task.Monad<Task>
-      [[compiler _] (|> platform
-                        (get@ #runtime)
-                        statement.lift-translation!
-                        (phase.run' (init.state (get@ #host platform)
-                                                (get@ #phase platform)))
-                        promise/wrap)
-       ## compiler (case (runtimeT.translate ## (initL.compiler (io.run js.init))
-       ##                 (initL.compiler (io.run hostL.init-host))
-       ##                 )
-       ##            ## (#error.Success [compiler disk-write])
-       ##            ## (do @
-       ##            ##   [_ (&io.prepare-target target)
-       ##            ##    _ disk-write
-       ##            ##    ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
-       ##            ##    ]
-       ##            ##   (wrap (|> compiler
-       ##            ##             (set@ [#.info #.mode] #.Build))))
-
-       ##            (#error.Success [compiler [runtime-bc function-bc]])
-       ##            (do @
-       ##              [_ (&io.prepare-target target)
-       ##               ## _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
-       ##               ## _ (&io.write target (format hostL.function-class ".class") function-bc)
-       ##               ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
-       ##               ]
-       ##              (wrap (|> compiler
-       ##                        (set@ [#.info #.mode] #.Build))))
-
-       ##            (#error.Error error)
-       ##            (io.fail error))
-       ]
-      (compile-module platform configuration prelude compiler)))
+      (<| (:: @ map product.left)
+          (:: (get@ #file-system platform) lift)
+          (phase.run' compiler)
+          (:share [fs anchor expression statement]
+                  {<Platform>
+                   platform}
+                  {<Operation>
+                   (perform-module-compilation module-name source)}))))
+
+  (def: (initialize-runtime platform configuration)
+    (All [fs anchor expression statement]
+      (-> <Platform> Configuration (fs <Compiler>)))
+    (|> platform
+        (get@ #runtime)
+        statement.lift-translation!
+        (phase.run' (init.state (get@ #host platform)
+                                (get@ #phase platform)))
+        (:: error.Functor<Error> map product.left)
+        (:: (get@ #file-system platform) lift))
+    
+    ## (case (runtimeT.translate ## (initL.compiler (io.run js.init))
+    ##        (initL.compiler (io.run hostL.init-host))
+    ##        )
+    ##   ## (#error.Success [compiler disk-write])
+    ##   ## (do @
+    ##   ##   [_ (&io.prepare-target target)
+    ##   ##    _ disk-write
+    ##   ##    ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
+    ##   ##    ]
+    ##   ##   (wrap (|> compiler
+    ##   ##             (set@ [#.info #.mode] #.Build))))
+
+    ##   (#error.Success [compiler [runtime-bc function-bc]])
+    ##   (do @
+    ##     [_ (&io.prepare-target target)
+    ##      ## _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
+    ##      ## _ (&io.write target (format hostL.function-class ".class") function-bc)
+    ##      ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
+    ##      ]
+    ##     (wrap (|> compiler
+    ##               (set@ [#.info #.mode] #.Build))))
+
+    ##   (#error.Error error)
+    ##   (io.fail error))
+    )
 
   (def: #export (compile platform configuration program)
-    (All [anchor expression statement]
-      (-> <Platform> Configuration Text (Task Any)))
-    (do task.Monad<Task>
-      [compiler (initialize platform configuration)
+    (All [fs anchor expression statement]
+      (-> <Platform> Configuration Text (fs Any)))
+    (do (:: (get@ #file-system platform) &monad)
+      [compiler (initialize-runtime platform configuration)
+       _ (compile-module platform configuration ..prelude compiler)
        _ (compile-module platform configuration program compiler)
        ## _ (cache/io.clean target ...)
        #let [_ (log! "Compilation complete!")]]
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/module.lux b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
index 47b7d7331..d8736ad72 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/module.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
@@ -20,7 +20,7 @@
 (type: #export Tag Text)
 
 (exception: #export (unknown-module {module Text})
-  module)
+  (ex.report ["Module" module]))
 
 (exception: #export (cannot-declare-tag-twice {module Text} {tag Text})
   (ex.report ["Module" module]
@@ -36,7 +36,7 @@
   )
 
 (exception: #export (cannot-define-more-than-once {name Name})
-  (%name name))
+  (ex.report ["Definition" (%name name)]))
 
 (exception: #export (can-only-change-state-of-active-module {module Text} {state Module-State})
   (ex.report ["Module" module]
diff --git a/stdlib/source/lux/compiler/meta/io/context.lux b/stdlib/source/lux/compiler/meta/io/context.lux
index b0a35cf61..615cd8d94 100644
--- a/stdlib/source/lux/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/compiler/meta/io/context.lux
@@ -9,7 +9,7 @@
      format
      ["." encoding]]]
    [world
-    ["." file (#+ File System)]
+    ["." file (#+ File)]
     [binary (#+ Binary)]]]
   ["." // (#+ Context Module)
    [///
@@ -18,7 +18,7 @@
 (type: #export Extension Text)
 
 (def: #export (file System<m> context module)
-  (All [m] (-> (System m) Context Module File))
+  (All [m] (-> (file.System m) Context Module File))
   (|> module
       (//.sanitize System<m>)
       (format context (:: System<m> separator))))
@@ -37,6 +37,8 @@
 
 (def: lux-extension Extension ".lux")
 
+(def: full-extension Extension (format host-extension lux-extension))
+
 (do-template [<name>]
   [(exception: #export (<name> {module Module})
      (ex.report ["Module" module]))]
@@ -46,7 +48,9 @@
   )
 
 (def: (find-source System<m> contexts module extension)
-  (All [m] (-> (System m) (List Context) Module Text (m (Maybe [Module File]))))
+  (All [fs]
+    (-> (file.System fs) (List Context) Module Extension
+        (fs (Maybe [Module File]))))
   (case contexts
     #.Nil
     (:: (:: System<m> &monad) wrap #.None)
@@ -57,10 +61,10 @@
        ? (file.exists? System<m> file)]
       (if ?
         (wrap (#.Some [module file]))
-        (find-source System<m> contexts' module)))))
+        (find-source System<m> contexts' module extension)))))
 
 (def: (try System<m> computations exception message)
-  (All [m a e] (-> (System m) (List (m (Maybe a))) (Exception e) e (m a)))
+  (All [m a e] (-> (file.System m) (List (m (Maybe a))) (Exception e) e (m a)))
   (case computations
     #.Nil
     (:: System<m> throw exception message)
@@ -77,20 +81,20 @@
 
 (type: #export Code Text)
 
-(def: #export (read System<m> contexts name)
-  (All [m]
-    (-> (System m) (List Context) Module
-        (m [Text Code])))
-  (let [find-source' (find-source System<m> contexts name)]
+(def: #export (read System<m> contexts module)
+  (All [fs]
+    (-> (file.System fs) (List Context) Module
+        (fs [Text Code])))
+  (let [find-source' (find-source System<m> contexts module)]
     (do (:: System<m> &monad)
       [[path file] (try System<m>
-                        (list (find-source' (format host-extension lux-extension))
-                              (find-source' lux-extension))
-                        module-not-found [name])
+                        (list (find-source' ..full-extension)
+                              (find-source' ..lux-extension))
+                        ..module-not-found [module])
        binary (:: System<m> read file)]
       (case (encoding.from-utf8 binary)
         (#error.Success code)
         (wrap [path code])
         
         (#error.Error _)
-        (:: System<m> throw cannot-read-module [name])))))
+        (:: System<m> throw ..cannot-read-module [module])))))
diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux
index 9295795be..5ec03c749 100644
--- a/stdlib/source/lux/io.lux
+++ b/stdlib/source/lux/io.lux
@@ -6,8 +6,9 @@
     [monad (#+ do Monad)]
     ["ex" exception (#+ Exception)]]
    [data
-    ["e" error (#+ Error)]
-    [collection [list]]]])
+    ["." error (#+ Error)]
+    [collection
+     [list]]]])
 
 (type: #export (IO a)
   {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."}
@@ -61,31 +62,35 @@
 
 (structure: #export _ (Functor Process)
   (def: (map f ma)
-    (io (:: e.Functor<Error> map f (run ma)))))
+    (io (:: error.Functor<Error> map f (run ma)))))
 
 (structure: #export _ (Apply Process)
   (def: functor Functor<Process>)
 
   (def: (apply ff fa)
-    (io (:: e.Apply<Error> apply (run ff) (run fa)))))
+    (io (:: error.Apply<Error> apply (run ff) (run fa)))))
 
 (structure: #export _ (Monad Process)
   (def: functor Functor<Process>)
 
   (def: (wrap x)
-    (io (:: e.Monad<Error> wrap x)))
+    (io (:: error.Monad<Error> wrap x)))
   
   (def: (join mma)
     (case (run mma)
-      (#e.Success ma)
+      (#error.Success ma)
       ma
       
-      (#e.Error error)
-      (io (#e.Error error)))))
+      (#error.Error error)
+      (io (#error.Error error)))))
+
+(def: #export from-io
+  (All [a] (-> (IO a) (Process a)))
+  (:: Functor<IO> map (|>> #error.Success)))
 
 (def: #export (fail error)
   (All [a] (-> Text (Process a)))
-  (io (#e.Error error)))
+  (io (#error.Error error)))
 
 (def: #export (throw exception message)
   (All [e a] (-> (Exception e) e (Process a)))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 912c448e9..76f03a835 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -2,8 +2,7 @@
   [lux #*
    [control
     ["." monad (#+ Monad do)]
-    ["ex" exception (#+ Exception exception:)]
-    pipe]
+    ["ex" exception (#+ Exception exception:)]]
    [data
     ["." error (#+ Error)]
     [text
@@ -105,20 +104,19 @@
 (`` (for {(~~ (static host.jvm))
           (as-is (import: #long java/io/File
                    (new [String])
-                   (exists [] #io #try boolean)
-                   (mkdirs [] #io #try boolean)
-                   (delete [] #io #try boolean)
+                   (~~ (do-template [<name>]
+                         [(<name> [] #io #try boolean)]
+
+                         [exists] [mkdirs] [delete]
+                         [isFile] [isDirectory]
+                         [canRead] [canWrite] [canExecute]))
+                   
                    (length [] #io #try long)
                    (listFiles [] #io #try #? (Array java/io/File))
                    (getAbsolutePath [] #io #try String)
                    (renameTo [java/io/File] #io #try boolean)
-                   (isFile [] #io #try boolean)
-                   (isDirectory [] #io #try boolean)
                    (lastModified [] #io #try long)
                    (setLastModified [long] #io #try boolean)
-                   (canRead [] #io #try boolean)
-                   (canWrite [] #io #try boolean)
-                   (canExecute [] #io #try boolean)
                    (#static separator String))
 
                  (import: java/lang/AutoCloseable
@@ -245,8 +243,8 @@
 
 (def: #export (exists? System<m> file)
   (All [m] (-> (System m) File (m Bit)))
-  (|> file
-      (do> (:: System<m> &monad)
-           [(:: System<m> file?)]
-           [(if> [(wrap #1)]
-                 [(:: System<m> directory? file)])])))
+  (do (:: System<m> &monad)
+    [??? (:: System<m> file? file)]
+    (if ???
+      (wrap #1)
+      (:: System<m> directory? file))))