aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/meta.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-10-26 21:41:41 -0400
committerEduardo Julian2017-10-26 21:41:41 -0400
commit3439602c2b356eaef3359b6496a0237f1af55e33 (patch)
tree90c3c1d0f97fc30b1a991de50977d8a075564724 /stdlib/source/lux/meta.lux
parente2621632653ad1252744eecff6da143faaf90787 (diff)
- Added a new piece of compiler state, just for storing the current-module.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/meta.lux109
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)