aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux2
-rw-r--r--new-luxc/source/program.lux108
-rw-r--r--new-luxc/test/test/luxc/lang/translation/primitive.lux3
-rw-r--r--new-luxc/test/test/luxc/lang/translation/structure.lux2
-rw-r--r--stdlib/source/lux/cli.lux24
-rw-r--r--stdlib/source/lux/compiler/default.lux142
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/module.lux4
-rw-r--r--stdlib/source/lux/compiler/meta/io/context.lux32
-rw-r--r--stdlib/source/lux/io.lux23
-rw-r--r--stdlib/source/lux/world/file.lux28
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))))