diff options
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/def.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/program.lux | 108 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/primitive.lux | 3 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/structure.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/cli.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default.lux | 142 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/analysis/module.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/io/context.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/lux/io.lux | 23 | ||||
| -rw-r--r-- | stdlib/source/lux/world/file.lux | 28 |
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)))) |