aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2018-08-16 06:22:54 -0400
committerEduardo Julian2018-08-16 06:22:54 -0400
commite4c1b1645fa1a62a0bf8c90723eab7be634dd67f (patch)
tree8413a7270493bc18c7af67d9458e7c31331a0fc7
parent18bb5f90d24376d3731986bf2c16bf6b58dcd3cb (diff)
Extension-related fixes.
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux18
-rw-r--r--new-luxc/source/program.lux6
-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
10 files changed, 70 insertions, 45 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
index f250604b5..9579acaa3 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux
@@ -67,4 +67,4 @@
(function.function translate abstraction)
(#synthesis.Extension extension)
- (extension.apply translate extension)))
+ (extension.apply "Translation" translate extension)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index efccb25f6..d1826669a 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -307,27 +307,27 @@
(bundle.install "is" (binary lux::is))
(bundle.install "try" (unary lux::try))))
-(def: bundle::bit
+(def: bundle::i64
Bundle
- (<| (bundle.prefix "bit")
+ (<| (bundle.prefix "i64")
(|> (: Bundle bundle.empty)
(bundle.install "and" (binary bit::and))
(bundle.install "or" (binary bit::or))
(bundle.install "xor" (binary bit::xor))
(bundle.install "left-shift" (binary bit::left-shift))
(bundle.install "logical-right-shift" (binary bit::logical-right-shift))
- (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift)))))
+ (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift))
+ (bundle.install "+" (binary i64::+))
+ (bundle.install "-" (binary i64::-))
+ (bundle.install "=" (binary i64::=)))))
-(def: bundle::i64
+(def: bundle::int
Bundle
- (<| (bundle.prefix "i64")
+ (<| (bundle.prefix "int")
(|> (: Bundle bundle.empty)
- (bundle.install "+" (binary i64::+))
- (bundle.install "-" (binary i64::-))
(bundle.install "*" (binary i64::*))
(bundle.install "/" (binary i64::/))
(bundle.install "%" (binary i64::%))
- (bundle.install "=" (binary i64::=))
(bundle.install "<" (binary i64::<))
(bundle.install "to-f64" (unary i64::to-f64))
(bundle.install "char" (unary i64::char)))))
@@ -375,8 +375,8 @@
Bundle
(<| (bundle.prefix "lux")
(|> bundle::lux
- (dictionary.merge bundle::bit)
(dictionary.merge bundle::i64)
+ (dictionary.merge bundle::int)
(dictionary.merge bundle::f64)
(dictionary.merge bundle::text)
(dictionary.merge bundle::io))))
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 01b3a2eee..7b29f7283 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -27,7 +27,9 @@
[translation
["." jvm
["." runtime]
- ["." expression]]]]])
+ ["." expression]
+ [procedure
+ ["." common]]]]]])
(def: (or-crash! failure-description action)
(All [a]
@@ -72,7 +74,7 @@
(#cli.Compilation configuration)
(<| (or-crash! "Compilation failed:")
..timed
- (default.compile platform configuration))
+ (default.compile platform configuration common.bundle))
(#cli.Interpretation configuration)
(<| (or-crash! "Interpretation failed:")
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+])))))))
))