diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux.lux | 466 |
1 files changed, 233 insertions, 233 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 4ed6dd7aa..881848963 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1444,14 +1444,14 @@ (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) content))) -(def:''' (untemplate_list tokens) +(def:''' (untemplated_list tokens) #Nil (-> ($' List Code) Code) ({#Nil (_ann (#Tag ["library/lux" "Nil"])) (#Cons [token tokens']) - (_ann (#Form (list (_ann (#Tag ["library/lux" "Cons"])) token (untemplate_list tokens'))))} + (_ann (#Form (list (_ann (#Tag ["library/lux" "Cons"])) token (untemplated_list tokens'))))} tokens)) (def:''' (list\compose xs ys) @@ -1527,7 +1527,7 @@ ## (interface: (Monad m) ## (: (All [a] (-> a (m a))) -## wrap) +## in) ## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) ("lux def type tagged" Monad @@ -1538,13 +1538,13 @@ ($' m a) ($' m b)))))) (record$ (list)) - ["wrap" "bind"] + ["in" "bind"] #0) (def:''' maybe_monad #Nil ($' Monad Maybe) - {#wrap + {#in (function' [x] (#Some x)) #bind @@ -1556,7 +1556,7 @@ (def:''' meta_monad #Nil ($' Monad Meta) - {#wrap + {#in (function' [x] (function' [state] (#Right state x))) @@ -1573,7 +1573,7 @@ (macro:' (do tokens) ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) - (let' [g!wrap (local_identifier$ "wrap") + (let' [g!in (local_identifier$ "in") g!bind (local_identifier$ " bind ") body' (list\fold ("lux type check" (-> (& Code Code) Code Code) (function' [binding body'] @@ -1588,7 +1588,7 @@ var)))) body (list\reverse (as_pairs bindings)))] - (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "wrap"]) g!wrap] [(tag$ ["library/lux" "bind"]) g!bind])) + (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "in"]) g!in] [(tag$ ["library/lux" "bind"]) g!bind])) body'])) monad))))) @@ -1605,15 +1605,15 @@ (-> a ($' m b)) ($' List a) ($' m ($' List b)))) - (let' [{#wrap wrap #bind _} m] + (let' [{#in in #bind _} m] ({#Nil - (wrap #Nil) + (in #Nil) (#Cons x xs') (do m [y (f x) ys (monad\map m f xs')] - (wrap (#Cons y ys)))} + (in (#Cons y ys)))} xs))) (def:''' (monad\fold m f y xs) @@ -1626,9 +1626,9 @@ b ($' List a) ($' m b))) - (let' [{#wrap wrap #bind _} m] + (let' [{#in in #bind _} m] ({#Nil - (wrap y) + (in y) (#Cons x xs') (do m @@ -1760,13 +1760,13 @@ (#Cons lastI inits) (do meta_monad [lastO ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] - (wrap (as_code_list spliced)) + (in (as_code_list spliced)) _ (do meta_monad [lastO (untemplate lastI)] - (wrap (as_code_list (form$ (list (tag$ ["library/lux" "Cons"]) - (tuple$ (list lastO (tag$ ["library/lux" "Nil"]))))))))} + (in (as_code_list (form$ (list (tag$ ["library/lux" "Cons"]) + (tuple$ (list lastO (tag$ ["library/lux" "Nil"]))))))))} lastI)] (monad\fold meta_monad (function' [leftI rightO] @@ -1774,12 +1774,12 @@ (let' [g!in-module (form$ (list (text$ "lux in-module") (text$ "library/lux") (identifier$ ["library/lux" "list\compose"])))] - (wrap (form$ (list g!in-module (as_code_list spliced) rightO)))) + (in (form$ (list g!in-module (as_code_list spliced) rightO)))) _ (do meta_monad [leftO (untemplate leftI)] - (wrap (form$ (list (tag$ ["library/lux" "Cons"]) (tuple$ (list leftO rightO))))))} + (in (form$ (list (tag$ ["library/lux" "Cons"]) (tuple$ (list leftO rightO))))))} leftI)) lastO inits))} @@ -1787,10 +1787,10 @@ #0 (do meta_monad [=elems (monad\map meta_monad untemplate elems)] - (wrap (untemplate_list =elems)))} + (in (untemplated_list =elems)))} replace?)) -(def:''' (untemplate_text value) +(def:''' (untemplated_text value) #Nil (-> Text Code) (wrap_meta (form$ (list (tag$ ["library/lux" "Text"]) (text$ value))))) @@ -1814,7 +1814,7 @@ (return (wrap_meta (form$ (list (tag$ ["library/lux" "Frac"]) (frac$ value))))) [_ [_ (#Text value)]] - (return (untemplate_text value)) + (return (untemplated_text value)) [#0 [_ (#Tag [module name])]] (return (wrap_meta (form$ (list (tag$ ["library/lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) @@ -1832,11 +1832,11 @@ (do meta_monad [real_name ({"" (if (text\= "" subst) - (wrap [module name]) + (in [module name]) (resolve_global_identifier [subst name])) _ - (wrap [module name])} + (in [module name])} module) #let [[module name] real_name]] (return (wrap_meta (form$ (list (tag$ ["library/lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) @@ -1852,10 +1852,10 @@ [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~!"])] (#Cons [dependent #Nil])]))]] (do meta_monad [independent (untemplate replace? subst dependent)] - (wrap (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) - (untemplate_list (list (untemplate_text "lux in-module") - (untemplate_text subst) - independent))))))) + (in (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) + (untemplated_list (list (untemplated_text "lux in-module") + (untemplated_text subst) + independent))))))) [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~'"])] (#Cons [keep_quoted #Nil])]))]] (untemplate #0 subst keep_quoted) @@ -1864,13 +1864,13 @@ (do meta_monad [output (spliced replace? (untemplate replace? subst) elems) #let [[_ output'] (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) output)))]] - (wrap [meta output'])) + (in [meta output'])) [_ [meta (#Tuple elems)]] (do meta_monad [output (spliced replace? (untemplate replace? subst) elems) #let [[_ output'] (wrap_meta (form$ (list (tag$ ["library/lux" "Tuple"]) output)))]] - (wrap [meta output'])) + (in [meta output'])) [_ [_ (#Record fields)]] (do meta_monad @@ -1881,9 +1881,9 @@ (do meta_monad [=k (untemplate replace? subst k) =v (untemplate replace? subst v)] - (wrap (tuple$ (list =k =v))))))) + (in (tuple$ (list =k =v))))))) fields)] - (wrap (wrap_meta (form$ (list (tag$ ["library/lux" "Record"]) (untemplate_list =fields))))))} + (in (wrap_meta (form$ (list (tag$ ["library/lux" "Record"]) (untemplated_list =fields))))))} [replace? token])) (macro:' #export (primitive tokens) @@ -1896,7 +1896,7 @@ (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (tag$ ["library/lux" "Nil"]))))) (#Cons [_ (#Text class_name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (untemplate_list params))))) + (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (untemplated_list params))))) _ (failure "Wrong syntax for primitive")} @@ -1927,9 +1927,9 @@ (do meta_monad [current_module current_module_name =template (untemplate #1 current_module template)] - (wrap (list (form$ (list (text$ "lux type check") - (identifier$ ["library/lux" "Code"]) - =template))))) + (in (list (form$ (list (text$ "lux type check") + (identifier$ ["library/lux" "Code"]) + =template))))) _ (failure "Wrong syntax for `")} @@ -1943,7 +1943,7 @@ ({(#Cons template #Nil) (do meta_monad [=template (untemplate #1 "" template)] - (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) + (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) _ (failure "Wrong syntax for `")} @@ -1957,7 +1957,7 @@ ({(#Cons template #Nil) (do meta_monad [=template (untemplate #0 "" template)] - (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) + (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) _ (failure "Wrong syntax for '")} @@ -2287,7 +2287,7 @@ #0} type)) -(def:''' (find_macro' modules current_module module name) +(def:''' (macro' modules current_module module name) #Nil (-> ($' List (& Text Module)) Text Text Text @@ -2297,7 +2297,7 @@ gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} ("lux type check" Module $module)] (get name bindings))] ({(#Left [r_module r_name]) - (find_macro' modules current_module r_module r_name) + (macro' modules current_module r_module r_name) (#Right [exported? def_type def_meta def_value]) (if (macro_type? def_type) @@ -2315,13 +2315,13 @@ ({["" name] (do meta_monad [module_name current_module_name] - (wrap [module_name name])) + (in [module_name name])) _ (return name)} name)) -(def:''' (find_macro full_name) +(def:''' (macro full_name) #Nil (-> Name ($' Meta ($' Maybe Macro))) (do meta_monad @@ -2333,7 +2333,7 @@ #seed seed #expected expected #location location #extensions extensions #scope_type_vars scope_type_vars} - (#Right state (find_macro' modules current_module module name))} + (#Right state (macro' modules current_module module name))} state))))) (def:''' (macro? name) @@ -2341,10 +2341,10 @@ (-> Name ($' Meta Bit)) (do meta_monad [name (normalize name) - output (find_macro name)] - (wrap ({(#Some _) #1 - #None #0} - output)))) + output (macro name)] + (in ({(#Some _) #1 + #None #0} + output)))) (def:''' (interpose sep xs) #Nil @@ -2366,7 +2366,7 @@ ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] (do meta_monad [macro_name' (normalize macro_name) - ?macro (find_macro macro_name')] + ?macro (macro macro_name')] ({(#Some macro) (("lux type as" Macro' macro) args) @@ -2384,12 +2384,12 @@ ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] (do meta_monad [macro_name' (normalize macro_name) - ?macro (find_macro macro_name')] + ?macro (macro macro_name')] ({(#Some macro) (do meta_monad [expansion (("lux type as" Macro' macro) args) expansion' (monad\map meta_monad macro_expand expansion)] - (wrap (list\join expansion'))) + (in (list\join expansion'))) #None (return (list token))} @@ -2405,28 +2405,28 @@ ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] (do meta_monad [macro_name' (normalize macro_name) - ?macro (find_macro macro_name')] + ?macro (macro macro_name')] ({(#Some macro) (do meta_monad [expansion (("lux type as" Macro' macro) args) expansion' (monad\map meta_monad macro_expand_all expansion)] - (wrap (list\join expansion'))) + (in (list\join expansion'))) #None (do meta_monad [args' (monad\map meta_monad macro_expand_all args)] - (wrap (list (form$ (#Cons (identifier$ macro_name) (list\join args'))))))} + (in (list (form$ (#Cons (identifier$ macro_name) (list\join args'))))))} ?macro)) [_ (#Form members)] (do meta_monad [members' (monad\map meta_monad macro_expand_all members)] - (wrap (list (form$ (list\join members'))))) + (in (list (form$ (list\join members'))))) [_ (#Tuple members)] (do meta_monad [members' (monad\map meta_monad macro_expand_all members)] - (wrap (list (tuple$ (list\join members'))))) + (in (list (tuple$ (list\join members'))))) [_ (#Record pairs)] (do meta_monad @@ -2442,7 +2442,7 @@ (failure "The value-part of a KV-pair in a record must macro-expand to a single Code.")} val')))) pairs)] - (wrap (list (record$ pairs')))) + (in (list (record$ pairs')))) _ (return (list syntax))} @@ -2485,7 +2485,7 @@ (do meta_monad [type+ (macro_expand_all type)] ({(#Cons type' #Nil) - (wrap (list (walk_type type'))) + (in (list (walk_type type'))) _ (failure "The expansion of the type-syntax had to yield a single element.")} @@ -2762,17 +2762,17 @@ (expander init_expansion)) (do meta_monad [sub_expansion (expander branches')] - (wrap (list& (form$ (list& (identifier$ macro_name) macro_args)) - body - sub_expansion))))) + (in (list& (form$ (list& (identifier$ macro_name) macro_args)) + body + sub_expansion))))) (#Cons pattern (#Cons body branches')) (do meta_monad [sub_expansion (expander branches')] - (wrap (list& pattern body sub_expansion))) + (in (list& pattern body sub_expansion))) #Nil - (do meta_monad [] (wrap (list))) + (do meta_monad [] (in (list))) _ (failure ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches @@ -2795,7 +2795,7 @@ ({(#Cons value branches) (do meta_monad [expansion (expander branches)] - (wrap (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) + (in (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) _ (failure "Wrong syntax for case")} @@ -2818,7 +2818,7 @@ [pattern+ (macro_expand_all pattern)] (case pattern+ (#Cons pattern' #Nil) - (wrap (list& pattern' body branches)) + (in (list& pattern' body branches)) _ (failure "^ can only expand to 1 pattern."))) @@ -2952,7 +2952,7 @@ [_ (#Tuple xs)] (|> xs (list\map process_def_meta_value) - untemplate_list + untemplated_list (meta_code ["library/lux" "Tuple"])) [_ (#Record kvs)] @@ -2961,17 +2961,17 @@ (function (_ [k v]) (` [(~ (process_def_meta_value k)) (~ (process_def_meta_value v))])))) - untemplate_list + untemplated_list (meta_code ["library/lux" "Record"])) )) (def:' (process_def_meta kvs) (-> (List [Code Code]) Code) - (untemplate_list (list\map (: (-> [Code Code] Code) - (function (_ [k v]) - (` [(~ (process_def_meta_value k)) - (~ (process_def_meta_value v))]))) - kvs))) + (untemplated_list (list\map (: (-> [Code Code] Code) + (function (_ [k v]) + (` [(~ (process_def_meta_value k)) + (~ (process_def_meta_value v))]))) + kvs))) (def:' (with_func_args args meta) (-> (List Code) Code Code) @@ -3181,7 +3181,7 @@ (function (_ token) (case token (^ [_ (#Form (list [_ (#Text "lux type check")] type [_ (#Identifier ["" name])]))]) - (wrap [name type]) + (in [name type]) _ (failure "Signatures require typed members!")))) @@ -3414,7 +3414,7 @@ _ (#Some (list type)))) -(def: (find_module name) +(def: (module name) (-> Text (Meta Module)) (function (_ state) (let [{#info info #source source #current_module _ #modules modules @@ -3432,12 +3432,12 @@ (Meta Module) (do meta_monad [module_name current_module_name] - (find_module module_name))) + (module module_name))) (def: (resolve_tag [module name]) (-> Name (Meta [Nat (List Name) Bit Type])) (do meta_monad - [=module (find_module module) + [=module (..module module) #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags_table #types types #module_annotations _ #module_state _} =module]] (case (get name tags_table) (#Some output) @@ -3460,7 +3460,7 @@ (#Named [module name] unnamed) (do meta_monad - [=module (find_module module) + [=module (..module module) #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]] (case (get name types) (#Some [tags exported? (#Named _ _type)]) @@ -3514,7 +3514,7 @@ (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag_name)] value meta [_ (#Bit #0)]))]) (case (get tag_name tag_mappings) (#Some tag) - (wrap [tag value]) + (in [tag value]) _ (failure (text\compose "Unknown implementation member: " tag_name))) @@ -3522,7 +3522,7 @@ _ (failure "Invalid implementation member.")))) (list\join tokens'))] - (wrap (list (record$ members))))) + (in (list (record$ members))))) (def: (text\join_with separator parts) (-> Text (List Text) Text) @@ -3725,13 +3725,13 @@ (^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens'))) (do meta_monad [defs' (extract_defs defs)] - (wrap [(#Only defs') tokens'])) + (in [(#Only defs') tokens'])) (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens')) (^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens'))) (do meta_monad [defs' (extract_defs defs)] - (wrap [(#Exclude defs') tokens'])) + (in [(#Exclude defs') tokens'])) (^or (^ (list& [_ (#Tag ["" "*"])] tokens')) (^ (list& [_ (#Tag ["" "all"])] tokens'))) @@ -3780,7 +3780,7 @@ [index (..index_of token sample) #let [[pre post'] (text\split! index sample) [_ post] (text\split! ("lux text size" token) post')]] - (wrap [pre post]))) + (in [pre post]))) (def: (replace_all pattern replacement template) (-> Text Text Text Text) @@ -3914,17 +3914,17 @@ [_ (#Identifier ["" m_name])] (do meta_monad [m_name (clean_module nested? relative_root m_name)] - (wrap (list {#import_name m_name - #import_alias #None - #import_refer {#refer_defs #All - #refer_open (list)}}))) + (in (list {#import_name m_name + #import_alias #None + #import_refer {#refer_defs #All + #refer_open (list)}}))) ## Nested (^ [_ (#Tuple (list& [_ (#Identifier ["" m_name])] extra))]) (do meta_monad [import_name (case (normal_parallel_path relative_root m_name) (#.Some parallel_path) - (wrap parallel_path) + (in parallel_path) #.None (clean_module nested? relative_root m_name)) @@ -3933,22 +3933,22 @@ openings+extra (openings_parser extra) #let [[openings extra] openings+extra] sub_imports (imports_parser #1 import_name context_alias extra)] - (wrap (case [referral openings] - [#Nothing #Nil] - sub_imports - - _ - (list& {#import_name import_name - #import_alias #None - #import_refer {#refer_defs referral - #refer_open openings}} - sub_imports)))) + (in (case [referral openings] + [#Nothing #Nil] + sub_imports + + _ + (list& {#import_name import_name + #import_alias #None + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m_name])] extra))]) (do meta_monad [import_name (case (normal_parallel_path relative_root m_name) (#.Some parallel_path) - (wrap parallel_path) + (in parallel_path) #.None (clean_module nested? relative_root m_name)) @@ -3958,16 +3958,16 @@ #let [[openings extra] openings+extra de_aliased (de_alias context_alias m_name alias)] sub_imports (imports_parser #1 import_name de_aliased extra)] - (wrap (case [referral openings] - [#Ignore #Nil] - sub_imports - - _ - (list& {#import_name import_name - #import_alias (#Some de_aliased) - #import_refer {#refer_defs referral - #refer_open openings}} - sub_imports)))) + (in (case [referral openings] + [#Ignore #Nil] + sub_imports + + _ + (list& {#import_name import_name + #import_alias (#Some de_aliased) + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) ## Unrecognized syntax. _ @@ -3977,7 +3977,7 @@ "Wrong syntax for import @ " current_module ..\n (code\encode token))))))) imports)] - (wrap (list\join imports')))) + (in (list\join imports')))) (def: (exported_definitions module state) (-> Text (Meta (List Text))) @@ -4047,7 +4047,7 @@ #None (f x2) (#Some y) (#Some y))) -(def: (find_in_env name state) +(def: (in_env name state) (-> Text Lux (Maybe Type)) (case state {#info info #source source #current_module _ #modules modules @@ -4070,7 +4070,7 @@ (: (List [Text [Type Any]]) closure))))) scopes))) -(def: (find_def_type name state) +(def: (definition_type name state) (-> Name Lux (Maybe Type)) (let [[v_prefix v_name] name {#info info #source source #current_module _ #modules modules @@ -4089,12 +4089,12 @@ (#Some definition) (case definition (#Left de_aliased) - (find_def_type de_aliased state) + (definition_type de_aliased state) (#Right [exported? def_type def_meta def_value]) (#Some def_type)))))) -(def: (find_def_value name state) +(def: (definition_value name state) (-> Name (Meta [Type Any])) (let [[v_prefix v_name] name {#info info #source source #current_module _ #modules modules @@ -4113,12 +4113,12 @@ (#Some definition) (case definition (#Left de_aliased) - (find_def_value de_aliased state) + (definition_value de_aliased state) (#Right [exported? def_type def_meta def_value]) (#Right [state [def_type def_value]])))))) -(def: (find_type_var idx bindings) +(def: (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings #Nil @@ -4127,27 +4127,27 @@ (#Cons [var bound] bindings') (if ("lux i64 =" idx var) bound - (find_type_var idx bindings')))) + (type_variable idx bindings')))) -(def: (find_type full_name) +(def: (type_definition full_name) (-> Name (Meta Type)) (do meta_monad [#let [[module name] full_name] current_module current_module_name] (function (_ compiler) (let [temp (if (text\= "" module) - (case (find_in_env name compiler) + (case (in_env name compiler) (#Some struct_type) (#Right [compiler struct_type]) _ - (case (find_def_type [current_module name] compiler) + (case (definition_type [current_module name] compiler) (#Some struct_type) (#Right [compiler struct_type]) _ (#Left ($_ text\compose "Unknown var: " (name\encode full_name))))) - (case (find_def_type full_name compiler) + (case (definition_type full_name compiler) (#Some struct_type) (#Right [compiler struct_type]) @@ -4160,7 +4160,7 @@ #seed _ #expected _ #location _ #extensions extensions #scope_type_vars _} compiler {#ex_counter _ #var_counter _ #var_bindings var_bindings} type_context] - (case (find_type_var type_id var_bindings) + (case (type_variable type_id var_bindings) #None temp @@ -4242,11 +4242,11 @@ (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) (do meta_monad [g!temp (gensym "temp")] - (wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) + (in (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) (^ (list [_ (#Identifier name)] [_ (#Text alias)] body)) (do meta_monad - [init_type (find_type name) + [init_type (type_definition name) struct_evidence (resolve_type_tags init_type)] (case struct_evidence #None @@ -4272,12 +4272,12 @@ enhanced_target) #None - (wrap enhanced_target)))) + (in enhanced_target)))) target (zipped/2 locals members))] - (wrap (` ({(~ pattern) (~ enhanced_target)} (~ (identifier$ source))))))))) + (in (` ({(~ pattern) (~ enhanced_target)} (~ (identifier$ source))))))))) name tags&members body)] - (wrap (list full_body))))) + (in (list full_body))))) _ (failure "Wrong syntax for ^open"))) @@ -4361,7 +4361,7 @@ (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) _ (failure "Wrong syntax for get@"))) @@ -4413,7 +4413,7 @@ (case struct [_ (#Identifier struct_name)] (do meta_monad - [struct_type (find_type struct_name) + [struct_type (type_definition struct_name) output (resolve_type_tags struct_type) #let [source (identifier$ struct_name)]] (case output @@ -4464,9 +4464,9 @@ (def: (imported_by? import_name module_name) (-> Text Text (Meta Bit)) (do meta_monad - [module (find_module module_name) + [module (module module_name) #let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]] - (wrap (is_member? imports import_name)))) + (in (is_member? imports import_name)))) (def: (read_refer module_name options) (-> Text (List Code) (Meta Refer)) @@ -4478,8 +4478,8 @@ current_module current_module_name] (case options #Nil - (wrap {#refer_defs referral - #refer_open openings}) + (in {#refer_defs referral + #refer_open openings}) _ (failure ($_ text\compose "Wrong syntax for refer @ " current_module @@ -4509,19 +4509,19 @@ (do meta_monad [*defs (exported_definitions module_name) _ (test_referrals module_name *defs +defs)] - (wrap +defs)) + (in +defs)) (#Exclude _defs) (do meta_monad [*defs (exported_definitions module_name) _ (test_referrals module_name *defs _defs)] - (wrap (..only (|>> (is_member? _defs) not) *defs))) + (in (..only (|>> (is_member? _defs) not) *defs))) #Ignore - (wrap (list)) + (in (list)) #Nothing - (wrap (list))) + (in (list))) #let [defs (list\map (: (-> Text Code) (function (_ def) (` ("lux def alias" (~ (local_identifier$ def)) (~ (identifier$ [module_name def])))))) @@ -4533,7 +4533,7 @@ (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) structs)))) list\join)]] - (wrap (list\compose defs openings)) + (in (list\compose defs openings)) )) (macro: #export (refer tokens) @@ -4613,7 +4613,7 @@ =module (` ("lux def module" [(~ location_code) (#.Record (~ (process_def_meta _meta)))] (~ =imports)))]] - (wrap (#Cons =module =refers)))) + (in (#Cons =module =refers)))) (macro: #export (\ tokens) {#.doc (text$ ($_ "lux text concat" @@ -4700,23 +4700,23 @@ [record (: (List (List Code)) #Nil)] pairs) accesses (list\join (list\reverse accesses'))]] - (wrap (list (` (let [(~+ accesses)] - (~ update_expr))))))) + (in (list (` (let [(~+ accesses)] + (~ update_expr))))))) (^ (list selector value)) (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!record)) - (..set@ (~ selector) (~ value) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!record)) + (..set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) (do meta_monad [g!_ (gensym "_") g!value (gensym "value") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!value) (~ g!record)) - (..set@ (~ selector) (~ g!value) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!value) (~ g!record)) + (..set@ (~ selector) (~ g!value) (~ g!record))))))) _ (failure "Wrong syntax for set@"))) @@ -4774,24 +4774,24 @@ (do meta_monad [g!record (gensym "record") g!temp (gensym "temp")] - (wrap (list (` (let [(~ g!record) (~ record) - (~ g!temp) (get@ [(~+ slots)] (~ g!record))] - (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) + (in (list (` (let [(~ g!record) (~ record) + (~ g!temp) (get@ [(~+ slots)] (~ g!record))] + (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) (^ (list selector fun)) (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!record)) - (..update@ (~ selector) (~ fun) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!record)) + (..update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) (do meta_monad [g!_ (gensym "_") g!fun (gensym "fun") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) - (..update@ (~ selector) (~ g!fun) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) + (..update@ (~ selector) (~ g!fun) (~ g!record))))))) _ (failure "Wrong syntax for update@"))) @@ -4848,7 +4848,7 @@ (|> data' (list\map (compose apply (make_env bindings'))) list\join - wrap)) + in)) #None)))) (#Some output) (return (list\compose output branches)) @@ -4859,7 +4859,7 @@ _ (failure "Wrong syntax for ^template"))) -(def: (find_baseline_column code) +(def: (baseline_column code) (-> Code Nat) (case code (^template [<tag>] @@ -4876,14 +4876,14 @@ (^template [<tag>] [[[_ _ column] (<tag> parts)] - (list\fold n/min column (list\map find_baseline_column parts))]) + (list\fold n/min column (list\map baseline_column parts))]) ([#Form] [#Tuple]) [[_ _ column] (#Record pairs)] (list\fold n/min column - (list\compose (list\map (|>> first find_baseline_column) pairs) - (list\map (|>> second find_baseline_column) pairs))) + (list\compose (list\map (|>> first baseline_column) pairs) + (list\map (|>> second baseline_column) pairs))) )) (type: Doc_Fragment @@ -4994,7 +4994,7 @@ (text\join_with "")) (#Doc_Example example) - (let [baseline (find_baseline_column example) + (let [baseline (baseline_column example) [location _] example [_ text] (doc_example_to_text (with_baseline baseline location) baseline example)] (text\compose text __paragraph)))) @@ -5035,7 +5035,7 @@ (-> Type Code) (case type (#Primitive name params) - (` (#.Primitive (~ (text$ name)) (~ (untemplate_list (list\map type_to_code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplated_list (list\map type_to_code params))))) (^template [<tag>] [(<tag> left right) @@ -5051,7 +5051,7 @@ (^template [<tag>] [(<tag> env type) - (let [env' (untemplate_list (list\map type_to_code env))] + (let [env' (untemplated_list (list\map type_to_code env))] (` (<tag> (~ env') (~ (type_to_code type)))))]) ([#.UnivQ] [#.ExQ]) @@ -5098,7 +5098,7 @@ (case (monad\map maybe_monad get_name inits) (#Some inits') (return inits') #None (failure "Wrong syntax for loop"))) - init_types (monad\map meta_monad find_type inits') + init_types (monad\map meta_monad type_definition inits') expected get_expected_type] (return (list (` (("lux type check" (-> (~+ (list\map type_to_code init_types)) @@ -5132,7 +5132,7 @@ (do maybe_monad [hslot (get_tag hslot') tslots (monad\map maybe_monad get_tag tslots')] - (wrap [hslot tslots]))) + (in [hslot tslots]))) (#Some slots) (return slots) @@ -5176,7 +5176,7 @@ [[location (<tag> elems)] (do maybe_monad [placements (monad\map maybe_monad (place_tokens label tokens) elems)] - (wrap (list [location (<tag> (list\join placements))])))]) + (in (list [location (<tag> (list\join placements))])))]) ([#Tuple] [#Form]) @@ -5190,12 +5190,12 @@ value' (place_tokens label tokens value)] (case [slot' value'] (^ [(list =slot) (list =value)]) - (wrap [=slot =value]) + (in [=slot =value]) _ #None)))) pairs)] - (wrap (list [location (#Record =pairs)]))) + (in (list [location (#Record =pairs)]))) )) (macro: #export (with_expansions tokens) @@ -5228,7 +5228,7 @@ [(~+ bindings')] (~+ bodies)))) (#Some output) - (wrap output) + (in output) _ (failure "[with_expansions] Improper macro expansion."))) @@ -5264,12 +5264,12 @@ (def: (anti_quote_def name) (-> Name (Meta Code)) (do meta_monad - [type+value (find_def_value name) + [type+value (definition_value name) #let [[type value] type+value]] (case (flat_alias type) (^template [<name> <type> <wrapper>] [(#Named ["library/lux" <name>] _) - (wrap (<wrapper> (:as <type> value)))]) + (in (<wrapper> (:as <type> value)))]) (["Bit" Bit bit$] ["Nat" Nat nat$] ["Int" Int int$] @@ -5294,7 +5294,7 @@ [[meta (<tag> parts)] (do meta_monad [=parts (monad\map meta_monad anti_quote parts)] - (wrap [meta (<tag> =parts)]))]) + (in [meta (<tag> =parts)]))]) ([#Form] [#Tuple]) @@ -5305,14 +5305,14 @@ (function (_ [slot value]) (do meta_monad [=value (anti_quote value)] - (wrap [slot =value])))) + (in [slot =value])))) pairs)] - (wrap [meta (#Record =pairs)])) + (in [meta (#Record =pairs)])) _ (\ meta_monad return token) ## TODO: Figure out why this doesn't work: - ## (\ meta_monad wrap token) + ## (\ meta_monad in token) )) (macro: #export (static tokens) @@ -5320,7 +5320,7 @@ (^ (list pattern)) (do meta_monad [pattern' (anti_quote pattern)] - (wrap (list pattern'))) + (in (list pattern'))) _ (failure "Wrong syntax for 'static'."))) @@ -5347,7 +5347,7 @@ (#Cons init extras) (do meta_monad [extras' (monad\map meta_monad case_level^ extras)] - (wrap [init extras'])))) + (in [init extras'])))) (def: (multi_level_case$ g!_ [[init_pattern levels] body]) (-> Code [Multi_Level_Case Code] (List Code)) @@ -5416,7 +5416,7 @@ (~+ (if initial_bind? (list) (list g!temp (` #.None)))))))))] - (wrap output))) + (in output))) _ (failure "Wrong syntax for ^multi"))) @@ -5468,7 +5468,7 @@ [stvs get_scope_type_vars] (case (..nth idx (list\reverse stvs)) (#Some var_id) - (wrap (list (` (#Ex (~ (nat$ var_id)))))) + (in (list (` (#Ex (~ (nat$ var_id)))))) #None (failure (text\compose "Indexed-type does not exist: " (nat\encode idx))))) @@ -5526,7 +5526,7 @@ (^ (list expr)) (do meta_monad [type get_expected_type] - (wrap (list (` ("lux type as" (~ (type_to_code type)) (~ expr)))))) + (in (list (` ("lux type as" (~ (type_to_code type)) (~ expr)))))) _ (failure (..wrong_syntax_error (name_of ..:assume))))) @@ -5551,7 +5551,7 @@ #let [[module line column] location location ($_ "lux text concat" (text\encode module) "," (nat\encode line) "," (nat\encode column)) message ($_ "lux text concat" "Undefined behavior @ " location)]] - (wrap (list (` (..error! (~ (text$ message))))))) + (in (list (` (..error! (~ (text$ message))))))) _ (failure (..wrong_syntax_error (name_of ..undefined))))) @@ -5571,14 +5571,14 @@ (case tokens (^ (list [_ (#Identifier var_name)])) (do meta_monad - [var_type (find_type var_name)] - (wrap (list (type_to_code var_type)))) + [var_type (type_definition var_name)] + (in (list (type_to_code var_type)))) (^ (list expression)) (do meta_monad [g!temp (gensym "g!temp")] - (wrap (list (` (let [(~ g!temp) (~ expression)] - (..:of (~ g!temp))))))) + (in (list (` (let [(~ g!temp) (~ expression)] + (..:of (~ g!temp))))))) _ (failure (..wrong_syntax_error (name_of ..:of))))) @@ -5592,12 +5592,12 @@ (function (_ arg') (case arg' [_ (#Identifier ["" arg_name])] - (wrap arg_name) + (in arg_name) _ (failure "Could not parse an argument."))) args')] - (wrap [[name args] tokens'])) + (in [[name args] tokens'])) _ (failure "Could not parse a complex declaration.") @@ -5664,19 +5664,19 @@ [arg (` ((~' ~) (~ (local_identifier$ arg))))]) args)] this_module current_module_name] - (wrap (list (` (macro: (~+ (export export?)) - ((~ (local_identifier$ name)) (~ g!tokens) (~ g!compiler)) - (~ anns) - (case (~ g!tokens) - (^ (list (~+ (list\map local_identifier$ args)))) - (#.Right [(~ g!compiler) - (list (~+ (list\map (function (_ template) - (` (`' (~ (replace_syntax rep_env template))))) - input_templates)))]) - - (~ g!_) - (#.Left (~ (text$ (..wrong_syntax_error [this_module name])))) - ))))) + (in (list (` (macro: (~+ (export export?)) + ((~ (local_identifier$ name)) (~ g!tokens) (~ g!compiler)) + (~ anns) + (case (~ g!tokens) + (^ (list (~+ (list\map local_identifier$ args)))) + (#.Right [(~ g!compiler) + (list (~+ (list\map (function (_ template) + (` (`' (~ (replace_syntax rep_env template))))) + input_templates)))]) + + (~ g!_) + (#.Left (~ (text$ (..wrong_syntax_error [this_module name])))) + ))))) )) (macro: #export (as_is tokens compiler) @@ -5707,12 +5707,12 @@ [_ (#Identifier identifier)] (do meta_monad [identifier (..resolve_global_identifier identifier) - type+value (..find_def_value identifier) + type+value (..definition_value identifier) #let [[type value] type+value]] (case (..flat_alias type) (^or (#Primitive "#Text" #Nil) (#Named ["library/lux" "Text"] (#Primitive "#Text" #Nil))) - (wrap (:as ..Text value)) + (in (:as ..Text value)) _ (failure ($_ text\compose @@ -5770,14 +5770,14 @@ (^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))]) (do meta_monad [g!expansion (gensym "g!expansion")] - (wrap [(list [g!expansion expansion]) g!expansion])) + (in [(list [g!expansion expansion]) g!expansion])) (^template [<tag>] [[ann (<tag> parts)] (do meta_monad [=parts (monad\map meta_monad label_code parts)] - (wrap [(list\fold list\compose (list) (list\map left =parts)) - [ann (<tag> (list\map right =parts))]]))]) + (in [(list\fold list\compose (list) (list\map left =parts)) + [ann (<tag> (list\map right =parts))]]))]) ([#Form] [#Tuple]) [ann (#Record kvs)] @@ -5789,10 +5789,10 @@ =val (label_code val) #let [[key_labels key_labelled] =key [val_labels val_labelled] =val]] - (wrap [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) + (in [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) kvs)] - (wrap [(list\fold list\compose (list) (list\map left =kvs)) - [ann (#Record (list\map right =kvs))]])) + (in [(list\fold list\compose (list) (list\map left =kvs)) + [ann (#Record (list\map right =kvs))]])) _ (return [(list) code]))) @@ -5803,10 +5803,10 @@ (do meta_monad [=raw (label_code raw) #let [[labels labelled] =raw]] - (wrap (list (` (with_expansions [(~+ (|> labels - (list\map (function (_ [label expansion]) (list label expansion))) - list\join))] - (~ labelled)))))) + (in (list (` (with_expansions [(~+ (|> labels + (list\map (function (_ [label expansion]) (list label expansion))) + list\join))] + (~ labelled)))))) _ (failure (..wrong_syntax_error (name_of ..``))) @@ -5816,56 +5816,56 @@ (-> Name Code) (` [(~ (text$ module)) (~ (text$ name))])) -(def: (untemplate_list& last inits) +(def: (untemplated_list& last inits) (-> Code (List Code) Code) (case inits #Nil last (#Cons [init inits']) - (` (#.Cons (~ init) (~ (untemplate_list& last inits')))))) + (` (#.Cons (~ init) (~ (untemplated_list& last inits')))))) -(def: (untemplate_record g!meta untemplate_pattern fields) +(def: (untemplated_record g!meta untemplated_pattern fields) (-> Code (-> Code (Meta Code)) (-> (List [Code Code]) (Meta Code))) (do meta_monad [=fields (monad\map meta_monad (function (_ [key value]) (do meta_monad - [=key (untemplate_pattern key) - =value (untemplate_pattern value)] - (wrap (` [(~ =key) (~ =value)])))) + [=key (untemplated_pattern key) + =value (untemplated_pattern value)] + (in (` [(~ =key) (~ =value)])))) fields)] - (wrap (` [(~ g!meta) (#.Record (~ (untemplate_list =fields)))])))) + (in (` [(~ g!meta) (#.Record (~ (untemplated_list =fields)))])))) (template [<tag> <name>] - [(def: (<name> g!meta untemplate_pattern elems) + [(def: (<name> g!meta untemplated_pattern elems) (-> Code (-> Code (Meta Code)) (-> (List Code) (Meta Code))) (case (list\reverse elems) (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] inits) (do meta_monad - [=inits (monad\map meta_monad untemplate_pattern (list\reverse inits))] - (wrap (` [(~ g!meta) (<tag> (~ (untemplate_list& spliced =inits)))]))) + [=inits (monad\map meta_monad untemplated_pattern (list\reverse inits))] + (in (` [(~ g!meta) (<tag> (~ (untemplated_list& spliced =inits)))]))) _ (do meta_monad - [=elems (monad\map meta_monad untemplate_pattern elems)] - (wrap (` [(~ g!meta) (<tag> (~ (untemplate_list =elems)))])))))] + [=elems (monad\map meta_monad untemplated_pattern elems)] + (in (` [(~ g!meta) (<tag> (~ (untemplated_list =elems)))])))))] - [#.Tuple untemplate_tuple] - [#.Form untemplate_form] + [#.Tuple untemplated_tuple] + [#.Form untemplated_form] ) -(def: (untemplate_pattern pattern) +(def: (untemplated_pattern pattern) (-> Code (Meta Code)) (do meta_monad [g!meta (gensym "g!meta")] (case pattern (^template [<tag> <gen>] [[_ (<tag> value)] - (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))]))]) + (in (` [(~ g!meta) (<tag> (~ (<gen> value)))]))]) ([#.Bit bit$] [#.Nat nat$] [#.Int int$] @@ -5883,25 +5883,25 @@ (^template [<tag> <untemplate>] [[_ (<tag> elems)] - (<untemplate> g!meta untemplate_pattern elems)]) - ([#.Tuple ..untemplate_tuple] - [#.Form ..untemplate_form]) + (<untemplate> g!meta untemplated_pattern elems)]) + ([#.Tuple ..untemplated_tuple] + [#.Form ..untemplated_form]) [_ (#Record fields)] - (..untemplate_record g!meta untemplate_pattern fields) + (..untemplated_record g!meta untemplated_pattern fields) ))) (macro: #export (^code tokens) (case tokens (^ (list& [_meta (#Form (list template))] body branches)) (do meta_monad - [pattern (untemplate_pattern template)] - (wrap (list& pattern body branches))) + [pattern (untemplated_pattern template)] + (in (list& pattern body branches))) (^ (list template)) (do meta_monad - [pattern (untemplate_pattern template)] - (wrap (list pattern))) + [pattern (untemplated_pattern template)] + (in (list pattern))) _ (failure (..wrong_syntax_error (name_of ..^code))))) @@ -5940,9 +5940,9 @@ (^ (list expression)) (do meta_monad [g!_ (gensym "g!_")] - (wrap (list (` ("lux try" - (.function ((~ g!_) (~ g!_)) - (~ expression))))))) + (in (list (` ("lux try" + (.function ((~ g!_) (~ g!_)) + (~ expression))))))) _ (..failure (..wrong_syntax_error (name_of ..try))))) |