diff options
Diffstat (limited to '')
6 files changed, 71 insertions, 74 deletions
diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux index 808c6b4fd..56e8560f0 100644 --- a/stdlib/source/lux/compiler/default/phase/extension.lux +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -5,9 +5,10 @@ ["ex" exception (#+ exception:)]] [data ["." error (#+ Error)] - ["." text] + ["." text + format] [collection - ["dict" dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)]]] ["." function]] ["." //]) @@ -35,26 +36,32 @@ (do-template [<name>] [(exception: #export (<name> {name Text}) - (ex.report ["Name" name]))] + (ex.report ["Extension" (%t name)]))] [unknown] [cannot-overwrite] + [invalid-syntax] ) +(exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat}) + (ex.report ["Extension" (%t name)] + ["Expected" (%n arity)] + ["Actual" (%n args)])) + (def: #export (install name handler) (All [s i o] (-> Text (Handler s i o) (Operation s i o Any))) (function (_ [bundle state]) - (if (dict.contains? name bundle) + (if (dictionary.contains? name bundle) (ex.throw cannot-overwrite name) - (#error.Success [[(dict.put name handler bundle) state] + (#error.Success [[(dictionary.put name handler bundle) state] []])))) (def: #export (apply phase [name parameters]) (All [s i o] (-> (Phase s i o) (Extension i) (Operation s i o o))) (function (_ (^@ stateE [bundle state])) - (case (dict.get name bundle) + (case (dictionary.get name bundle) #.None (ex.throw unknown name) 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 59a99800b..65fcf8550 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -37,7 +37,7 @@ (analyse argC))) (list.zip2 inputsT+ args))] (wrap (#analysis.Extension extension-name argsA))) - (////.throw bundle.incorrect-arity [extension-name num-expected num-actual])))))) + (////.throw ///.incorrect-arity [extension-name num-expected num-actual])))))) (def: #export (nullary valueT) (-> Type Handler) @@ -80,7 +80,7 @@ (wrap (#analysis.Extension extension-name (list opA)))) _ - (////.throw bundle.incorrect-arity [extension-name 1 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) (def: lux::in-module Handler @@ -91,7 +91,7 @@ (analyse exprC)) _ - (////.throw bundle.invalid-syntax [extension-name])))) + (////.throw ///.invalid-syntax [extension-name])))) (do-template [<name> <type>] [(def: (<name> eval) @@ -108,7 +108,7 @@ (analyse valueC))) _ - (////.throw bundle.incorrect-arity [extension-name 2 (list.size args)]))))] + (////.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))] [lux::check actualT] [lux::coerce Any] @@ -126,7 +126,7 @@ (wrap valueA)) _ - (////.throw bundle.incorrect-arity [extension-name 1 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) (def: (bundle::lux eval) (-> Eval Bundle) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux index 5ba07b362..069ec4e1a 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux @@ -231,7 +231,7 @@ (wrap (#analysis.Extension extension-name (list arrayA)))) _ - (////.throw bundle.incorrect-arity [extension-name 1 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) (def: array::new Handler @@ -270,7 +270,7 @@ lengthA)))) _ - (////.throw bundle.incorrect-arity [extension-name 1 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) (def: (check-jvm objectT) (-> Type (Operation Text)) @@ -344,7 +344,7 @@ (wrap (#analysis.Extension extension-name (list (analysis.text elem-class) idxA arrayA)))) _ - (////.throw bundle.incorrect-arity [extension-name 2 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) (def: array::write Handler @@ -366,7 +366,7 @@ (wrap (#analysis.Extension extension-name (list (analysis.text elem-class) idxA valueA arrayA)))) _ - (////.throw bundle.incorrect-arity [extension-name 3 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 3 (list.size args)])))) (def: bundle::array Bundle @@ -389,7 +389,7 @@ (wrap (#analysis.Extension extension-name (list)))) _ - (////.throw bundle.incorrect-arity [extension-name 0 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 0 (list.size args)])))) (def: object::null? Handler @@ -404,7 +404,7 @@ (wrap (#analysis.Extension extension-name (list objectA)))) _ - (////.throw bundle.incorrect-arity [extension-name 1 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) (def: object::synchronized Handler @@ -419,7 +419,7 @@ (wrap (#analysis.Extension extension-name (list monitorA exprA)))) _ - (////.throw bundle.incorrect-arity [extension-name 2 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) (host.import: java/lang/Object (equals [Object] boolean)) @@ -516,7 +516,7 @@ (wrap (#analysis.Extension extension-name (list exceptionA)))) _ - (////.throw bundle.incorrect-arity [extension-name 1 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) (def: object::class Handler @@ -531,10 +531,10 @@ (wrap (#analysis.Extension extension-name (list (analysis.text class))))) _ - (////.throw bundle.invalid-syntax extension-name)) + (////.throw ///.invalid-syntax extension-name)) _ - (////.throw bundle.incorrect-arity [extension-name 1 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) (def: object::instance? Handler @@ -554,10 +554,10 @@ (////.throw cannot-possibly-be-an-instance (format object-class " !<= " class)))) _ - (////.throw bundle.invalid-syntax extension-name)) + (////.throw ///.invalid-syntax extension-name)) _ - (////.throw bundle.incorrect-arity [extension-name 2 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) (def: (java-type-to-class jvm-type) (-> java/lang/reflect/Type (Operation Text)) @@ -739,7 +739,7 @@ " For value: " (%code valueC) "\n")))) _ - (////.throw bundle.invalid-syntax extension-name)))) + (////.throw ///.invalid-syntax extension-name)))) (def: bundle::object Bundle @@ -828,10 +828,10 @@ (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field))))) _ - (////.throw bundle.invalid-syntax extension-name)) + (////.throw ///.invalid-syntax extension-name)) _ - (////.throw bundle.incorrect-arity [extension-name 2 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) (def: static::put Handler @@ -850,10 +850,10 @@ (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) valueA)))) _ - (////.throw bundle.invalid-syntax extension-name)) + (////.throw ///.invalid-syntax extension-name)) _ - (////.throw bundle.incorrect-arity [extension-name 3 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 3 (list.size args)])))) (def: virtual::get Handler @@ -869,10 +869,10 @@ (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) objectA)))) _ - (////.throw bundle.invalid-syntax extension-name)) + (////.throw ///.invalid-syntax extension-name)) _ - (////.throw bundle.incorrect-arity [extension-name 3 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 3 (list.size args)])))) (def: virtual::put Handler @@ -893,10 +893,10 @@ (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) valueA objectA)))) _ - (////.throw bundle.invalid-syntax extension-name)) + (////.throw ///.invalid-syntax extension-name)) _ - (////.throw bundle.incorrect-arity [extension-name 4 (list.size args)])))) + (////.throw ///.incorrect-arity [extension-name 4 (list.size args)])))) (def: (java-type-to-parameter type) (-> java/lang/reflect/Type (Operation Text)) @@ -1155,7 +1155,7 @@ (analysis.text outputJC) (decorate-inputs argsT argsA))))) _ - (////.throw bundle.invalid-syntax extension-name)))) + (////.throw ///.invalid-syntax extension-name)))) (def: invoke::virtual Handler @@ -1178,7 +1178,7 @@ (analysis.text outputJC) objectA (decorate-inputs argsT argsA))))) _ - (////.throw bundle.invalid-syntax extension-name)))) + (////.throw ///.invalid-syntax extension-name)))) (def: invoke::special Handler @@ -1195,7 +1195,7 @@ (analysis.text outputJC) (decorate-inputs argsT argsA))))) _ - (////.throw bundle.invalid-syntax extension-name)))) + (////.throw ///.invalid-syntax extension-name)))) (def: invoke::interface Handler @@ -1216,7 +1216,7 @@ (decorate-inputs argsT argsA))))) _ - (////.throw bundle.invalid-syntax extension-name)))) + (////.throw ///.invalid-syntax extension-name)))) (def: invoke::constructor Handler @@ -1231,7 +1231,7 @@ (wrap (#analysis.Extension extension-name (list& (analysis.text class) (decorate-inputs argsT argsA))))) _ - (////.throw bundle.invalid-syntax extension-name)))) + (////.throw ///.invalid-syntax extension-name)))) (def: bundle::member Bundle diff --git a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux index 4fe68b23c..582526694 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux @@ -1,8 +1,7 @@ (.module: [lux #* [control - [monad (#+ do)] - ["ex" exception (#+ exception:)]] + [monad (#+ do)]] [data ["." text format] @@ -11,15 +10,6 @@ ["." dictionary (#+ Dictionary)]]]] [// (#+ Handler Bundle)]) -(exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat}) - (ex.report ["Extension" (%t name)] - ["Expected arity" (|> arity .int %i)] - ["Actual arity" (|> args .int %i)])) - -(exception: #export (invalid-syntax {name Text}) - (ex.report ["Extension" name])) - -## [Utils] (def: #export empty Bundle (dictionary.new text.Hash<Text>)) diff --git a/stdlib/source/lux/compiler/default/phase/extension/statement.lux b/stdlib/source/lux/compiler/default/phase/extension/statement.lux index afc7c843c..6d2fbaa4e 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/statement.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/statement.lux @@ -12,21 +12,21 @@ ["." macro] [type (#+ :share) ["." check]]] - ["." /// - ["." analysis - ["." module] - ["." type]] - ["." synthesis] - ["." translation] - ["." statement (#+ Operation Handler Bundle)] - ["." extension - ["." bundle]]]) + ["." // + ["." bundle] + ["/." // + ["." analysis + ["." module] + ["." type]] + ["." synthesis] + ["." translation] + ["." statement (#+ Operation Handler Bundle)]]]) (def: (evaluate! type codeC) (All [anchor expression statement] (-> Type Code (Operation anchor expression statement [Type expression Any]))) (do ///.Monad<Operation> - [state (extension.lift ///.get-state) + [state (//.lift ///.get-state) #let [analyse (get@ [#statement.analysis #statement.phase] state) synthesize (get@ [#statement.synthesis #statement.phase] state) translate (get@ [#statement.translation #statement.phase] state)] @@ -52,7 +52,7 @@ (-> Name (Maybe Type) Code (Operation anchor expression statement [Type expression Text Any]))) (do ///.Monad<Operation> - [state (extension.lift ///.get-state) + [state (//.lift ///.get-state) #let [analyse (get@ [#statement.analysis #statement.phase] state) synthesize (get@ [#statement.synthesis #statement.phase] state) translate (get@ [#statement.translation #statement.phase] state)] @@ -90,7 +90,7 @@ [[_ annotationsT annotationsV] (evaluate! Code annotationsC) #let [annotationsV (:coerce Code annotationsV)] current-module (statement.lift-analysis - (extension.lift + (//.lift macro.current-module-name)) #let [full-name [current-module def-name]] [value//type valueT valueN valueV] (define! full-name @@ -114,12 +114,12 @@ (translation.learn full-name valueN))) _ - (///.throw bundle.invalid-syntax [extension-name])))) + (///.throw //.invalid-syntax [extension-name])))) (def: (alias! alias def-name) (-> Text Name (analysis.Operation Any)) (do ///.Monad<Operation> - [definition (extension.lift (macro.find-def def-name))] + [definition (//.lift (macro.find-def def-name))] (module.define alias definition))) (def: def::module @@ -134,20 +134,20 @@ (wrap [])) _ - (///.throw bundle.invalid-syntax [extension-name])))) + (///.throw //.invalid-syntax [extension-name])))) (def: def::alias Handler (function (_ extension-name phase inputsC+) (case inputsC+ (^ (list [_ (#.Identifier ["" alias])] [_ (#.Identifier def-name)])) - (extension.lift + (//.lift (///.sub [(get@ [#statement.analysis #statement.state]) (set@ [#statement.analysis #statement.state])] (alias! alias def-name))) _ - (///.throw bundle.invalid-syntax [extension-name])))) + (///.throw //.invalid-syntax [extension-name])))) (do-template [<mame> <type> <scope>] [(def: <mame> @@ -164,7 +164,7 @@ (:assume [])})) valueC)] (<| <scope> - (extension.install name) + (//.install name) (:share [anchor expression statement] {(Handler anchor expression statement) handler} @@ -172,7 +172,7 @@ (:assume handlerV)}))) _ - (///.throw bundle.invalid-syntax [extension-name]))))] + (///.throw //.invalid-syntax [extension-name]))))] [def::analysis analysis.Handler statement.lift-analysis] [def::synthesis synthesis.Handler statement.lift-synthesis] diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux index 65184a7ea..0854fcaa9 100644 --- a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux @@ -20,7 +20,7 @@ ["." runtime (#+ Operation Phase Handler Bundle)] ["//." /// ["." synthesis (#+ Synthesis)] - [extension + ["." extension ["." bundle]] [/// [host @@ -38,24 +38,24 @@ ## [Utils] (syntax: (arity: {name s.local-identifier} {arity s.nat}) - (with-gensyms [g!_ g!extension g!name g!translate g!inputs] + (with-gensyms [g!_ g!extension g!name g!phase g!inputs] (do @ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation) Handler) - (function ((~ g!_) (~ g!name) (~ g!translate) (~ g!inputs)) + (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) (do /////.Monad<Operation> [(~+ (|> g!input+ (list/map (function (_ g!input) - (list g!input (` ((~ g!translate) (~ g!input)))))) + (list g!input (` ((~ g!phase) (~ g!input)))))) list.concat))] ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) (~' _) - (/////.throw bundle.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) + (/////.throw extension.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) (arity: nullary 0) (arity: unary 1) @@ -65,9 +65,9 @@ (def: #export (variadic extension) (-> Variadic Handler) (function (_ extension-name) - (function (_ translate inputsS) + (function (_ phase inputsS) (do /////.Monad<Operation> - [inputsI (monad.map @ translate inputsS)] + [inputsI (monad.map @ phase inputsS)] (wrap (extension inputsI)))))) ## [Bundle] |