aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/compiler/default.lux18
-rw-r--r--stdlib/source/lux/compiler/default/init.lux6
-rw-r--r--stdlib/source/lux/compiler/default/phase/analysis/expression.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension.lux16
-rw-r--r--stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux29
-rw-r--r--stdlib/source/lux/compiler/default/phase/statement/total.lux2
-rw-r--r--stdlib/source/lux/compiler/default/phase/synthesis/expression.lux16
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+])))))))
))