diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux.lux | 153 |
1 files changed, 79 insertions, 74 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 9f2b0a697..9bf50bba5 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1400,11 +1400,11 @@ (failure "Wrong syntax for def:'''")} tokens)) -(def:''' (as_pairs xs) +(def:''' (pairs xs) #End (All [a] (-> ($' List a) ($' List (& a a)))) ({(#Item x (#Item y xs')) - (#Item [x y] (as_pairs xs')) + (#Item [x y] (pairs xs')) _ #End} @@ -1419,7 +1419,7 @@ (form$ (list (record$ (list [label body])) value))} binding))) body - (list\reverse (as_pairs bindings))))) + (list\reverse (pairs bindings))))) _ (failure "Wrong syntax for let'")} @@ -1587,7 +1587,7 @@ value))} var)))) body - (list\reverse (as_pairs bindings)))] + (list\reverse (pairs bindings)))] (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "in"]) g!in] [(tag$ ["library/lux" "bind"]) g!bind])) body'])) monad))))) @@ -1651,10 +1651,15 @@ (failure "Wrong syntax for if")} tokens)) +(def:''' PList + #End + Type + (All [a] ($' List (& Text a)))) + (def:''' (get k plist) #End (All [a] - (-> Text ($' List (& Text a)) ($' Maybe a))) + (-> Text ($' PList a) ($' Maybe a))) ({(#Item [[k' v] plist']) (if (text\= k k') (#Some v) @@ -1667,7 +1672,7 @@ (def:''' (put k v dict) #End (All [a] - (-> Text a ($' List (& Text a)) ($' List (& Text a)))) + (-> Text a ($' PList a) ($' PList a))) ({#End (list [k v]) @@ -1742,7 +1747,7 @@ (#Left ($_ text\compose "Unknown module: " module " @ " (name\encode full_name)))} (get module modules)))) -(def:''' (as_code_list expression) +(def:''' (code_list expression) #End (-> Code Code) (let' [type (form$ (list (tag$ ["library/lux" "Apply"]) @@ -1760,13 +1765,13 @@ (#Item lastI inits) (do meta_monad [lastO ({[_ (#Form (#Item [[_ (#Identifier ["" "~+"])] (#Item [spliced #End])]))] - (in (as_code_list spliced)) + (in (code_list spliced)) _ (do meta_monad [lastO (untemplate lastI)] - (in (as_code_list (form$ (list (tag$ ["library/lux" "Item"]) - (tuple$ (list lastO (tag$ ["library/lux" "End"]))))))))} + (in (code_list (form$ (list (tag$ ["library/lux" "Item"]) + (tuple$ (list lastO (tag$ ["library/lux" "End"]))))))))} lastI)] (monad\fold meta_monad (function' [leftI rightO] @@ -1774,7 +1779,7 @@ (let' [g!in-module (form$ (list (text$ "lux in-module") (text$ "library/lux") (identifier$ ["library/lux" "list\compose"])))] - (in (form$ (list g!in-module (as_code_list spliced) rightO)))) + (in (form$ (list g!in-module (code_list spliced) rightO)))) _ (do meta_monad @@ -2309,7 +2314,7 @@ #None)} ("lux type check" Global gdef)))) -(def:''' (normalize name) +(def:''' (normal name) #End (-> Name ($' Meta Name)) ({["" name] @@ -2340,7 +2345,7 @@ #End (-> Name ($' Meta Bit)) (do meta_monad - [name (normalize name) + [name (normal name) output (macro name)] (in ({(#Some _) #1 #None #0} @@ -2360,13 +2365,13 @@ (list& x sep (interpose sep xs'))} xs)) -(def:''' (macro_expand_once token) +(def:''' (single_expansion token) #End (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Item [_ (#Identifier macro_name)] args))] + ({[_ (#Form (#Item [_ (#Identifier name)] args))] (do meta_monad - [macro_name' (normalize macro_name) - ?macro (macro macro_name')] + [name' (normal name) + ?macro (macro name')] ({(#Some macro) (("lux type as" Macro' macro) args) @@ -2378,18 +2383,18 @@ (return (list token))} token)) -(def:''' (macro_expand token) +(def:''' (expansion token) #End (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Item [_ (#Identifier macro_name)] args))] + ({[_ (#Form (#Item [_ (#Identifier name)] args))] (do meta_monad - [macro_name' (normalize macro_name) - ?macro (macro macro_name')] + [name' (normal name) + ?macro (macro name')] ({(#Some macro) (do meta_monad - [expansion (("lux type as" Macro' macro) args) - expansion' (monad\map meta_monad macro_expand expansion)] - (in (list\join expansion'))) + [top_level_expansion (("lux type as" Macro' macro) args) + recursive_expansion (monad\map meta_monad expansion top_level_expansion)] + (in (list\join recursive_expansion))) #None (return (list token))} @@ -2399,33 +2404,33 @@ (return (list token))} token)) -(def:''' (macro_expand_all syntax) +(def:''' (full_expansion syntax) #End (-> Code ($' Meta ($' List Code))) - ({[_ (#Form (#Item [_ (#Identifier macro_name)] args))] + ({[_ (#Form (#Item [_ (#Identifier name)] args))] (do meta_monad - [macro_name' (normalize macro_name) - ?macro (macro macro_name')] + [name' (normal name) + ?macro (macro name')] ({(#Some macro) (do meta_monad [expansion (("lux type as" Macro' macro) args) - expansion' (monad\map meta_monad macro_expand_all expansion)] + expansion' (monad\map meta_monad full_expansion expansion)] (in (list\join expansion'))) #None (do meta_monad - [args' (monad\map meta_monad macro_expand_all args)] - (in (list (form$ (#Item (identifier$ macro_name) (list\join args'))))))} + [args' (monad\map meta_monad full_expansion args)] + (in (list (form$ (#Item (identifier$ name) (list\join args'))))))} ?macro)) [_ (#Form members)] (do meta_monad - [members' (monad\map meta_monad macro_expand_all members)] + [members' (monad\map meta_monad full_expansion members)] (in (list (form$ (list\join members'))))) [_ (#Tuple members)] (do meta_monad - [members' (monad\map meta_monad macro_expand_all members)] + [members' (monad\map meta_monad full_expansion members)] (in (list (tuple$ (list\join members'))))) [_ (#Record pairs)] @@ -2434,7 +2439,7 @@ (function' [kv] (let' [[key val] kv] (do meta_monad - [val' (macro_expand_all val)] + [val' (full_expansion val)] ({(#Item val'' #End) (return [key val'']) @@ -2483,7 +2488,7 @@ "(type (All [a] (Maybe (List a))))"))]) ({(#Item type #End) (do meta_monad - [type+ (macro_expand_all type)] + [type+ (full_expansion type)] ({(#Item type' #End) (in (list (walk_type type'))) @@ -2751,18 +2756,18 @@ (def:' (expander branches) (-> (List Code) (Meta (List Code))) - ({(#Item [_ (#Form (#Item [_ (#Identifier macro_name)] macro_args))] + ({(#Item [_ (#Form (#Item [_ (#Identifier name)] args))] (#Item body branches')) (do meta_monad - [??? (macro? macro_name)] + [??? (macro? name)] (if ??? (do meta_monad - [init_expansion (macro_expand_once (form$ (list& (identifier$ macro_name) (form$ macro_args) body branches')))] + [init_expansion (single_expansion (form$ (list& (identifier$ name) (form$ args) body branches')))] (expander init_expansion)) (do meta_monad [sub_expansion (expander branches')] - (in (list& (form$ (list& (identifier$ macro_name) macro_args)) + (in (list& (form$ (list& (identifier$ name) args)) body sub_expansion))))) @@ -2795,7 +2800,7 @@ ({(#Item value branches) (do meta_monad [expansion (expander branches)] - (in (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) + (in (list (` ((~ (record$ (pairs expansion))) (~ value)))))) _ (failure "Wrong syntax for case")} @@ -2815,7 +2820,7 @@ (case tokens (#Item [_ (#Form (#Item pattern #End))] (#Item body branches)) (do meta_monad - [pattern+ (macro_expand_all pattern)] + [pattern+ (full_expansion pattern)] (case pattern+ (#Item pattern' #End) (in (list& pattern' body branches)) @@ -2875,7 +2880,7 @@ (case tokens (^ (list [_ (#Tuple bindings)] body)) (if (multiple? 2 (list\size bindings)) - (|> bindings as_pairs list\reverse + (|> bindings pairs list\reverse (list\fold (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] @@ -3173,8 +3178,8 @@ (case ?parts (#Some name args meta sigs) (do meta_monad - [name+ (normalize name) - sigs' (monad\map meta_monad macro_expand sigs) + [name+ (normal name) + sigs' (monad\map meta_monad expansion sigs) members (: (Meta (List [Text Code])) (monad\map meta_monad (: (-> Code (Meta [Text Code])) @@ -3236,7 +3241,7 @@ [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and': (and #1 #0 #1) ## => #0"] [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or': (or #1 #0 #1) ## => #1"]) -(def: (index_of part text) +(def: (index part text) (-> Text Text (Maybe Nat)) ("lux text index" 0 part text)) @@ -3271,7 +3276,7 @@ (def: (text\split_all_with splitter input) (-> Text Text (List Text)) - (case (..index_of splitter input) + (case (..index splitter input) #None (list input) @@ -3494,7 +3499,7 @@ (macro: #export (implementation tokens) {#.doc "Not meant to be used directly. Prefer 'implementation:'."} (do meta_monad - [tokens' (monad\map meta_monad macro_expand tokens) + [tokens' (monad\map meta_monad expansion tokens) struct_type get_expected_type tags+type (resolve_type_tags struct_type) tags (: (Meta (List Name)) @@ -3777,7 +3782,7 @@ (def: (text\split_with token sample) (-> Text Text (Maybe [Text Text])) (do ..maybe_monad - [index (..index_of token sample) + [index (..index token sample) #let [[pre post'] (text\split! index sample) [_ post] (text\split! ("lux text size" token) post')]] (in [pre post]))) @@ -4235,9 +4240,9 @@ {#.doc (text$ ($_ "lux text concat" "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..\n "## Takes an 'alias' text for the generated local bindings." ..\n - "(def: #export (range (^open ''.'') from to)" ..\n + "(def: #export (range (^open ''.'') minimum additional)" ..\n " (All [a] (-> (Enum a) a a (List a)))" ..\n - " (range' <= succ from to))"))} + " (range' <= succ minimum additional))"))} (case tokens (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) (do meta_monad @@ -4299,7 +4304,7 @@ (let [[right left] branch] (` (if (~ left) (~ right) (~ else)))))) else - (as_pairs branches')))) + (pairs branches')))) _ (failure "Wrong syntax for cond")))) @@ -4331,7 +4336,7 @@ (case tokens (^ (list [_ (#Tag slot')] record)) (do meta_monad - [slot (normalize slot') + [slot (normal slot') output (resolve_tag slot) #let [[idx tags exported? type] output] g!_ (gensym "_") @@ -4546,7 +4551,7 @@ _ (failure "Wrong syntax for refer"))) -(def: (refer_to_code module_name module_alias' [r_defs r_opens]) +(def: (refer_code module_name module_alias' [r_defs r_opens]) (-> Text (Maybe Text) Refer Code) (let [module_alias (..default module_name module_alias') localizations (: (List Code) @@ -4608,7 +4613,7 @@ tuple$) =refers (list\map (: (-> Importation Code) (function (_ [m_name m_alias =refer]) - (refer_to_code m_name m_alias =refer))) + (refer_code m_name m_alias =refer))) imports) =module (` ("lux def module" [(~ location_code) (#.Record (~ (process_def_meta _meta)))] @@ -4646,7 +4651,7 @@ (case tokens (^ (list [_ (#Tag slot')] value record)) (do meta_monad - [slot (normalize slot') + [slot (normal slot') output (resolve_tag slot) #let [[idx tags exported? type] output]] (case (resolve_struct_type type) @@ -4735,7 +4740,7 @@ (case tokens (^ (list [_ (#Tag slot')] fun record)) (do meta_monad - [slot (normalize slot') + [slot (normal slot') output (resolve_tag slot) #let [[idx tags exported? type] output]] (case (resolve_struct_type type) @@ -5031,15 +5036,15 @@ (#Item y ys') (list& x y (interleave xs' ys'))))) -(def: (type_to_code type) +(def: (type_code type) (-> Type Code) (case type (#Primitive name params) - (` (#.Primitive (~ (text$ name)) (~ (untemplated_list (list\map type_to_code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplated_list (list\map type_code params))))) (^template [<tag>] [(<tag> left right) - (` (<tag> (~ (type_to_code left)) (~ (type_to_code right))))]) + (` (<tag> (~ (type_code left)) (~ (type_code right))))]) ([#.Sum] [#.Product] [#.Function] [#.Apply]) @@ -5051,15 +5056,15 @@ (^template [<tag>] [(<tag> env type) - (let [env' (untemplated_list (list\map type_to_code env))] - (` (<tag> (~ env') (~ (type_to_code type)))))]) + (let [env' (untemplated_list (list\map type_code env))] + (` (<tag> (~ env') (~ (type_code type)))))]) ([#.UnivQ] [#.ExQ]) (#Named [module name] anonymous) ## TODO: Generate the explicit type definition instead of using ## the "identifier$" shortcut below. ## (` (#.Named [(~ (text$ module)) (~ (text$ name))] - ## (~ (type_to_code anonymous)))) + ## (~ (type_code anonymous)))) (identifier$ [module name]))) (macro: #export (loop tokens) @@ -5089,7 +5094,7 @@ #.None)] (case ?params (#.Some [name bindings body]) - (let [pairs (as_pairs bindings) + (let [pairs (pairs bindings) vars (list\map first pairs) inits (list\map second pairs)] (if (every? identifier? inits) @@ -5101,8 +5106,8 @@ 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)) - (~ (type_to_code expected))) + (-> (~+ (list\map type_code init_types)) + (~ (type_code expected))) (function ((~ name) (~+ vars)) (~ body))) (~+ inits)))))) @@ -5139,8 +5144,8 @@ #None (failure "Wrong syntax for ^slots"))) #let [[hslot tslots] slots] - hslot (normalize hslot) - tslots (monad\map meta_monad normalize tslots) + hslot (..normal hslot) + tslots (monad\map meta_monad ..normal tslots) output (resolve_tag hslot) g!_ (gensym "_") #let [[idx tags exported? type] output @@ -5221,9 +5226,9 @@ (case tokens (^ (list& [_ (#Tuple bindings)] bodies)) (case bindings - (^ (list& [_ (#Identifier ["" var_name])] macro_expr bindings')) + (^ (list& [_ (#Identifier ["" var_name])] expr bindings')) (do meta_monad - [expansion (macro_expand_once macro_expr)] + [expansion (single_expansion expr)] (case (place_tokens var_name expansion (` (.with_expansions [(~+ bindings')] (~+ bodies)))) @@ -5409,7 +5414,7 @@ #None (case (~ g!temp) (~+ next_branches))} - ("lux type check" (#.Apply (~ (type_to_code expected)) Maybe) + ("lux type check" (#.Apply (~ (type_code expected)) Maybe) (case (~ g!temp) (~+ (multi_level_case$ g!temp [mlc body])) @@ -5526,7 +5531,7 @@ (^ (list expr)) (do meta_monad [type get_expected_type] - (in (list (` ("lux type as" (~ (type_to_code type)) (~ expr)))))) + (in (list (` ("lux type as" (~ (type_code type)) (~ expr)))))) _ (failure (..wrong_syntax_error (name_of ..:assume))))) @@ -5572,7 +5577,7 @@ (^ (list [_ (#Identifier var_name)])) (do meta_monad [var_type (type_definition var_name)] - (in (list (type_to_code var_type)))) + (in (list (type_code var_type)))) (^ (list expression)) (do meta_monad @@ -5717,7 +5722,7 @@ _ (failure ($_ text\compose "Invalid target platform (must be a value of type Text): " (name\encode identifier) - " : " (..code\encode (..type_to_code type)))))) + " : " (..code\encode (..type_code type)))))) _ (failure ($_ text\compose @@ -5919,7 +5924,7 @@ (^ (list [_ (#Tuple bindings)] bodyT)) (if (multiple? 2 (list\size bindings)) (return (list (` (..with_expansions [(~+ (|> bindings - ..as_pairs + ..pairs (list\map (function (_ [localT valueT]) (list localT (` (..as_is (~ valueT)))))) (list\fold list\compose (list))))] |