diff options
Diffstat (limited to 'stdlib')
7 files changed, 56 insertions, 33 deletions
diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index ac3fb7aa8..5b4a1a153 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -27,7 +27,7 @@ ["." analysis ["." module] [".A" expression]] - ["." translation (#+ Host)] + ["." translation (#+ Host Bundle)] ["." statement [".S" total]]]] ## (luxc [cache] @@ -77,7 +77,8 @@ (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))] + <Compiler> (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] @@ -137,14 +138,15 @@ {<Operation> (perform-module-compilation (get@ #cli.module configuration) source)})))) - (def: #export (initialize platform configuration) + (def: #export (initialize platform configuration translation-bundle) (All [fs anchor expression statement] - (-> <Platform> Configuration (fs <Compiler>))) + (-> <Platform> Configuration <Bundle> (fs <Compiler>))) (|> platform (get@ #runtime) statement.lift-translation (phase.run' (init.state (get@ #host platform) - (get@ #phase platform))) + (get@ #phase platform) + translation-bundle)) (:: error.Functor<Error> map product.left) (:: (get@ #file-system platform) lift)) @@ -174,11 +176,11 @@ ## (io.fail error)) ) - (def: #export (compile platform configuration) + (def: #export (compile platform configuration translation-bundle) (All [fs anchor expression statement] - (-> <Platform> Configuration (fs Any))) + (-> <Platform> Configuration <Bundle> (fs Any))) (do (:: (get@ #file-system platform) &monad) - [compiler (initialize platform configuration) + [compiler (initialize platform configuration translation-bundle) _ (compile-module platform (set@ #cli.module ..prelude configuration) compiler) _ (compile-module platform configuration compiler) ## _ (cache/io.clean target ...) diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux index 96464ed2a..07aa1217e 100644 --- a/stdlib/source/lux/compiler/default/init.lux +++ b/stdlib/source/lux/compiler/default/init.lux @@ -16,7 +16,6 @@ ["." extension [".E" analysis] [".E" synthesis] - [".E" translation] [".E" statement]]] [// ["." host]]]) @@ -72,13 +71,14 @@ #.extensions [] #.host host}) -(def: #export (state host translate) +(def: #export (state host translate translation-bundle) (All [anchor expression statement] (-> (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 [translationE.bundle (translation.state host)] + translation-state [translation-bundle (translation.state host)] eval (evaluation.evaluator synthesis-state translation-state translate) analysis-state [(analysisE.bundle eval) (..compiler host)]] [statementE.bundle diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux index 0f01b48da..ed2f81735 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux @@ -103,7 +103,7 @@ (case.case compile input branches) (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) - (extension.apply compile [extension-name extension-args]) + (extension.apply "Analysis" compile [extension-name extension-args]) (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])] [_ (#.Identifier ["" arg-name])]))] diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux index 56e8560f0..99c7152c7 100644 --- a/stdlib/source/lux/compiler/default/phase/extension.lux +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -8,6 +8,7 @@ ["." text format] [collection + [list ("list/." Functor<List>)] ["." dictionary (#+ Dictionary)]]] ["." function]] ["." //]) @@ -38,11 +39,18 @@ [(exception: #export (<name> {name Text}) (ex.report ["Extension" (%t name)]))] - [unknown] [cannot-overwrite] [invalid-syntax] ) +(exception: #export [s i o] (unknown {where Text} {name Text} {bundle (Bundle s i o)}) + (ex.report ["Where" (%t where)] + ["Extension" (%t name)] + ["Available" (|> bundle + dictionary.keys + (list/map (|>> %t (format "\n\t"))) + (text.join-with ""))])) + (exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat}) (ex.report ["Extension" (%t name)] ["Expected" (%n arity)] @@ -57,13 +65,13 @@ (#error.Success [[(dictionary.put name handler bundle) state] []])))) -(def: #export (apply phase [name parameters]) +(def: #export (apply where phase [name parameters]) (All [s i o] - (-> (Phase s i o) (Extension i) (Operation s i o o))) + (-> Text (Phase s i o) (Extension i) (Operation s i o o))) (function (_ (^@ stateE [bundle state])) (case (dictionary.get name bundle) #.None - (ex.throw unknown name) + (ex.throw unknown [where name bundle]) (#.Some handler) ((handler name phase) parameters stateE)))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux index 65fcf8550..884ef7302 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -147,29 +147,30 @@ (bundle.install "exit" (unary Int Nothing)) (bundle.install "current-time" (nullary Int))))) -(def: bundle::bit +(def: I64* (type (I64 Any))) + +(def: bundle::i64 Bundle - (<| (bundle.prefix "bit") + (<| (bundle.prefix "i64") (|> bundle.empty - (bundle.install "and" (binary Nat Nat Nat)) - (bundle.install "or" (binary Nat Nat Nat)) - (bundle.install "xor" (binary Nat Nat Nat)) - (bundle.install "left-shift" (binary Nat Nat Nat)) - (bundle.install "logical-right-shift" (binary Nat Nat Nat)) - (bundle.install "arithmetic-right-shift" (binary Int Nat Int)) - ))) + (bundle.install "and" (binary I64* I64* I64)) + (bundle.install "or" (binary I64* I64* I64)) + (bundle.install "xor" (binary I64* I64* I64)) + (bundle.install "left-shift" (binary Nat I64* I64)) + (bundle.install "logical-right-shift" (binary Nat I64* I64)) + (bundle.install "arithmetic-right-shift" (binary Nat I64* I64)) + (bundle.install "+" (binary I64* I64* I64)) + (bundle.install "-" (binary I64* I64* I64)) + (bundle.install "=" (binary I64* I64* Bit))))) (def: bundle::int Bundle (<| (bundle.prefix "int") (|> bundle.empty - (bundle.install "+" (binary Int Int Int)) - (bundle.install "-" (binary Int Int Int)) (bundle.install "*" (binary Int Int Int)) (bundle.install "/" (binary Int Int Int)) (bundle.install "%" (binary Int Int Int)) - (bundle.install "=" (binary Int Int Bit)) - (bundle.install "<" (binary Int Int Bit)) + (bundle.install "<" (binary Int Int Int)) (bundle.install "to-frac" (unary Int Frac)) (bundle.install "char" (unary Int Text))))) @@ -210,7 +211,7 @@ (<| (bundle.prefix "lux") (|> bundle.empty (dictionary.merge (bundle::lux eval)) - (dictionary.merge bundle::bit) + (dictionary.merge bundle::i64) (dictionary.merge bundle::int) (dictionary.merge bundle::frac) (dictionary.merge bundle::text) diff --git a/stdlib/source/lux/compiler/default/phase/statement/total.lux b/stdlib/source/lux/compiler/default/phase/statement/total.lux index 967f07294..8b81a134c 100644 --- a/stdlib/source/lux/compiler/default/phase/statement/total.lux +++ b/stdlib/source/lux/compiler/default/phase/statement/total.lux @@ -28,7 +28,7 @@ Phase (case code (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) - (extension.apply phase [name inputs]) + (extension.apply "Statement" phase [name inputs]) (^ [_ (#.Form (list& macro inputs))]) (do ///.Monad<Operation> diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux index 6cdd9b6fc..0d15ae463 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux @@ -1,9 +1,11 @@ (.module: [lux (#- primitive) [control - ["." monad (#+ do)]] + ["." monad (#+ do)] + pipe] [data ["." maybe] + ["." error] [collection ["." list ("list/." Functor<List>)] ["." dictionary (#+ Dictionary)]]]] @@ -70,5 +72,15 @@ (function.abstraction phase environmentA bodyA) (#analysis.Extension name args) - (extension.apply phase [name args]) + (function (_ state) + (|> (extension.apply "Synthesis" phase [name args]) + (///.run' state) + (case> (#error.Success output) + (#error.Success output) + + (#error.Error error) + (<| (///.run' state) + (do ///.Monad<Operation> + [argsS+ (monad.map @ phase args)] + (wrap (#//.Extension [name argsS+]))))))) )) |