diff options
Diffstat (limited to 'stdlib/source/library/lux.lux')
| -rw-r--r-- | stdlib/source/library/lux.lux | 213 |
1 files changed, 108 insertions, 105 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 4d3141587..eb2676ee3 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1088,7 +1088,7 @@ code} code)) -(def:'' (parse_quantified_args args next) +(def:'' (quantified_args_parser args next) #Nil ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) (#Function ($' List Code) @@ -1099,7 +1099,7 @@ (next #Nil) (#Cons [_ (#Identifier "" arg_name)] args') - (parse_quantified_args args' (function'' [names] (next (#Cons arg_name names)))) + (quantified_args_parser args' (function'' [names] (next (#Cons arg_name names)))) _ (fail "Expected identifier.")} @@ -1149,28 +1149,28 @@ ["" tokens]} tokens) ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse_quantified_args args - (function'' [names] - (let'' body' (list\fold ("lux type check" (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["library/lux" "UnivQ"]) - (#Cons (tag$ ["library/lux" "Nil"]) - (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) - (update_parameters body')) #Nil)))))) - body - names) - (return (#Cons ({[#1 _] - body' - - [_ #Nil] - body' - - [#0 _] - (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] - #Nil) - body')} - [(text\= "" self_name) names]) - #Nil))))) + (quantified_args_parser args + (function'' [names] + (let'' body' (list\fold ("lux type check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["library/lux" "UnivQ"]) + (#Cons (tag$ ["library/lux" "Nil"]) + (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) + (update_parameters body')) #Nil)))))) + body + names) + (return (#Cons ({[#1 _] + body' + + [_ #Nil] + body' + + [#0 _] + (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + #Nil) + body')} + [(text\= "" self_name) names]) + #Nil))))) _ (fail "Wrong syntax for All")} @@ -1193,28 +1193,28 @@ ["" tokens]} tokens) ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) - (parse_quantified_args args - (function'' [names] - (let'' body' (list\fold ("lux type check" (#Function Text (#Function Code Code)) - (function'' [name' body'] - (form$ (#Cons (tag$ ["library/lux" "ExQ"]) - (#Cons (tag$ ["library/lux" "Nil"]) - (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) - (update_parameters body')) #Nil)))))) - body - names) - (return (#Cons ({[#1 _] - body' - - [_ #Nil] - body' - - [#0 _] - (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] - #Nil) - body')} - [(text\= "" self_name) names]) - #Nil))))) + (quantified_args_parser args + (function'' [names] + (let'' body' (list\fold ("lux type check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ ["library/lux" "ExQ"]) + (#Cons (tag$ ["library/lux" "Nil"]) + (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) + (update_parameters body')) #Nil)))))) + body + names) + (return (#Cons ({[#1 _] + body' + + [_ #Nil] + body' + + [#0 _] + (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + #Nil) + body')} + [(text\= "" self_name) names]) + #Nil))))) _ (fail "Wrong syntax for Ex")} @@ -1750,7 +1750,7 @@ (identifier$ ["library/lux" "List"])))] (form$ (list (text$ "lux type check") type expression)))) -(def:''' (splice replace? untemplate elems) +(def:''' (spliced replace? untemplate elems) #Nil (-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) ({#1 @@ -1862,13 +1862,13 @@ [_ [meta (#Form elems)]] (do meta_monad - [output (splice replace? (untemplate replace? subst) elems) + [output (spliced replace? (untemplate replace? subst) elems) #let [[_ output'] (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) output)))]] (wrap [meta output'])) [_ [meta (#Tuple elems)]] (do meta_monad - [output (splice replace? (untemplate replace? subst) elems) + [output (spliced replace? (untemplate replace? subst) elems) #let [[_ output'] (wrap_meta (form$ (list (tag$ ["library/lux" "Tuple"]) output)))]] (wrap [meta output'])) @@ -3296,17 +3296,18 @@ (#Some x) (nth ("lux i64 -" 1 idx) xs')))) -(def: (beta_reduce env type) +## https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction +(def: (reduced env type) (-> (List Type) Type Type) (case type (#Sum left right) - (#Sum (beta_reduce env left) (beta_reduce env right)) + (#Sum (reduced env left) (reduced env right)) (#Product left right) - (#Product (beta_reduce env left) (beta_reduce env right)) + (#Product (reduced env left) (reduced env right)) (#Apply arg func) - (#Apply (beta_reduce env arg) (beta_reduce env func)) + (#Apply (reduced env arg) (reduced env func)) (#UnivQ ?local_env ?local_def) (case ?local_env @@ -3325,7 +3326,7 @@ type) (#Function ?input ?output) - (#Function (beta_reduce env ?input) (beta_reduce env ?output)) + (#Function (reduced env ?input) (reduced env ?output)) (#Parameter idx) (case (nth idx env) @@ -3336,7 +3337,7 @@ type) (#Named name type) - (beta_reduce env type) + (reduced env type) _ type @@ -3346,10 +3347,10 @@ (-> Type Type (Maybe Type)) (case type_fn (#UnivQ env body) - (#Some (beta_reduce (list& type_fn param env) body)) + (#Some (reduced (list& type_fn param env) body)) (#ExQ env body) - (#Some (beta_reduce (list& type_fn param env) body)) + (#Some (reduced (list& type_fn param env) body)) (#Apply A F) (do maybe_monad @@ -3372,16 +3373,16 @@ _ (list type)))] - [flatten_variant #Sum] - [flatten_tuple #Product] - [flatten_lambda #Function] + [flat_variant #Sum] + [flat_tuple #Product] + [flat_lambda #Function] ) -(def: (flatten_app type) +(def: (flat_app type) (-> Type [Type (List Type)]) (case type (#Apply head func') - (let [[func tail] (flatten_app func')] + (let [[func tail] (flat_app func')] [func (#Cons head tail)]) _ @@ -3391,7 +3392,7 @@ (-> Type (Maybe (List Type))) (case type (#Product _) - (#Some (flatten_tuple type)) + (#Some (flat_tuple type)) (#Apply arg func) (do maybe_monad @@ -3717,7 +3718,7 @@ (fail "#only/#+ and #exclude/#- require identifiers.")))) defs)) -(def: (parse_referrals tokens) +(def: (referrals_parser tokens) (-> (List Code) (Meta [Referrals (List Code)])) (case tokens (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "+"])] defs))] tokens')) @@ -3743,7 +3744,7 @@ _ (return [#Nothing tokens]))) -(def: (parse_openings parts) +(def: (openings_parser parts) (-> (List Code) (Meta [(List Openings) (List Code)])) (case parts #.Nil @@ -3760,7 +3761,7 @@ _ (fail "Expected all implementations of opening form to be identifiers."))) structs) - next+remainder (parse_openings parts')] + next+remainder (openings_parser parts')] (let [[next remainder] next+remainder] (return [(#.Cons [prefix structs'] next) remainder]))) @@ -3902,7 +3903,7 @@ #import_alias import_alias #import_refer import_refer})) -(def: (parse_imports nested? relative_root context_alias imports) +(def: (imports_parser nested? relative_root context_alias imports) (-> Bit Text Text (List Code) (Meta (List Importation))) (do meta_monad [imports' (monad\map meta_monad @@ -3927,11 +3928,11 @@ #.None (clean_module nested? relative_root m_name)) - referral+extra (parse_referrals extra) + referral+extra (referrals_parser extra) #let [[referral extra] referral+extra] - openings+extra (parse_openings extra) + openings+extra (openings_parser extra) #let [[openings extra] openings+extra] - sub_imports (parse_imports #1 import_name context_alias extra)] + sub_imports (imports_parser #1 import_name context_alias extra)] (wrap (case [referral openings] [#Nothing #Nil] sub_imports @@ -3951,12 +3952,12 @@ #.None (clean_module nested? relative_root m_name)) - referral+extra (parse_referrals extra) + referral+extra (referrals_parser extra) #let [[referral extra] referral+extra] - openings+extra (parse_openings extra) + openings+extra (openings_parser extra) #let [[openings extra] openings+extra de_aliased (de_alias context_alias m_name alias)] - sub_imports (parse_imports #1 import_name de_aliased extra)] + sub_imports (imports_parser #1 import_name de_aliased extra)] (wrap (case [referral openings] [#Ignore #Nil] sub_imports @@ -4019,7 +4020,7 @@ code\encode)))) )) -(def: (filter p xs) +(def: (only p xs) (All [a] (-> (-> a Bit) (List a) (List a))) (case xs #Nil @@ -4027,8 +4028,8 @@ (#Cons x xs') (if (p x) - (#Cons x (filter p xs')) - (filter p xs')))) + (#Cons x (only p xs')) + (only p xs')))) (def: (is_member? cases name) (-> (List Text) Text Bit) @@ -4196,13 +4197,13 @@ ($_ text\compose "(" name " " (|> params (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")")) (#Sum _) - ($_ text\compose "(| " (|> (flatten_variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(| " (|> (flat_variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") (#Product _) - ($_ text\compose "[" (|> (flatten_tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") + ($_ text\compose "[" (|> (flat_tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") (#Function _) - ($_ text\compose "(-> " (|> (flatten_lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + ($_ text\compose "(-> " (|> (flat_lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") (#Parameter id) (nat\encode id) @@ -4220,7 +4221,7 @@ ($_ text\compose "(Ex " (type\encode body) ")") (#Apply _) - (let [[func args] (flatten_app type)] + (let [[func args] (flat_app type)] ($_ text\compose "(" (type\encode func) " " (|> args (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) @@ -4470,9 +4471,9 @@ (def: (read_refer module_name options) (-> Text (List Code) (Meta Refer)) (do meta_monad - [referral+options (parse_referrals options) + [referral+options (referrals_parser options) #let [[referral options] referral+options] - openings+options (parse_openings options) + openings+options (openings_parser options) #let [[openings options] openings+options] current_module current_module_name] (case options @@ -4514,7 +4515,7 @@ (do meta_monad [*defs (exported_definitions module_name) _ (test_referrals module_name *defs _defs)] - (wrap (filter (|>> (is_member? _defs) not) *defs))) + (wrap (..only (|>> (is_member? _defs) not) *defs))) #Ignore (wrap (list)) @@ -4599,7 +4600,7 @@ _ [(list) tokens]))] current_module current_module_name - imports (parse_imports #0 current_module "" _imports) + imports (imports_parser #0 current_module "" _imports) #let [=imports (|> imports (list\map (: (-> Importation Code) (function (_ [m_name m_alias =refer]) @@ -4798,20 +4799,20 @@ (macro: #export (^template tokens) {#.doc (text$ ($_ "lux text concat" "## It's similar to template, but meant to be used during pattern-matching." ..\n - "(def: (beta_reduce env type)" ..\n + "(def: (reduced env type)" ..\n " (-> (List Type) Type Type)" ..\n " (case type" ..\n " (#.Primitive name params)" ..\n - " (#.Primitive name (list\map (beta_reduce env) params))" + " (#.Primitive name (list\map (reduced env) params))" __paragraph " (^template [<tag>]" ..\n " [(<tag> left right)" ..\n - " (<tag> (beta_reduce env left) (beta_reduce env right))])" ..\n + " (<tag> (reduced env left) (reduced env right))])" ..\n " ([#.Sum] [#.Product])" __paragraph " (^template [<tag>]" ..\n " [(<tag> left right)" ..\n - " (<tag> (beta_reduce env left) (beta_reduce env right))])" ..\n + " (<tag> (reduced env left) (reduced env right))])" ..\n " ([#.Function] [#.Apply])" __paragraph " (^template [<tag>]" ..\n @@ -5241,7 +5242,7 @@ _ (fail "Wrong syntax for with_expansions"))) -(def: (flatten_alias type) +(def: (flat_alias type) (-> Type Type) (case type (^template [<name>] @@ -5255,7 +5256,7 @@ ["Text"]) (#Named _ type') - (flatten_alias type') + (flat_alias type') _ type)) @@ -5265,7 +5266,7 @@ (do meta_monad [type+value (find_def_value name) #let [[type value] type+value]] - (case (flatten_alias type) + (case (flat_alias type) (^template [<name> <type> <wrapper>] [(#Named ["library/lux" <name>] _) (wrap (<wrapper> (:as <type> value)))]) @@ -5330,7 +5331,7 @@ (def: (case_level^ level) (-> Code (Meta [Code Code])) (case level - (^ [_ (#Tuple (list expr binding))]) + (^ [_ (#Record (list [expr binding]))]) (return [expr binding]) _ @@ -5373,7 +5374,8 @@ "Useful in situations where the result of a branch depends on further refinements on the values being matched." "For example:" (case (split (size static) uri) - (^multi (#.Some [chunk uri']) [(text\= static chunk) #1]) + (^multi (#.Some [chunk uri']) + {(text\= static chunk) #1}) (match_uri endpoint? parts' uri') _ @@ -5382,7 +5384,8 @@ "Short-cuts can be taken when using bit tests." "The example above can be rewritten as..." (case (split (size static) uri) - (^multi (#.Some [chunk uri']) (text\= static chunk)) + (^multi (#.Some [chunk uri']) + (text\= static chunk)) (match_uri endpoint? parts' uri') _ @@ -5453,7 +5456,7 @@ (macro: #export ($ tokens) {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." "In the example below, 0 corresponds to the 'a' variable." - (def: #export (from_list list) + (def: #export (of_list list) (All [a] (-> (List a) (Row a))) (list\fold add (: (Row ($ 0)) @@ -5580,7 +5583,7 @@ _ (fail (..wrong_syntax_error (name_of ..:of))))) -(def: (parse_complex_declaration tokens) +(def: (complex_declaration_parser tokens) (-> (List Code) (Meta [[Text (List Text)] (List Code)])) (case tokens (^ (list& [_ (#Form (list& [_ (#Identifier ["" name])] args'))] tokens')) @@ -5600,7 +5603,7 @@ (fail "Could not parse a complex declaration.") )) -(def: (parse_any tokens) +(def: (any_parser tokens) (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& token tokens')) @@ -5610,7 +5613,7 @@ (fail "Could not parse anything.") )) -(def: (parse_many tokens) +(def: (many_parser tokens) (-> (List Code) (Meta [(List Code) (List Code)])) (case tokens (^ (list& head tail)) @@ -5620,7 +5623,7 @@ (fail "Could not parse anything.") )) -(def: (parse_end tokens) +(def: (end_parser tokens) (-> (List Code) (Meta Any)) (case tokens (^ (list)) @@ -5630,7 +5633,7 @@ (fail "Expected input Codes to be empty.") )) -(def: (parse_anns tokens) +(def: (anns_parser tokens) (-> (List Code) (Meta [Code (List Code)])) (case tokens (^ (list& [_ (#Record _anns)] tokens')) @@ -5647,13 +5650,13 @@ (* x x)))} (do meta_monad [#let [[export? tokens] (export^ tokens)] - name+args|tokens (parse_complex_declaration tokens) + name+args|tokens (complex_declaration_parser tokens) #let [[[name args] tokens] name+args|tokens] - anns|tokens (parse_anns tokens) + anns|tokens (anns_parser tokens) #let [[anns tokens] anns|tokens] - input_templates|tokens (parse_many tokens) + input_templates|tokens (many_parser tokens) #let [[input_templates tokens] input_templates|tokens] - _ (parse_end tokens) + _ (end_parser tokens) g!tokens (gensym "tokens") g!compiler (gensym "compiler") g!_ (gensym "_") @@ -5706,7 +5709,7 @@ [identifier (..resolve_global_identifier identifier) type+value (..find_def_value identifier) #let [[type value] type+value]] - (case (..flatten_alias type) + (case (..flat_alias type) (^or (#Primitive "#Text" #Nil) (#Named ["library/lux" "Text"] (#Primitive "#Text" #Nil))) (wrap (:as ..Text value)) |