aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/program.lux53
-rw-r--r--stdlib/source/lux/compiler.lux15
-rw-r--r--stdlib/source/lux/compiler/default.lux198
-rw-r--r--stdlib/source/lux/compiler/default/init.lux235
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/module.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension.lux16
-rw-r--r--stdlib/source/lux/compiler/default/phase/statement/total.lux4
-rw-r--r--stdlib/source/lux/compiler/default/platform.lux109
-rw-r--r--stdlib/source/lux/compiler/meta/archive/document.lux22
-rw-r--r--stdlib/source/lux/compiler/meta/archive/key.lux20
-rw-r--r--stdlib/source/lux/compiler/meta/cache.lux37
-rw-r--r--stdlib/source/lux/compiler/meta/io/context.lux13
-rw-r--r--stdlib/source/lux/interpreter.lux29
13 files changed, 410 insertions, 343 deletions
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index ebc94cacb..0362d14b0 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -1,8 +1,7 @@
(.module:
[lux #*
[control
- [monad (#+ do)]
- ["p" parser]]
+ [monad (#+ do)]]
[data
["." error]
["." text
@@ -14,10 +13,21 @@
[world
["." file (#+ File)]
["." console]]
- [compiler
- ["." cli]
- ["." default (#+ Platform)]]
- ["." interpreter]]
+ ["." compiler
+ ["." cli (#+ Configuration)]
+ [meta
+ ["." archive]
+ [io
+ ["." context]]]
+ [default
+ ["." platform (#+ Platform)]
+ ["." init]
+ ["." syntax]
+ ["." phase
+ ["." translation]
+ ["." statement]]]]
+ ## ["." interpreter]
+ ]
[luxc
[lang
["." host/jvm]
@@ -45,23 +55,24 @@
(def: (timed action)
(All [a]
- (-> (Process a) (Process a)))
+ (-> (-> Any (Process a)) (Process a)))
(do io.Monad<Process>
[start (io.from-io instant.now)
- result action
+ result (action [])
finish (io.from-io instant.now)
#let [elapsed-time (instant.span start finish)
- _ (log! (format text.new-line "Elapsed time: " (%duration elapsed-time)))]]
+ _ (log! (format text.new-line
+ "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})))
+ (wrap {#platform.host host
+ #platform.phase expression.translate
+ #platform.runtime runtime.translate
+ #platform.file-system file.JVM@System})))
(program: [{service cli.service}]
(do io.Monad<IO>
@@ -71,8 +82,18 @@
(#cli.Compilation configuration)
(<| (or-crash! "Compilation failed:")
..timed
- (default.compile platform configuration common.bundle))
+ (function (_ _)
+ (do (:: (get@ #platform.file-system platform) &monad)
+ [state (platform.initialize platform common.bundle)
+ _ (platform.compile platform (set@ #cli.module syntax.prelude configuration) state)
+ ## _ (compile platform configuration state)
+ ## _ (cache/io.clean target ...)
+ ]
+ (wrap (log! "Compilation complete!")))))
(#cli.Interpretation configuration)
- (<| (or-crash! "Interpretation failed:")
- (interpreter.run io.Monad<Process> console platform configuration)))))
+ ## TODO: Fix the interpreter...
+ (undefined)
+ ## (<| (or-crash! "Interpretation failed:")
+ ## (interpreter.run io.Monad<Process> console platform configuration common.bundle))
+ )))
diff --git a/stdlib/source/lux/compiler.lux b/stdlib/source/lux/compiler.lux
index bc6005382..d6c6d82d9 100644
--- a/stdlib/source/lux/compiler.lux
+++ b/stdlib/source/lux/compiler.lux
@@ -11,19 +11,22 @@
["." file (#+ File)]]]
[/
[meta
- ["." archive (#+ Document Archive)]]])
-
-(type: #export Module Text)
+ ["." archive (#+ Archive)
+ [key (#+ Key)]
+ [descriptor (#+ Module)]
+ [document (#+ Document)]]]])
(type: #export Code Text)
-(type: #export Source
+(type: #export Parameter Text)
+
+(type: #export Input
{#module Module
#file File
#code Code})
(type: #export Output
- (Dictionary File Binary))
+ (Dictionary Text Binary))
(type: #export (Compilation d)
{#dependencies (List Module)
@@ -32,7 +35,7 @@
[(Document d) Output])))})
(type: #export (Compiler d)
- (-> Source (Compilation d)))
+ (-> (Key d) (List Parameter) Input (Compilation d)))
(type: #export (Importer !)
(-> (file.System !) Module Archive (! (Error Archive))))
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index efba96e05..726562cc8 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -1,198 +1,6 @@
(.module:
- [lux (#- Source)
- [control
- [monad (#+ do)]
- ["ex" exception (#+ exception:)]]
- [data
- ["." product]
- ["." error (#+ Error)]
- [text ("text/." Hash<Text>)
- format
- ["." encoding]]
- [collection
- ["." dictionary]]]
- [type (#+ :share)]
- ["." macro]
- [world
- ["." file (#+ File)]]]
- ["." // (#+ Source)
- ["." cli (#+ Configuration)]
- [meta
- [io
- ["." context]]]]
- [/
- ["." init]
- ["." syntax (#+ Aliases)]
- ["." phase
- ["." analysis
- ["." module]
- [".A" expression]]
- ["." translation (#+ Host Bundle)]
- ["." statement
- [".S" total]]
- ["." extension]]]
- ## (luxc [cache]
- ## [cache/description]
- ## [cache/io])
- )
+ [lux #*])
-(type: Reader
- (-> .Source (Error [.Source Code])))
+(type: #export Version Text)
-(def: (reader current-module aliases)
- (-> Text Aliases (analysis.Operation Reader))
- (function (_ [bundle state])
- (let [[cursor offset source-code] (get@ #.source state)]
- (#error.Success [[bundle state]
- (syntax.parse current-module aliases ("lux text size" source-code))]))))
-
-(def: (read reader)
- (-> Reader (analysis.Operation Code))
- (function (_ [bundle compiler])
- (case (reader (get@ #.source compiler))
- (#error.Error error)
- (#error.Error error)
-
- (#error.Success [source' output])
- (let [[cursor _] output]
- (#error.Success [[bundle (|> compiler
- (set@ #.source source')
- (set@ #.cursor cursor))]
- output])))))
-
-## ## (def: (write-module target-dir file-name module-name module outputs)
-## ## (-> File Text Text Module Outputs (Process Any))
-## ## (do io.Monad<Process>
-## ## [_ (monad.map @ (product.uncurry (&io.write target-dir))
-## ## (dictionary.entries outputs))]
-## ## (&io.write target-dir
-## ## (format module-name "/" cache.descriptor-name)
-## ## (encoding.to-utf8 (%code (cache/description.write file-name module))))))
-
-(type: #export (Platform ! anchor expression statement)
- {#host (Host expression statement)
- #phase (translation.Phase anchor expression statement)
- #runtime (translation.Operation anchor expression statement Any)
- #file-system (file.System !)})
-
-(with-expansions [<Platform> (as-is (Platform ! anchor expression statement))
- <Operation> (as-is (statement.Operation anchor expression statement Any))
- <State+> (as-is (statement.State+ anchor expression statement))
- <Bundle> (as-is (Bundle anchor expression statement))]
-
- (def: (begin-module-compilation module-name source)
- (All [anchor expression statement]
- (-> Text Source <Operation>))
- (statement.lift-analysis
- (do phase.Monad<Operation>
- [_ (module.create (text/hash (get@ #//.code source)) module-name)
- _ (analysis.set-current-module module-name)]
- (analysis.set-source-code (init.source (get@ #//.module source) (get@ #//.code source))))))
-
- (def: end-module-compilation
- (All [anchor expression statement]
- (-> Text <Operation>))
- (|>> module.set-compiled
- statement.lift-analysis))
-
- (def: (module-compilation-iteration reader)
- (-> Reader (All [anchor expression statement] <Operation>))
- (do phase.Monad<Operation>
- [code (statement.lift-analysis
- (..read reader))
- _ (totalS.phase code)]
- init.refresh))
-
- (def: (module-compilation-loop module-name)
- (All [anchor expression statement]
- (-> Text <Operation>))
- (do phase.Monad<Operation>
- [reader (statement.lift-analysis
- (..reader module-name syntax.no-aliases))]
- (function (_ state)
- (loop [state state]
- (case (module-compilation-iteration reader state)
- (#error.Success [state' output])
- (recur state')
-
- (#error.Error error)
- (if (ex.match? syntax.end-of-file error)
- (#error.Success [state []])
- (ex.with-stack //.cannot-compile module-name (#error.Error error))))))))
-
- (def: (perform-module-compilation module-name source)
- (All [anchor expression statement]
- (-> Text Source <Operation>))
- (do phase.Monad<Operation>
- [_ (begin-module-compilation module-name source)
- _ (module-compilation-loop module-name)]
- (end-module-compilation module-name)))
-
- (def: #export (compile-module platform configuration compiler)
- (All [! anchor expression statement]
- (-> <Platform> Configuration <State+> (! <State+>)))
- (do (:: (get@ #file-system platform) &monad)
- [source (context.read (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)
- ]
- (<| (:: @ map product.left)
- (:: (get@ #file-system platform) lift)
- (phase.run' compiler)
- (:share [! anchor expression statement]
- {<Platform>
- platform}
- {<Operation>
- (perform-module-compilation (get@ #cli.module configuration) source)}))))
-
- (def: #export (initialize platform configuration translation-bundle)
- (All [! anchor expression statement]
- (-> <Platform> Configuration <Bundle> (! <State+>)))
- (|> platform
- (get@ #runtime)
- statement.lift-translation
- (phase.run' (init.state (get@ #host platform)
- (get@ #phase platform)
- translation-bundle))
- (:: 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 translation-bundle)
- (All [! anchor expression statement]
- (-> <Platform> Configuration <Bundle> (! Any)))
- (do (:: (get@ #file-system platform) &monad)
- [compiler (initialize platform configuration translation-bundle)
- _ (compile-module platform (set@ #cli.module syntax.prelude configuration) compiler)
- _ (compile-module platform configuration compiler)
- ## _ (cache/io.clean target ...)
- ]
- (wrap (log! "Compilation complete!"))))
- )
+(def: #export version Version "0.6.0")
diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux
index 07aa1217e..c50d37705 100644
--- a/stdlib/source/lux/compiler/default/init.lux
+++ b/stdlib/source/lux/compiler/default/init.lux
@@ -1,86 +1,81 @@
(.module:
- [lux #*
+ [lux (#- Module loop)
[control
- [monad (#+ do)]]
+ [monad (#+ do)]
+ ["ex" exception (#+ exception:)]]
[data
- ["." product]]]
- [//
+ ["." product]
+ ["." error (#+ Error)]
+ ["." text ("text/." Hash<Text>)]
+ [collection
+ ["." dictionary]]]
+ ["." macro]
+ [world
+ ["." file]]]
+ ["." //
+ ["." syntax (#+ Aliases)]
["." evaluation]
["." phase
["." analysis
+ ["." module]
[".A" expression]]
["." synthesis
[".S" expression]]
- ["." translation (#+ Host)]
- ["." statement]
+ ["." translation]
+ ["." statement
+ [".S" total]]
["." extension
[".E" analysis]
[".E" synthesis]
[".E" statement]]]
- [//
- ["." host]]])
-
-(type: #export Version Text)
-
-(def: #export version Version "0.6.0")
-
-(def: #export (cursor file)
- (-> Text Cursor)
- [file 1 0])
-
-(def: #export (source file code)
- (-> Text Text Source)
- [(cursor file) 0 code])
-
-(def: dummy-source
- Source
- [.dummy-cursor 0 ""])
-
-(def: #export type-context
- Type-Context
- {#.ex-counter 0
- #.var-counter 0
- #.var-bindings (list)})
+ ["/." // (#+ Compiler)
+ ["." host]
+ [meta
+ [archive
+ ["." signature]
+ ["." key (#+ Key)]
+ ["." descriptor (#+ Module)]
+ ["." document]]]]])
(def: #export info
Info
- {#.target (`` (for {(~~ (static host.common-lisp)) host.common-lisp
- (~~ (static host.js)) host.js
- (~~ (static host.jvm)) host.jvm
- (~~ (static host.lua)) host.lua
- (~~ (static host.php)) host.php
- (~~ (static host.python)) host.python
- (~~ (static host.r)) host.r
- (~~ (static host.ruby)) host.ruby
- (~~ (static host.scheme)) host.scheme}))
- #.version ..version
- #.mode #.Build})
-
-(def: #export (compiler host)
- (-> Any Lux)
- {#.info ..info
- #.source dummy-source
- #.cursor .dummy-cursor
- #.current-module #.None
- #.modules (list)
- #.scopes (list)
- #.type-context ..type-context
- #.expected #.None
- #.seed 0
- #.scope-type-vars (list)
- #.extensions []
- #.host host})
+ {#.target (`` (for {(~~ (static host.common-lisp)) host.common-lisp
+ (~~ (static host.js)) host.js
+ (~~ (static host.jvm)) host.jvm
+ (~~ (static host.lua)) host.lua
+ (~~ (static host.php)) host.php
+ (~~ (static host.python)) host.python
+ (~~ (static host.r)) host.r
+ (~~ (static host.ruby)) host.ruby
+ (~~ (static host.scheme)) host.scheme}))
+ #.version //.version
+ #.mode #.Build})
+
+(def: refresh
+ (All [anchor expression statement]
+ (statement.Operation anchor expression statement Any))
+ (do phase.Monad<Operation>
+ [[bundle state] phase.get-state
+ #let [eval (evaluation.evaluator (get@ [#statement.synthesis #statement.state] state)
+ (get@ [#statement.translation #statement.state] state)
+ (get@ [#statement.translation #statement.phase] state))]]
+ (phase.set-state [statementE.bundle
+ (update@ [#statement.analysis #statement.state]
+ (: (-> analysis.State+ analysis.State+)
+ (|>> product.right
+ [(analysisE.bundle eval)]))
+ state)])))
(def: #export (state host translate translation-bundle)
(All [anchor expression statement]
- (-> (Host expression statement)
+ (-> (translation.Host expression statement)
(translation.Phase anchor expression statement)
(translation.Bundle anchor expression statement)
(statement.State+ anchor expression statement)))
(let [synthesis-state [synthesisE.bundle synthesis.init]
translation-state [translation-bundle (translation.state host)]
eval (evaluation.evaluator synthesis-state translation-state translate)
- analysis-state [(analysisE.bundle eval) (..compiler host)]]
+ analysis-state [(analysisE.bundle eval) (analysis.state ..info host)]]
[statementE.bundle
{#statement.analysis {#statement.state analysis-state
#statement.phase expressionA.compile}
@@ -89,17 +84,115 @@
#statement.translation {#statement.state translation-state
#statement.phase translate}}]))
-(def: #export refresh
+(type: Reader
+ (-> Source (Error [Source Code])))
+
+(def: (reader current-module aliases)
+ (-> Module Aliases (analysis.Operation Reader))
+ (function (_ [bundle state])
+ (let [[cursor offset source-code] (get@ #.source state)]
+ (#error.Success [[bundle state]
+ (syntax.parse current-module aliases ("lux text size" source-code))]))))
+
+(def: (read reader)
+ (-> Reader (analysis.Operation Code))
+ (function (_ [bundle compiler])
+ (case (reader (get@ #.source compiler))
+ (#error.Error error)
+ (#error.Error error)
+
+ (#error.Success [source' output])
+ (let [[cursor _] output]
+ (#error.Success [[bundle (|> compiler
+ (set@ #.source source')
+ (set@ #.cursor cursor))]
+ output])))))
+
+(with-expansions [<Operation> (as-is (All [anchor expression statement]
+ (statement.Operation anchor expression statement Any)))]
+
+ (def: (begin hash input)
+ (-> Nat ///.Input <Operation>)
+ (statement.lift-analysis
+ (do phase.Monad<Operation>
+ [#let [module (get@ #///.module input)]
+ _ (module.create hash module)
+ _ (analysis.set-current-module module)]
+ (analysis.set-source-code (analysis.source (get@ #///.module input) (get@ #///.code input))))))
+
+ (def: end
+ (-> Module <Operation>)
+ (|>> module.set-compiled
+ statement.lift-analysis))
+
+ (def: (iteration reader)
+ (-> Reader <Operation>)
+ (do phase.Monad<Operation>
+ [code (statement.lift-analysis
+ (..read reader))
+ _ (totalS.phase code)]
+ ..refresh))
+
+ (def: (loop module)
+ (-> Module <Operation>)
+ (do phase.Monad<Operation>
+ [reader (statement.lift-analysis
+ (..reader module syntax.no-aliases))]
+ (function (_ state)
+ (.loop [state state]
+ (case (..iteration reader state)
+ (#error.Success [state' output])
+ (recur state')
+
+ (#error.Error error)
+ (if (ex.match? syntax.end-of-file error)
+ (#error.Success [state []])
+ (ex.with-stack ///.cannot-compile module (#error.Error error))))))))
+
+ (def: (compile hash input)
+ (-> Nat ///.Input <Operation>)
+ (do phase.Monad<Operation>
+ [#let [module (get@ #///.module input)]
+ _ (..begin hash input)
+ _ (..loop module)]
+ (..end module)))
+
+ (def: (default-dependencies prelude input)
+ (-> Module ///.Input (List Module))
+ (if (text/= prelude (get@ #///.module input))
+ (list)
+ (list prelude)))
+ )
+
+(def: #export (compiler prelude state)
(All [anchor expression statement]
- (statement.Operation anchor expression statement Any))
- (do phase.Monad<Operation>
- [[bundle state] phase.get-state
- #let [eval (evaluation.evaluator (get@ [#statement.synthesis #statement.state] state)
- (get@ [#statement.translation #statement.state] state)
- (get@ [#statement.translation #statement.phase] state))]]
- (phase.set-state [statementE.bundle
- (update@ [#statement.analysis #statement.state]
- (: (-> analysis.State+ analysis.State+)
- (|>> product.right
- [(analysisE.bundle eval)]))
- state)])))
+ (-> Module
+ (statement.State+ anchor expression statement)
+ (Compiler .Module)))
+ (function (_ key parameters input)
+ (let [hash (text/hash (get@ #///.code input))
+ dependencies (default-dependencies prelude input)]
+ {#///.dependencies dependencies
+ #///.process (function (_ archive)
+ (do error.Monad<Error>
+ [[state' analysis-module] (phase.run' state
+ (: (All [anchor expression statement]
+ (statement.Operation anchor expression statement .Module))
+ (do phase.Monad<Operation>
+ [_ (compile hash input)]
+ (statement.lift-analysis
+ (extension.lift
+ macro.current-module)))))
+ #let [descriptor {#descriptor.hash hash
+ #descriptor.name (get@ #///.module input)
+ #descriptor.file (get@ #///.file input)
+ #descriptor.references dependencies
+ #descriptor.state #.Compiled}]]
+ (wrap (#.Right [(document.write key descriptor analysis-module)
+ (dictionary.new text.Hash<Text>)]))))})))
+
+(def: #export key
+ (Key .Module)
+ (key.key {#signature.name (name-of ..compiler)
+ #signature.version //.version}
+ (module.new 0)))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/module.lux b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
index d8736ad72..a8f6bda03 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/module.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/module.lux
@@ -50,7 +50,7 @@
["Old annotations" (%code old)]
["New annotations" (%code new)]))
-(def: (new hash)
+(def: #export (new hash)
(-> Nat Module)
{#.module-hash hash
#.module-aliases (list)
diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux
index ba3180500..75814ad24 100644
--- a/stdlib/source/lux/compiler/default/phase/extension.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- Name)
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
@@ -13,12 +13,14 @@
["." function]]
["." //])
+(type: #export Name Text)
+
(type: #export (Extension i)
- [Text (List i)])
+ [Name (List i)])
-(with-expansions [<Bundle> (as-is (Dictionary Text (Handler s i o)))]
+(with-expansions [<Bundle> (as-is (Dictionary Name (Handler s i o)))]
(type: #export (Handler s i o)
- (-> Text
+ (-> Name
(//.Phase [<Bundle> s] i o)
(//.Phase [<Bundle> s] (List i) o)))
@@ -36,14 +38,14 @@
(//.Phase (State s i o) i o))
(do-template [<name>]
- [(exception: #export (<name> {name Text})
+ [(exception: #export (<name> {name Name})
(ex.report ["Extension" (%t name)]))]
[cannot-overwrite]
[invalid-syntax]
)
-(exception: #export [s i o] (unknown {where Text} {name Text} {bundle (Bundle s i o)})
+(exception: #export [s i o] (unknown {where Text} {name Name} {bundle (Bundle s i o)})
(ex.report ["Where" (%t where)]
["Extension" (%t name)]
["Available" (|> bundle
@@ -52,7 +54,7 @@
(list/map (|>> %t (format text.new-line text.tab)))
(text.join-with ""))]))
-(exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat})
+(exception: #export (incorrect-arity {name Name} {arity Nat} {args Nat})
(ex.report ["Extension" (%t name)]
["Expected" (%n arity)]
["Actual" (%n args)]))
diff --git a/stdlib/source/lux/compiler/default/phase/statement/total.lux b/stdlib/source/lux/compiler/default/phase/statement/total.lux
index 8b81a134c..15f116aa1 100644
--- a/stdlib/source/lux/compiler/default/phase/statement/total.lux
+++ b/stdlib/source/lux/compiler/default/phase/statement/total.lux
@@ -12,7 +12,7 @@
["." analysis
["." expression]
["." type]
- [macro (#+ expand)]]
+ ["///." macro]]
["." extension]]])
(exception: #export (not-a-statement {code Code})
@@ -46,7 +46,7 @@
#.None
(///.throw macro-was-not-found macro-name))]
- (expression.expand-macro macro-name macro inputs))
+ (extension.lift (///macro.expand macro-name macro inputs)))
_
(///.throw not-a-macro code))))]
diff --git a/stdlib/source/lux/compiler/default/platform.lux b/stdlib/source/lux/compiler/default/platform.lux
new file mode 100644
index 000000000..0c0d72024
--- /dev/null
+++ b/stdlib/source/lux/compiler/default/platform.lux
@@ -0,0 +1,109 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]]
+ [data
+ ["." product]
+ ["." error]]
+ [world
+ ["." file (#+ File)]]
+ ["." compiler
+ [default
+ ["." init]
+ ["." syntax]
+ ["." phase
+ ["." translation]
+ ["." statement]]]
+ ["." cli (#+ Configuration)]
+ [meta
+ ["." archive]
+ [io
+ ["." context]]]]])
+
+(type: #export (Platform ! anchor expression statement)
+ {#host (translation.Host expression statement)
+ #phase (translation.Phase anchor expression statement)
+ #runtime (translation.Operation anchor expression statement Any)
+ #file-system (file.System !)})
+
+## (def: (write-module target-dir file-name module-name module outputs)
+## (-> File Text Text Module Outputs (Process Any))
+## (do io.Monad<Process>
+## [_ (monad.map @ (product.uncurry (&io.write target-dir))
+## (dictionary.entries outputs))]
+## (&io.write target-dir
+## (format module-name "/" cache.descriptor-name)
+## (encoding.to-utf8 (%code (cache/description.write file-name module))))))
+
+(with-expansions [<Platform> (as-is (Platform ! anchor expression statement))
+ <State+> (as-is (statement.State+ anchor expression statement))
+ <Bundle> (as-is (translation.Bundle anchor expression statement))]
+
+ (def: #export (initialize platform translation-bundle)
+ (All [! anchor expression statement]
+ (-> <Platform> <Bundle> (! <State+>)))
+ (|> platform
+ (get@ #runtime)
+ statement.lift-translation
+ (phase.run' (init.state (get@ #host platform)
+ (get@ #phase platform)
+ translation-bundle))
+ (:: 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 [state disk-write])
+ ## ## (do @
+ ## ## [_ (&io.prepare-target target)
+ ## ## _ disk-write
+ ## ## ## _ (cache/io.pre-load sources target (commonT.load-definition state))
+ ## ## ]
+ ## ## (wrap (|> state
+ ## ## (set@ [#.info #.mode] #.Build))))
+
+ ## (#error.Success [state [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 state))
+ ## ]
+ ## (wrap (|> state
+ ## (set@ [#.info #.mode] #.Build))))
+
+ ## (#error.Error error)
+ ## (io.fail error))
+ )
+
+ (def: #export (compile platform configuration state)
+ (All [! anchor expression statement]
+ (-> <Platform> Configuration <State+> (! Any)))
+ (do (:: (get@ #file-system platform) &monad)
+ [input (context.read (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)
+ ]
+ ## (case (compiler input)
+ ## (#error.Error error)
+ ## (:: (get@ #file-system platform) lift (#error.Error error))
+
+ ## (#error.Success))
+ (let [compiler (init.compiler syntax.prelude state)
+ compilation (compiler init.key (list) input)]
+ (case ((get@ #compiler.process compilation)
+ archive.empty)
+ (#error.Success more|done)
+ (case more|done
+ (#.Left more)
+ (:: (get@ #file-system platform) lift (#error.Error "NOT DONE!"))
+
+ (#.Right done)
+ (wrap []))
+
+ (#error.Error error)
+ (:: (get@ #file-system platform) lift (#error.Error error))))))
+ )
diff --git a/stdlib/source/lux/compiler/meta/archive/document.lux b/stdlib/source/lux/compiler/meta/archive/document.lux
index 237b092da..b99ff9b72 100644
--- a/stdlib/source/lux/compiler/meta/archive/document.lux
+++ b/stdlib/source/lux/compiler/meta/archive/document.lux
@@ -14,38 +14,40 @@
["." descriptor (#+ Module Descriptor)]])
## Document
-(exception: #export (invalid-key {module Module} {expected (Key Any)} {actual (Key Any)})
+(exception: #export (invalid-signature {module Module} {expected Signature} {actual Signature})
(ex.report ["Module" module]
- ["Expected" (signature.description (get@ #key.signature expected))]
- ["Actual" (signature.description (get@ #key.signature actual))]))
+ ["Expected" (signature.description expected)]
+ ["Actual" (signature.description actual)]))
(abstract: #export (Document d)
{}
- {#key (Key d)
+ {#signature Signature
#descriptor Descriptor
#content d}
(def: #export (read key document)
(All [d] (-> (Key d) (Document Any) (Error d)))
- (let [[document//key document//descriptor document//content] (:representation document)]
+ (let [[document//signature document//descriptor document//content] (:representation document)]
(if (:: signature.Equivalence<Signature> =
- (get@ #key.signature key)
- (get@ #key.signature document//key))
+ (key.signature key)
+ document//signature)
(#error.Success (:share [e]
{(Key e)
key}
{e
document//content}))
- (ex.throw invalid-key [(get@ #descriptor.name document//descriptor) key document//key]))))
+ (ex.throw invalid-signature [(get@ #descriptor.name document//descriptor)
+ (key.signature key)
+ document//signature]))))
(def: #export (write key descriptor content)
(All [d] (-> (Key d) Descriptor d (Document d)))
- (:abstraction {#key key
+ (:abstraction {#signature (key.signature key)
#descriptor descriptor
#content content}))
(def: #export signature
(-> (Document Any) Signature)
- (|>> :representation (get@ #key) (get@ #key.signature)))
+ (|>> :representation (get@ #signature)))
)
diff --git a/stdlib/source/lux/compiler/meta/archive/key.lux b/stdlib/source/lux/compiler/meta/archive/key.lux
index 1758facf4..50c10ac01 100644
--- a/stdlib/source/lux/compiler/meta/archive/key.lux
+++ b/stdlib/source/lux/compiler/meta/archive/key.lux
@@ -1,8 +1,20 @@
(.module:
- [lux #*]
+ [lux #*
+ [type
+ abstract]]
[//
[signature (#+ Signature)]])
-(type: #export (Key k)
- {#signature Signature
- #default k})
+(abstract: #export (Key k)
+ {}
+
+ Signature
+
+ (def: #export signature
+ (-> (Key Any) Signature)
+ (|>> :representation))
+
+ (def: #export (key signature sample)
+ (All [d] (-> Signature d (Key d)))
+ (:abstraction signature))
+ )
diff --git a/stdlib/source/lux/compiler/meta/cache.lux b/stdlib/source/lux/compiler/meta/cache.lux
index 8c93c65e7..bcb7c98f0 100644
--- a/stdlib/source/lux/compiler/meta/cache.lux
+++ b/stdlib/source/lux/compiler/meta/cache.lux
@@ -19,20 +19,27 @@
["." set (#+ Set)]]]
[world
[file (#+ File System)]]]
- [//io (#+ Context Module)]
- ["." //io/context]
- ["." //io/archive]
- ["." //archive (#+ Signature Key Descriptor Document Archive)]
+ [//
+ [io (#+ Context Module)
+ ["io/." context]
+ ["io/." archive]]
+ ["." archive (#+ Signature Key Descriptor Document Archive)]
+ ["/." //]]
["." /dependency (#+ Dependency Graph)])
-(exception: #export (cannot-delete-cached-file {file File})
+(exception: #export (cannot-delete-file {file File})
(ex.report ["File" file]))
-(exception: #export (stale-document {module Text} {current-hash Nat} {stale-hash Nat})
+(exception: #export (stale-document {module ///.Module} {current-hash Nat} {stale-hash Nat})
(ex.report ["Module" module]
["Current hash" (%n current-hash)]
["Stale hash" (%n stale-hash)]))
+(exception: #export (mismatched-signature {module ///.Module} {expected Signature} {actual Signature})
+ (ex.report ["Module" module]
+ ["Expected" (archive.describe expected)]
+ ["Actual" (archive.describe actual)]))
+
(do-template [<name>]
[(exception: #export (<name> {message Text})
message)]
@@ -44,7 +51,7 @@
(def: #export (cached System<m> root)
(All [m] (-> (System m) File (m (List File))))
(|> root
- (//io/archive.archive System<m>)
+ (io/archive.archive System<m>)
(do> (:: System<m> &monad)
[(:: System<m> files)]
[(monad.map @ (function (recur file)
@@ -56,7 +63,7 @@
[(:: System<m> files)]
[(monad.map @ recur)]
[list.concat
- (list& (maybe.assume (//io/archive.module System<m> root file)))
+ (list& (maybe.assume (io/archive.module System<m> root file)))
wrap]))
(wrap (list))))))]
[list.concat wrap])))
@@ -68,11 +75,11 @@
[deleted? (:: System<m> delete document)]
(if deleted?
(wrap [])
- (:: System<m> throw cannot-delete-cached-file document))))
+ (:: System<m> throw cannot-delete-file document))))
(def: (un-install System<m> root module)
(All [m] (-> (System m) File Module (m Any)))
- (let [document (//io/archive.document System<m> root module)]
+ (let [document (io/archive.document System<m> root module)]
(|> document
(do> (:: System<m> &monad)
[(:: System<m> files)]
@@ -113,15 +120,19 @@
(All [m d] (-> (System m) (List File) File (Key d) (Format d) Module
(m (Maybe [Dependency (Document d)]))))
(do (:: System<m> &monad)
- [document' (:: System<m> read (//io/archive.document System<m> root module))
- [module' source-code] (//io/context.read System<m> contexts module)
+ [document' (:: System<m> read (io/archive.document System<m> root module))
+ [module' source-code] (io/context.read System<m> contexts module)
#let [current-hash (:: text.Hash<Text> hash source-code)]]
(case (do error.Monad<Error>
[[signature descriptor content] (binary.read (..document binary) document')
#let [[document-hash _file references _state] descriptor]
+ _ (ex.assert mismatched-signature [module (get@ #archive.signature key) signature]
+ (:: archive.Equivalence<Signature> =
+ (get@ #archive.signature key)
+ signature))
_ (ex.assert stale-document [module current-hash document-hash]
(n/= current-hash document-hash))
- document (//archive.close key signature descriptor content)]
+ document (archive.write key signature descriptor content)]
(wrap [[module references] document]))
(#error.Success [dependency document])
(wrap (#.Some [dependency document]))
diff --git a/stdlib/source/lux/compiler/meta/io/context.lux b/stdlib/source/lux/compiler/meta/io/context.lux
index 2651c771d..32e05c219 100644
--- a/stdlib/source/lux/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/compiler/meta/io/context.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Module Source Code)
+ [lux (#- Module Code)
[control
monad
["ex" exception (#+ Exception exception:)]]
@@ -11,9 +11,12 @@
[world
["." file (#+ File)]
[binary (#+ Binary)]]]
- ["." // (#+ Context Module Code)
- ["/." /// (#+ Source)
- ["." host]]])
+ ["." // (#+ Context Code)
+ [//
+ [archive
+ [descriptor (#+ Module)]]
+ ["//." // (#+ Input)
+ ["." host]]]])
(do-template [<name>]
[(exception: #export (<name> {module Module})
@@ -86,7 +89,7 @@
(def: #export (read System<m> contexts module)
(All [!]
(-> (file.System !) (List Context) Module
- (! Source)))
+ (! Input)))
(let [find-source-file' (find-source-file System<m> contexts module)]
(do (:: System<m> &monad)
[file (try System<m>
diff --git a/stdlib/source/lux/interpreter.lux b/stdlib/source/lux/interpreter.lux
index e44084bc0..8a6d00578 100644
--- a/stdlib/source/lux/interpreter.lux
+++ b/stdlib/source/lux/interpreter.lux
@@ -11,8 +11,9 @@
["." check]]
[compiler
["." cli (#+ Configuration)]
- ["." default (#+ Platform)
+ ["." default
["." syntax]
+ ["." platform (#+ Platform)]
["." init]
["." phase
["." analysis
@@ -59,23 +60,24 @@
[_ (module.create 0 ..module)]
(analysis.set-current-module ..module))))
-(def: (initialize Monad<!> Console<!> platform configuration)
+(def: (initialize Monad<!> Console<!> platform configuration translation-bundle)
(All [! anchor expression statement]
(-> (Monad !)
(Console !) (Platform ! anchor expression statement)
Configuration
+ (translation.Bundle anchor expression statement)
(! (State+ anchor expression statement))))
(do Monad<!>
- [state (default.initialize platform configuration)
- state (default.compile-module platform
- (set@ #cli.module syntax.prelude configuration)
- (set@ [#extension.state
- #statement.analysis #statement.state
- #extension.state
- #.info #.mode]
- #.Interpreter
- state))
- [state _] (:: (get@ #default.file-system platform)
+ [state (platform.initialize platform translation-bundle)
+ state (platform.compile platform
+ (set@ #cli.module syntax.prelude configuration)
+ (set@ [#extension.state
+ #statement.analysis #statement.state
+ #extension.state
+ #.info #.mode]
+ #.Interpreter
+ state))
+ [state _] (:: (get@ #platform.file-system platform)
lift (phase.run' state enter-module))
_ (:: Console<!> write ..welcome-message)]
(wrap state)))
@@ -184,11 +186,12 @@
(set@ #source source'))
representation]))))
-(def: #export (run Monad<!> Console<!> platform configuration)
+(def: #export (run Monad<!> Console<!> platform configuration translation-bundle)
(All [! anchor expression statement]
(-> (Monad !)
(Console !) (Platform ! anchor expression statement)
Configuration
+ (translation.Bundle anchor expression statement)
(! Any)))
(do Monad<!>
[state (initialize Monad<!> Console<!> platform configuration)]