aboutsummaryrefslogtreecommitdiff
path: root/stdlib
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
parente2621632653ad1252744eecff6da143faaf90787 (diff)
- Added a new piece of compiler state, just for storing the current-module.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux.lux76
-rw-r--r--stdlib/source/lux/meta.lux109
2 files changed, 92 insertions, 93 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 9509c7ad5..7aa9a96a6 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -710,6 +710,7 @@
## {#info Info
## #source Source
## #cursor Cursor
+## #current-module (Maybe Text)
## #modules (List [Text Module])
## #scopes (List Scope)
## #type-context Type-Context
@@ -725,32 +726,35 @@
Source
(#Product ## "lux;cursor"
Cursor
- (#Product ## "lux;modules"
- (#Apply (#Product Text Module) List)
- (#Product ## "lux;scopes"
- (#Apply Scope List)
- (#Product ## "lux;type-context"
- Type-Context
- (#Product ## "lux;expected"
- (#Apply Type Maybe)
- (#Product ## "lux;seed"
- Nat
- (#Product ## scope-type-vars
- (#Apply Nat List)
- ## "lux;host"
- Void))))))))))
+ (#Product ## "lux;current-module"
+ (#Apply Text Maybe)
+ (#Product ## "lux;modules"
+ (#Apply (#Product Text Module) List)
+ (#Product ## "lux;scopes"
+ (#Apply Scope List)
+ (#Product ## "lux;type-context"
+ Type-Context
+ (#Product ## "lux;expected"
+ (#Apply Type Maybe)
+ (#Product ## "lux;seed"
+ Nat
+ (#Product ## scope-type-vars
+ (#Apply Nat List)
+ ## "lux;host"
+ Void)))))))))))
(record$ (#Cons [(tag$ ["lux" "tags"])
(tuple$ (#Cons (text$ "info")
(#Cons (text$ "source")
(#Cons (text$ "cursor")
- (#Cons (text$ "modules")
- (#Cons (text$ "scopes")
- (#Cons (text$ "type-context")
- (#Cons (text$ "expected")
- (#Cons (text$ "seed")
- (#Cons (text$ "scope-type-vars")
- (#Cons (text$ "host")
- #Nil)))))))))))]
+ (#Cons (text$ "current-module")
+ (#Cons (text$ "modules")
+ (#Cons (text$ "scopes")
+ (#Cons (text$ "type-context")
+ (#Cons (text$ "expected")
+ (#Cons (text$ "seed")
+ (#Cons (text$ "scope-type-vars")
+ (#Cons (text$ "host")
+ #Nil))))))))))))]
(#Cons [(tag$ ["lux" "doc"])
(text$ "Represents the state of the Lux compiler during a run.
@@ -1807,7 +1811,7 @@
#Nil
(-> Ident ($' Meta Ident))
(let' [[module name] ident
- {#info info #source source #modules modules
+ {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars} state]
@@ -1970,12 +1974,12 @@
#Nil
($' Meta Text)
("lux case" state
- {#info info #source source #modules modules
+ {#info info #source source #current-module current-module #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars}
- ("lux case" (reverse scopes)
- (#Cons {#name (#;Cons module-name #Nil) #inner _ #locals _ #captured _} _)
+ ("lux case" current-module
+ (#;Some module-name)
(#Right [state module-name])
_
@@ -2440,7 +2444,7 @@
(let' [[module name] ident]
(function' [state]
("lux case" state
- {#info info #source source #modules modules
+ {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected
#cursor cursor
@@ -2698,12 +2702,12 @@
#Nil
(-> Text ($' Meta Code))
("lux case" state
- {#info info #source source #modules modules
+ {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected
#cursor cursor
#scope-type-vars scope-type-vars}
- (#Right {#info info #source source #modules modules
+ (#Right {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed (n.+ +1 seed) #expected expected
#cursor cursor
@@ -3562,7 +3566,7 @@
(def: (find-module name)
(-> Text (Meta Module))
(function [state]
- (let [{#info info #source source #modules modules
+ (let [{#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars} state]
@@ -3625,7 +3629,7 @@
(def: get-expected-type
(Meta Type)
(function [state]
- (let [{#info info #source source #modules modules
+ (let [{#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars} state]
@@ -4145,7 +4149,7 @@
(def: (exported-defs module state)
(-> Text (Meta (List Text)))
(let [modules (case state
- {#info info #source source #modules modules
+ {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars}
@@ -4200,7 +4204,7 @@
(def: (find-in-env name state)
(-> Text Compiler (Maybe Type))
(case state
- {#info info #source source #modules modules
+ {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars}
@@ -4223,7 +4227,7 @@
(def: (find-def-type name state)
(-> Ident Compiler (Maybe Type))
(let [[v-prefix v-name] name
- {#info info #source source #modules modules
+ {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars} state]
@@ -4242,7 +4246,7 @@
(def: (find-def-value name state)
(-> Ident (Meta [Type Top]))
(let [[v-prefix v-name] name
- {#info info #source source #modules modules
+ {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars} state]
@@ -5609,7 +5613,7 @@
(def: (get-scope-type-vars state)
(Meta (List Nat))
(case state
- {#info info #source source #modules modules
+ {#info info #source source #current-module _ #modules modules
#scopes scopes #type-context types #host host
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars}
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)