diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/meta.lux | 109 |
1 files changed, 52 insertions, 57 deletions
diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 6f1fb2720..e65e09b58 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -7,44 +7,44 @@ [product] [ident "ident/" Codec<Text,Ident> Eq<Ident>] [maybe] - ["E" error] + ["e" error] [text "text/" Monoid<Text> Eq<Text>] (coll [list "list/" Monoid<List> Monad<List>]))) (. [code])) ## (type: (Meta a) -## (-> Compiler (E;Error [Compiler a]))) +## (-> Compiler (e;Error [Compiler a]))) (struct: #export _ (F;Functor Meta) (def: (map f fa) (function [state] (case (fa state) - (#E;Error msg) - (#E;Error msg) + (#e;Error msg) + (#e;Error msg) - (#E;Success [state' a]) - (#E;Success [state' (f a)]))))) + (#e;Success [state' a]) + (#e;Success [state' (f a)]))))) (struct: #export _ (A;Applicative Meta) (def: functor Functor<Meta>) (def: (wrap x) (function [state] - (#E;Success [state x]))) + (#e;Success [state x]))) (def: (apply ff fa) (function [state] (case (ff state) - (#E;Success [state' f]) + (#e;Success [state' f]) (case (fa state') - (#E;Success [state'' a]) - (#E;Success [state'' (f a)]) + (#e;Success [state'' a]) + (#e;Success [state'' (f a)]) - (#E;Error msg) - (#E;Error msg)) + (#e;Error msg) + (#e;Error msg)) - (#E;Error msg) - (#E;Error msg))))) + (#e;Error msg) + (#e;Error msg))))) (struct: #export _ (Monad Meta) (def: applicative Applicative<Meta>) @@ -52,10 +52,10 @@ (def: (join mma) (function [state] (case (mma state) - (#E;Error msg) - (#E;Error msg) + (#e;Error msg) + (#e;Error msg) - (#E;Success [state' ma]) + (#e;Success [state' ma]) (ma state'))))) (def: (get k plist) @@ -71,68 +71,63 @@ (get k plist')))) (def: #export (run' compiler action) - (All [a] (-> Compiler (Meta a) (E;Error [Compiler a]))) + (All [a] (-> Compiler (Meta a) (e;Error [Compiler a]))) (action compiler)) (def: #export (run compiler action) - (All [a] (-> Compiler (Meta a) (E;Error a))) + (All [a] (-> Compiler (Meta a) (e;Error a))) (case (action compiler) - (#E;Error error) - (#E;Error error) + (#e;Error error) + (#e;Error error) - (#E;Success [_ output]) - (#E;Success output))) + (#e;Success [_ output]) + (#e;Success output))) (def: #export (either left right) {#;doc "Pick whichever computation succeeds."} (All [a] (-> (Meta a) (Meta a) (Meta a))) (function [compiler] (case (left compiler) - (#E;Error error) + (#e;Error error) (right compiler) - (#E;Success [compiler' output]) - (#E;Success [compiler' output])))) + (#e;Success [compiler' output]) + (#e;Success [compiler' output])))) (def: #export (assert message test) {#;doc "Fails with the given message if the test is false."} (-> Text Bool (Meta Unit)) (function [compiler] (if test - (#E;Success [compiler []]) - (#E;Error message)))) + (#e;Success [compiler []]) + (#e;Error message)))) (def: #export (fail msg) {#;doc "Fails with the given message."} (All [a] (-> Text (Meta a))) (function [_] - (#E;Error msg))) + (#e;Error msg))) (def: #export (find-module name) (-> Text (Meta Module)) (function [state] (case (get name (get@ #;modules state)) (#;Some module) - (#E;Success [state module]) + (#e;Success [state module]) _ - (#E;Error ($_ text/compose "Unknown module: " name))))) + (#e;Error ($_ text/compose "Unknown module: " name))))) (def: #export current-module-name (Meta Text) (function [state] - (case (list;last (get@ #;scopes state)) - (#;Some scope) - (case (get@ #;name scope) - (#;Cons m-name #;Nil) - (#E;Success [state m-name]) - - _ - (#E;Error "Improper name for scope.")) + (case (get@ #;current-module state) + (#;Some current-module) + (#e;Success [state current-module]) _ - (#E;Error "Empty environment!") + (#e;Error "No current module.") ))) (def: #export current-module @@ -262,7 +257,7 @@ (let [[module name] ident] (: (Meta (Maybe Macro)) (function [state] - (#E;Success [state (find-macro' (get@ #;modules state) this-module module name)])))))) + (#e;Success [state (find-macro' (get@ #;modules state) this-module module name)])))))) (def: #export (normalize ident) {#;doc "If given an identifier without a module prefix, gives it the current module's name as prefix. @@ -361,7 +356,7 @@ A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} (-> Text (Meta Code)) (function [state] - (#E;Success [(update@ #;seed n.inc state) + (#e;Success [(update@ #;seed n.inc state) (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) (def: (get-local-symbol ast) @@ -412,7 +407,7 @@ (def: #export (module-exists? module) (-> Text (Meta Bool)) (function [state] - (#E;Success [state (case (get module (get@ #;modules state)) + (#e;Success [state (case (get module (get@ #;modules state)) (#;Some _) true @@ -446,10 +441,10 @@ (get@ [#;captured #;mappings] scope)))] (wrap type)) (#;Some var-type) - (#E;Success [state var-type]) + (#e;Success [state var-type]) #;None - (#E;Error ($_ text/compose "Unknown variable: " name)))))) + (#e;Error ($_ text/compose "Unknown variable: " name)))))) (def: #export (find-def name) {#;doc "Looks-up a definition's whole data in the available modules (including the current one)."} @@ -461,10 +456,10 @@ (^slots [#;defs]) (get v-prefix (get@ #;modules state))] (get v-name defs))) (#;Some _anns) - (#E;Success [state _anns]) + (#e;Success [state _anns]) _ - (#E;Error ($_ text/compose "Unknown definition: " (ident/encode name)))))) + (#e;Error ($_ text/compose "Unknown definition: " (ident/encode name)))))) (def: #export (find-def-type name) {#;doc "Looks-up a definition's type in the available modules (including the current one)."} @@ -495,8 +490,8 @@ (-> Text (Meta (List [Text Def]))) (function [state] (case (get module-name (get@ #;modules state)) - #;None (#E;Error ($_ text/compose "Unknown module: " module-name)) - (#;Some module) (#E;Success [state (get@ #;defs module)]) + #;None (#e;Error ($_ text/compose "Unknown module: " module-name)) + (#;Some module) (#e;Success [state (get@ #;defs module)]) ))) (def: #export (exports module-name) @@ -516,7 +511,7 @@ (|> state (get@ #;modules) [state] - #E;Success))) + #e;Success))) (def: #export (tags-of type-name) {#;doc "All the tags associated with a type definition."} @@ -535,7 +530,7 @@ {#;doc "The cursor of the current expression being analyzed."} (Meta Cursor) (function [state] - (#E;Success [state (get@ #;cursor state)]))) + (#e;Success [state (get@ #;cursor state)]))) (def: #export expected-type {#;doc "The expected type of the current expression being analyzed."} @@ -543,10 +538,10 @@ (function [state] (case (get@ #;expected state) (#;Some type) - (#E;Success [state type]) + (#e;Success [state type]) #;None - (#E;Error "Not expecting any type.")))) + (#e;Error "Not expecting any type.")))) (def: #export (imported-modules module-name) {#;doc "All the modules imported by a specified module."} @@ -591,10 +586,10 @@ (function [state] (case (list;inits (get@ #;scopes state)) #;None - (#E;Error "No local environment") + (#e;Error "No local environment") (#;Some scopes) - (#E;Success [state + (#e;Success [state (list/map (|>. (get@ [#;locals #;mappings]) (list/map (function [[name [type _]]] [name type]))) @@ -617,12 +612,12 @@ {#;doc "Obtains the current state of the compiler."} (Meta Compiler) (function [compiler] - (#E;Success [compiler compiler]))) + (#e;Success [compiler compiler]))) (def: #export type-context (Meta Type-Context) (function [compiler] - (#E;Success [compiler (get@ #;type-context compiler)]))) + (#e;Success [compiler (get@ #;type-context compiler)]))) (do-template [<macro> <func> <desc>] [(macro: #export (<macro> tokens) |