aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2018-08-04 10:05:26 -0400
committerEduardo Julian2018-08-04 10:05:26 -0400
commit221cf3ea1bd48a8c678d3447558ea94631114ebc (patch)
treed5b7315718f9ec75576f5026783db5a5c752a6a3 /stdlib/source
parentc1f900baea30dbca55489c6afaf80dcfcda8813b (diff)
Made some adjustments to fit stdlib's compiler infrastructure to new-luxc.
Diffstat (limited to 'stdlib/source')
-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
6 files changed, 138 insertions, 115 deletions
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))))