diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 76 | ||||
| -rw-r--r-- | stdlib/source/lux/meta.lux | 109 |
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) |