diff options
Diffstat (limited to 'stdlib/source')
9 files changed, 281 insertions, 36 deletions
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index 197befb10..d5b97ad36 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -1,2 +1,187 @@ (.module: - [lux #*]) + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." product] + ["." error] + [text ("text/." Hash<Text>) + format + ["." encoding]] + [collection + ["." dictionary]]] + [type (#+ :share)] + ["." macro] + [concurrency + ["." promise ("promise/." Monad<Promise>)] + ["." task (#+ Task)]] + [world + ["." file (#+ File)]]] + [// + [meta + [io + ["." context]]]] + [/ + ["." init] + ["." syntax (#+ Aliases)] + ["." phase + ["." analysis + ["." module] + [".A" expression]] + ["." translation (#+ Host)] + ["." statement + [".S" total]]]] + ## (luxc [cache] + ## [cache/description] + ## [cache/io]) + ) + +(def: (forgive-eof operation) + (All [s o] + (-> (phase.Operation s o) (phase.Operation s Any))) + (function (_ compiler) + (ex.catch syntax.end-of-file + (|>> [compiler]) + (operation compiler)))) + +(def: #export prelude Text "lux") + +(def: (read current-module aliases) + (-> Text Aliases (analysis.Operation Code)) + (function (_ [bundle compiler]) + (case (syntax.read current-module aliases (get@ #.source compiler)) + (#error.Error error) + (#error.Error error) + + (#error.Success [source' output]) + (#error.Success [[bundle (set@ #.source source' compiler)] + output])))) + +## ## (def: (write-module target-dir file-name module-name module artifacts) +## ## (-> File Text Text Module Artifacts (Process Any)) +## ## (do io.Monad<Process> +## ## [_ (monad.map @ (product.uncurry (&io.write target-dir)) +## ## (dictionary.entries artifacts))] +## ## (&io.write target-dir +## ## (format module-name "/" cache.descriptor-name) +## ## (encoding.to-utf8 (%code (cache/description.write file-name module)))))) + +(type: Configuration + {#sources (List File) + #target File}) + +(type: (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 Task)}) + +(with-expansions [<Platform> (as-is (Platform 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) + (All [anchor expression statement] + (-> Text Text Text <Operation>)) + (statement.lift-analysis! + (do phase.Monad<Operation> + [_ (module.create (text/hash source-code) module-name) + _ (analysis.set-current-module module-name)] + (analysis.set-source-code (init.source file-name source-code))))) + + (def: (end-module-compilation module-name) + (All [anchor expression statement] + (-> Text <Operation>)) + (statement.lift-analysis! + (module.set-compiled module-name))) + + (def: (loop-module-compilation module-name) + (All [anchor expression statement] + (-> Text <Operation>)) + (forgive-eof + (loop [_ []] + (do phase.Monad<Operation> + [code (statement.lift-analysis! + (do @ + [code (..read module-name syntax.no-aliases) + #let [[cursor _] code] + _ (analysis.set-cursor cursor)] + (wrap code))) + _ (totalS.phase code)] + (forgive-eof (recur [])))))) + + (def: (perform-module-compilation module-name file-name source-code) + (All [anchor expression statement] + (-> Text Text Text <Operation>)) + (do phase.Monad<Operation> + [_ (begin-module-compilation module-name file-name source-code) + _ (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)})) + ## _ (&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))) + + (def: #export (compile platform configuration program) + (All [anchor expression statement] + (-> <Platform> Configuration Text (Task Any))) + (do task.Monad<Task> + [compiler (initialize platform configuration) + _ (compile-module platform configuration program compiler) + ## _ (cache/io.clean target ...) + #let [_ (log! "Compilation complete!")]] + (wrap []))) + ) diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux index d768f5f7d..4bd2f807d 100644 --- a/stdlib/source/lux/compiler/default/init.lux +++ b/stdlib/source/lux/compiler/default/init.lux @@ -1,6 +1,7 @@ (.module: lux [// + ["." evaluation] [phase (#+ Eval) [analysis [".A" expression]] @@ -67,16 +68,19 @@ #.extensions [] #.host host}) -(def: #export (state eval translate host) +(def: #export (state host translate) (All [anchor expression statement] - (-> Eval + (-> (Host expression statement) (translation.Phase anchor expression statement) - (Host expression statement) (statement.State+ anchor expression statement))) - [statementE.bundle - {#statement.analysis {#statement.state [analysisE.bundle (..compiler [])] - #statement.phase (expressionA.analyser eval)} - #statement.synthesis {#statement.state [synthesisE.bundle synthesis.init] - #statement.phase expressionS.synthesize} - #statement.translation {#statement.state [translationE.bundle (translation.state host)] - #statement.phase translate}}]) + (let [analysis-state [analysisE.bundle (..compiler host)] + synthesis-state [synthesisE.bundle synthesis.init] + translation-state [translationE.bundle (translation.state host)] + eval (evaluation.evaluator analysis-state synthesis-state translation-state translate)] + [statementE.bundle + {#statement.analysis {#statement.state analysis-state + #statement.phase (expressionA.analyser eval)} + #statement.synthesis {#statement.state synthesis-state + #statement.phase expressionS.synthesize} + #statement.translation {#statement.state translation-state + #statement.phase translate}}])) diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux index b0776141a..974fc2473 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis.lux @@ -280,3 +280,13 @@ (#error.Error error) (#error.Error error)))))) + +(do-template [<name> <type> <field> <value>] + [(def: #export (<name> value) + (-> <type> (Operation Any)) + (extension.update (set@ <field> <value>)))] + + [set-source-code Source #.source value] + [set-current-module Text #.current-module (#.Some value)] + [set-cursor Cursor #.cursor value] + ) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/module.lux b/stdlib/source/lux/compiler/default/phase/analysis/module.lux index 5812ef3d2..47b7d7331 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/module.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/module.lux @@ -133,7 +133,7 @@ ((///.throw cannot-define-more-than-once [self-name name]) state)))))) (def: #export (create hash name) - (-> Nat Text (Operation [])) + (-> Nat Text (Operation Any)) (extension.lift (function (_ state) (let [module (new hash)] diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux index 2c2bf4464..b1b28b6a3 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/statement.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux @@ -23,20 +23,6 @@ [// ["." evaluation]]]]) -(do-template [<name> <component> <operation>] - [(def: (<name> operation) - (All [anchor expression statement output] - (-> (<operation> output) (Operation anchor expression statement output))) - (extension.lift - (///.sub [(get@ [<component> #statement.state]) - (set@ [<component> #statement.state])] - operation)))] - - [lift-analysis! #statement.analysis analysis.Operation] - [lift-synthesis! #statement.synthesis synthesis.Operation] - [lift-translation! #statement.translation (translation.Operation anchor expression statement)] - ) - (def: (compile ?name ?type codeC) (All [anchor expression statement] (-> (Maybe Name) (Maybe Type) Code @@ -46,7 +32,7 @@ #let [analyse (get@ [#statement.analysis #statement.phase] state) synthesize (get@ [#statement.synthesis #statement.phase] state) translate (get@ [#statement.translation #statement.phase] state)] - [_ code//type codeA] (lift-analysis! + [_ code//type codeA] (statement.lift-analysis! (analysis.with-scope (type.with-fresh-env (case ?type @@ -62,9 +48,9 @@ code//type (type.with-env (check.clean code//type))] (wrap [code//type codeA])))))) - codeS (lift-synthesis! + codeS (statement.lift-synthesis! (synthesize codeA))] - (lift-translation! + (statement.lift-translation! (do @ [codeT (translate codeS) codeV (case ?name @@ -83,7 +69,7 @@ (do ///.Monad<Operation> [[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC) #let [annotationsV (:coerce Code annotationsV)] - current-module (lift-analysis! + current-module (statement.lift-analysis! (extension.lift macro.current-module-name)) [value//type valueT valueV] (compile (#.Some [current-module def-name]) @@ -91,7 +77,7 @@ (#.Some Type) #.None) valueC)] - (lift-analysis! + (statement.lift-analysis! (do @ [_ (module.define def-name [value//type annotationsV valueV])] (if (macro.type? annotationsV) @@ -112,6 +98,20 @@ [definition (extension.lift (macro.find-def def-name))] (module.define alias definition))) +(def: def::module + Handler + (function (_ extension-name phase inputsC+) + (case inputsC+ + (^ (list annotationsC)) + (do ///.Monad<Operation> + [[_ annotationsT annotationsV] (compile #.None (#.Some Code) annotationsC) + _ (statement.lift-analysis! + (module.set-annotations (:coerce Code annotationsV)))] + (wrap [])) + + _ + (///.throw bundle.invalid-syntax [extension-name])))) + (def: def::alias Handler (function (_ extension-name phase inputsC+) @@ -151,7 +151,7 @@ _ (///.throw bundle.invalid-syntax [extension-name]))))] - [def::analysis analysis.Handler lift-analysis!] + [def::analysis analysis.Handler statement.lift-analysis!] [def::synthesis synthesis.Handler (<| extension.lift (///.sub [(get@ [#statement.synthesis #statement.state]) @@ -169,6 +169,7 @@ Bundle (<| (bundle.prefix "def") (|> bundle.empty + (dictionary.put "module" def::module) (dictionary.put "alias" def::alias) (dictionary.put "analysis" def::analysis) (dictionary.put "synthesis" def::synthesis) diff --git a/stdlib/source/lux/compiler/default/phase/statement.lux b/stdlib/source/lux/compiler/default/phase/statement.lux index 8b0876cdd..daaea020c 100644 --- a/stdlib/source/lux/compiler/default/phase/statement.lux +++ b/stdlib/source/lux/compiler/default/phase/statement.lux @@ -1,6 +1,6 @@ (.module: [lux #*] - [// + ["." // ["." analysis] ["." synthesis] ["." translation] @@ -28,3 +28,18 @@ [Handler extension.Handler] [Bundle extension.Bundle] ) + +(do-template [<name> <component> <operation>] + [(def: #export (<name> operation) + (All [anchor expression statement output] + (-> (<operation> output) + (Operation anchor expression statement output))) + (extension.lift + (//.sub [(get@ [<component> #..state]) + (set@ [<component> #..state])] + operation)))] + + [lift-analysis! #..analysis analysis.Operation] + [lift-synthesis! #..synthesis synthesis.Operation] + [lift-translation! #..translation (translation.Operation anchor expression statement)] + ) diff --git a/stdlib/source/lux/compiler/default/phase/statement/total.lux b/stdlib/source/lux/compiler/default/phase/statement/total.lux new file mode 100644 index 000000000..d2b046f5f --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/statement/total.lux @@ -0,0 +1,27 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + [text + format]]] + ["." // (#+ Phase) + ["/." // + ["." extension]]]) + +(do-template [<name>] + [(exception: #export (<name> {code Code}) + (ex.report ["Statement" (%code code)]))] + + [unrecognized-statement] + ) + +(def: #export (phase code) + Phase + (case code + (^ [_ (#.Form (list& [_ (#.Text extension-name)] extension-args))]) + (extension.apply phase [extension-name extension-args]) + + _ + (///.throw unrecognized-statement code))) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux index 5b20dcff5..7faa5a4ea 100644 --- a/stdlib/source/lux/compiler/default/syntax.lux +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -40,9 +40,10 @@ format] [collection ["." row (#+ Row)] - ["dict" dictionary (#+ Dictionary)]]]]) + ["." dictionary (#+ Dictionary)]]]]) (type: #export Aliases (Dictionary Text Text)) +(def: #export no-aliases Aliases (dictionary.new text.Hash<Text>)) (def: white-space Text "\t\v \r\f") (def: new-line Text "\n") @@ -555,7 +556,7 @@ (p.either (do @ [_ (l.this name-separator) second-part name-part^] - (wrap [[(|> aliases (dict.get first-part) (maybe.default first-part)) + (wrap [[(|> aliases (dictionary.get first-part) (maybe.default first-part)) second-part] ($_ n/+ (text.size first-part) diff --git a/stdlib/source/lux/compiler/meta/io/context.lux b/stdlib/source/lux/compiler/meta/io/context.lux index 6d90483e2..b0a35cf61 100644 --- a/stdlib/source/lux/compiler/meta/io/context.lux +++ b/stdlib/source/lux/compiler/meta/io/context.lux @@ -78,7 +78,9 @@ (type: #export Code Text) (def: #export (read System<m> contexts name) - (All [m] (-> (System m) (List Context) Module (m [Text Code]))) + (All [m] + (-> (System m) (List Context) Module + (m [Text Code]))) (let [find-source' (find-source System<m> contexts name)] (do (:: System<m> &monad) [[path file] (try System<m> |