diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/compiler.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default.lux | 198 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/init.lux | 235 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/analysis/module.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/extension.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/statement/total.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/platform.lux | 109 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/archive/document.lux | 22 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/archive/key.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/cache.lux | 37 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/io/context.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/lux/interpreter.lux | 29 |
12 files changed, 373 insertions, 327 deletions
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)] |