aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/tool/compiler.lux21
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux91
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive.lux37
4 files changed, 99 insertions, 64 deletions
diff --git a/stdlib/source/lux/tool/compiler.lux b/stdlib/source/lux/tool/compiler.lux
index e151c9e94..12a2f869c 100644
--- a/stdlib/source/lux/tool/compiler.lux
+++ b/stdlib/source/lux/tool/compiler.lux
@@ -1,7 +1,7 @@
(.module:
[lux (#- Module Source Code)
[control
- ["ex" exception (#+ exception:)]]
+ ["." exception (#+ exception:)]]
[data
["." error (#+ Error)]
[collection
@@ -30,17 +30,18 @@
(type: #export (Output o)
(Dictionary Text o))
-(type: #export (Compilation d o)
+(type: #export (Compilation s d o)
{#dependencies (List Module)
- #process (-> Archive
- (Error (Either (Compilation d o)
- [[Descriptor (Document d)] (Output o)])))})
+ #process (-> s Archive
+ (Error (Either [s (Compilation s d o)]
+ [s [Descriptor (Document d)] (Output o)])))})
-(type: #export (Compiler d o)
- (-> Input (Compilation d o)))
+(type: #export (Compiler s d o)
+ (-> Input (Compilation s d o)))
-(type: #export (Instancer d o)
- (-> (Key d) (List Parameter) (Compiler d o)))
+(type: #export (Instancer s d o)
+ (-> (Key d) (List Parameter) (Compiler s d o)))
(exception: #export (cannot-compile {module Module})
- (ex.report ["Module" module]))
+ (exception.report
+ ["Module" module]))
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index 5de9970f6..850615b37 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -169,16 +169,15 @@
(list prelude)))
)
-(def: #export (compiler expander prelude state)
- (All [anchor expression statement]
- (-> Expander Module
- (statement.State+ anchor expression statement)
- (Instancer .Module)))
+(def: #export (compiler expander prelude)
+ (-> Expander Module
+ (All [anchor expression statement]
+ (Instancer (statement.State+ anchor expression statement) .Module)))
(function (_ key parameters input)
(let [hash (text/hash (get@ #///.code input))
dependencies (default-dependencies prelude input)]
{#///.dependencies dependencies
- #///.process (function (_ archive)
+ #///.process (function (_ state archive)
(do error.monad
[[state' analysis-module] (phase.run' state
(: (All [anchor expression statement]
@@ -193,7 +192,8 @@
#descriptor.file (get@ #///.file input)
#descriptor.references (set.from-list text.hash dependencies)
#descriptor.state #.Compiled}]]
- (wrap (#.Right [[descriptor (document.write key analysis-module)]
+ (wrap (#.Right [state'
+ [descriptor (document.write key analysis-module)]
(dictionary.new text.hash)]))))})))
(def: #export key
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index f9b4d4bd3..73ee068bb 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -1,10 +1,14 @@
(.module:
- [lux #*
+ [lux (#- Module)
+ [type (#+ :share :extract)]
[control
- [monad (#+ Monad do)]]
+ ["." monad (#+ Monad do)]]
[data
+ ["." bit]
["." product]
- ["." error (#+ Error)]]
+ ["." error (#+ Error)]
+ [collection
+ ["." list]]]
[world
["." file (#+ File)]]]
[//
@@ -17,7 +21,8 @@
["." translation]]
["." cli (#+ Configuration)]
[meta
- ["." archive]
+ ["." archive (#+ Archive)
+ [descriptor (#+ Module)]]
[io
["." context]]]]])
@@ -80,39 +85,59 @@
## (io.fail error))
)
- (def: #export (compile expander platform configuration state)
+ (def: #export (compile expander platform configuration archive state)
(All [! anchor expression statement]
- (-> Expander <Platform> Configuration <State+> (! (Error Any))))
- (let [monad (get@ #&monad platform)]
- (do monad
- [input (context.read monad
- (get@ #&file-system platform)
- (get@ #cli.sources configuration)
- (get@ #cli.module configuration))
- ## _ (&io.prepare-module target-dir (get@ #cli.module configuration))
- ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs)
- ]
- (wrap (do error.monad
- [input input
- #let [compile (init.compiler expander syntax.prelude state)
- compilation (compile init.key (list) input)]]
- (case ((get@ #///.process compilation)
- archive.empty)
+ (-> Expander <Platform> Configuration Archive <State+> (! (Error [Archive <State+>]))))
+ (let [monad (get@ #&monad platform)
+ compiler (:share [anchor expression statement]
+ {<State+>
+ state}
+ {(///.Compiler <State+> .Module Any)
+ ((init.compiler expander syntax.prelude) init.key (list))})]
+ (loop [module (get@ #cli.module configuration)
+ [archive state] [archive state]]
+ (let [import! (:share [! anchor expression statement]
+ {<Platform>
+ platform}
+ {(-> Module [Archive <State+>]
+ (! (Error [Archive <State+>])))
+ recur})]
+ (do (error.with monad)
+ [input (context.read monad
+ (get@ #&file-system platform)
+ (get@ #cli.sources configuration)
+ module)
+ ## _ (&io.prepare-module target-dir (get@ #cli.module configuration))
+ ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs)
+ ]
+ (loop [state state
+ compilation (compiler (:coerce ///.Input input))]
+ (do @
+ [archive+state' (monad.fold @
+ import!
+ [archive state]
+ (list.filter (bit.complement (archive.archived? archive))
+ (get@ #///.dependencies compilation)))
+ #let [[archive' state'] (:share [! anchor expression statement]
+ {<Platform>
+ platform}
+ {[Archive <State+>]
+ archive+state'})
+ continue! (:share [! anchor expression statement]
+ {<Platform>
+ platform}
+ {(-> <State+> (///.Compilation <State+> .Module Any)
+ (! (Error [Archive <State+>])))
+ recur})]]
+ (case ((get@ #///.process compilation) state' archive')
(#error.Success more|done)
(case more|done
- (#.Left more)
- (#error.Failure "NOT DONE!")
+ (#.Left [state'' more])
+ (continue! state'' more)
- (#.Right done)
- (wrap []))
+ (#.Right [state'' descriptor+document output])
+ (wrap [(archive.add module descriptor+document archive') state'']))
(#error.Failure error)
- (#error.Failure error))))
-
- ## (case (compile input)
- ## (#error.Failure error)
- ## (:: monad wrap (#error.Failure error))
-
- ## (#error.Success))
- )))
+ (:: monad wrap (#error.Failure error))))))))))
)
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index eb9761ab9..96a6e3b63 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -24,53 +24,62 @@
["." document (#+ Document)]])
## Archive
-(exception: #export (unknown-document {name Module})
- (ex.report ["Module" name]))
+(exception: #export (unknown-document {module Module})
+ (ex.report ["Module" module]))
-(exception: #export (cannot-replace-document {name Module}
+(exception: #export (cannot-replace-document {module Module}
{old (Document Any)}
{new (Document Any)})
- (ex.report ["Module" name]
+ (ex.report ["Module" module]
["Old key" (signature.description (document.signature old))]
["New key" (signature.description (document.signature new))]))
(abstract: #export Archive
{}
- (Dictionary Text [Descriptor (Document Any)])
+ (Dictionary Module [Descriptor (Document Any)])
(def: #export empty
Archive
(:abstraction (dictionary.new text.hash)))
- (def: #export (add name [descriptor document] archive)
+ (def: #export (add module [descriptor document] archive)
(-> Module [Descriptor (Document Any)] Archive (Error Archive))
- (case (dictionary.get name (:representation archive))
+ (case (dictionary.get module (:representation archive))
(#.Some [existing-descriptor existing-document])
(if (is? document existing-document)
(#error.Success archive)
- (ex.throw cannot-replace-document [name existing-document document]))
+ (ex.throw cannot-replace-document [module existing-document document]))
#.None
(#error.Success (|> archive
:representation
- (dictionary.put name [descriptor document])
+ (dictionary.put module [descriptor document])
:abstraction))))
- (def: #export (find name archive)
+ (def: #export (find module archive)
(-> Module Archive (Error [Descriptor (Document Any)]))
- (case (dictionary.get name (:representation archive))
+ (case (dictionary.get module (:representation archive))
(#.Some document)
(#error.Success document)
#.None
- (ex.throw unknown-document [name])))
+ (ex.throw unknown-document [module])))
+
+ (def: #export (archived? archive module)
+ (-> Archive Module Bit)
+ (case (find module archive)
+ (#error.Success _)
+ yes
+
+ (#error.Failure _)
+ no))
(def: #export (merge additions archive)
(-> Archive Archive (Error Archive))
(monad.fold error.monad
- (function (_ [name' descriptor+document'] archive')
- (..add name' descriptor+document' archive'))
+ (function (_ [module' descriptor+document'] archive')
+ (..add module' descriptor+document' archive'))
archive
(dictionary.entries (:representation additions))))
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 00:20:17 +0000