diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/control/parser/type.lux | 178 |
1 files changed, 89 insertions, 89 deletions
diff --git a/stdlib/source/lux/control/parser/type.lux b/stdlib/source/lux/control/parser/type.lux index 8ed5004fe..32329abbe 100644 --- a/stdlib/source/lux/control/parser/type.lux +++ b/stdlib/source/lux/control/parser/type.lux @@ -25,16 +25,16 @@ (exception.report ["Type" (%.type type)]))] - [not-existential] - [not-recursive] - [not-named] - [not-parameter] - [unknown-parameter] - [not-function] - [not-application] - [not-polymorphic] - [not-variant] - [not-tuple] + [not_existential] + [not_recursive] + [not_named] + [not_parameter] + [unknown_parameter] + [not_function] + [not_application] + [not_polymorphic] + [not_variant] + [not_tuple] ) (template [<name>] @@ -43,17 +43,17 @@ ["Expected" (%.type expected)] ["Actual" (%.type actual)]))] - [types-do-not-match] - [wrong-parameter] + [types_do_not_match] + [wrong_parameter] ) -(exception: #export empty-input) +(exception: #export empty_input) -(exception: #export (unconsumed-input {remaining (List Type)}) +(exception: #export (unconsumed_input {remaining (List Type)}) (exception.report ["Types" (|> remaining - (list\map (|>> %.type (format text.new-line "* "))) - (text.join-with ""))])) + (list\map (|>> %.type (format text.new_line "* "))) + (text.join_with ""))])) (type: #export Env (Dictionary Nat [Type Code])) @@ -77,7 +77,7 @@ (#try.Success output) _ - (exception.throw ..unconsumed-input remaining)))) + (exception.throw ..unconsumed_input remaining)))) (def: #export (run poly type) (All [a] (-> (Parser a) Type (Try a))) @@ -88,7 +88,7 @@ (.function (_ [env inputs]) (#try.Success [[env inputs] env]))) -(def: (with-env temp poly) +(def: (with_env temp poly) (All [a] (-> Env (Parser a) (Parser a))) (.function (_ [env inputs]) (case (//.run poly [temp inputs]) @@ -103,7 +103,7 @@ (.function (_ [env inputs]) (case inputs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons headT tail) (#try.Success [[env inputs] headT])))) @@ -113,32 +113,32 @@ (.function (_ [env inputs]) (case inputs #.Nil - (exception.throw ..empty-input []) + (exception.throw ..empty_input []) (#.Cons headT tail) (#try.Success [[env tail] headT])))) (def: #export (local types poly) (All [a] (-> (List Type) (Parser a) (Parser a))) - (.function (_ [env pass-through]) + (.function (_ [env pass_through]) (case (run' env poly types) (#try.Failure error) (#try.Failure error) (#try.Success output) - (#try.Success [[env pass-through] output])))) + (#try.Success [[env pass_through] output])))) (def: (label idx) (-> Nat Code) - (code.local-identifier ($_ text\compose "label" text.tab (n\encode idx)))) + (code.local_identifier ($_ text\compose "label" text.tab (n\encode idx)))) -(def: #export (with-extension type poly) +(def: #export (with_extension type poly) (All [a] (-> Type (Parser a) (Parser [Code a]))) (.function (_ [env inputs]) - (let [current-id (dictionary.size env) - g!var (label current-id)] + (let [current_id (dictionary.size env) + g!var (label current_id)] (case (//.run poly - [(dictionary.put current-id [type g!var] env) + [(dictionary.put current_id [type g!var] env) inputs]) (#try.Failure error) (#try.Failure error) @@ -151,78 +151,78 @@ (All [a] (-> (Parser a) (Parser a))) (do //.monad [headT ..any] - (let [members (<flattener> (type.un-name headT))] + (let [members (<flattener> (type.un_name headT))] (if (n.> 1 (list.size members)) (local members poly) (//.fail (exception.construct <exception> headT))))))] - [variant type.flatten-variant #.Sum ..not-variant] - [tuple type.flatten-tuple #.Product ..not-tuple] + [variant type.flatten_variant #.Sum ..not_variant] + [tuple type.flatten_tuple #.Product ..not_tuple] ) (def: polymorphic' (Parser [Nat Type]) (do //.monad [headT any - #let [[num-arg bodyT] (type.flatten-univ-q (type.un-name headT))]] - (if (n.= 0 num-arg) - (//.fail (exception.construct ..not-polymorphic headT)) - (wrap [num-arg bodyT])))) + #let [[num_arg bodyT] (type.flatten_univ_q (type.un_name headT))]] + (if (n.= 0 num_arg) + (//.fail (exception.construct ..not_polymorphic headT)) + (wrap [num_arg bodyT])))) (def: #export (polymorphic poly) (All [a] (-> (Parser a) (Parser [Code (List Code) a]))) (do {! //.monad} [headT any funcI (\ ! map dictionary.size ..env) - [num-args non-poly] (local (list headT) ..polymorphic') + [num_args non_poly] (local (list headT) ..polymorphic') env ..env #let [funcL (label funcI) - [all-varsL env'] (loop [current-arg 0 + [all_varsL env'] (loop [current_arg 0 env' env - all-varsL (: (List Code) (list))] - (if (n.< num-args current-arg) - (if (n.= 0 current-arg) + all_varsL (: (List Code) (list))] + (if (n.< num_args current_arg) + (if (n.= 0 current_arg) (let [varL (label (inc funcI))] - (recur (inc current-arg) + (recur (inc current_arg) (|> env' (dictionary.put funcI [headT funcL]) (dictionary.put (inc funcI) [(#.Parameter (inc funcI)) varL])) - (#.Cons varL all-varsL))) - (let [partialI (|> current-arg (n.* 2) (n.+ funcI)) - partial-varI (inc partialI) - partial-varL (label partial-varI) - partialC (` ((~ funcL) (~+ (|> (list.indices num-args) + (#.Cons varL all_varsL))) + (let [partialI (|> current_arg (n.* 2) (n.+ funcI)) + partial_varI (inc partialI) + partial_varL (label partial_varI) + partialC (` ((~ funcL) (~+ (|> (list.indices num_args) (list\map (|>> (n.* 2) inc (n.+ funcI) label)) list.reverse))))] - (recur (inc current-arg) + (recur (inc current_arg) (|> env' (dictionary.put partialI [.Nothing partialC]) - (dictionary.put partial-varI [(#.Parameter partial-varI) partial-varL])) - (#.Cons partial-varL all-varsL)))) - [all-varsL env']))]] - (<| (with-env env') - (local (list non-poly)) + (dictionary.put partial_varI [(#.Parameter partial_varI) partial_varL])) + (#.Cons partial_varL all_varsL)))) + [all_varsL env']))]] + (<| (with_env env') + (local (list non_poly)) (do ! [output poly] - (wrap [funcL all-varsL output]))))) + (wrap [funcL all_varsL output]))))) -(def: #export (function in-poly out-poly) +(def: #export (function in_poly out_poly) (All [i o] (-> (Parser i) (Parser o) (Parser [i o]))) (do //.monad [headT any - #let [[inputsT outputT] (type.flatten-function (type.un-name headT))]] + #let [[inputsT outputT] (type.flatten_function (type.un_name headT))]] (if (n.> 0 (list.size inputsT)) - (//.and (local inputsT in-poly) - (local (list outputT) out-poly)) - (//.fail (exception.construct ..not-function headT))))) + (//.and (local inputsT in_poly) + (local (list outputT) out_poly)) + (//.fail (exception.construct ..not_function headT))))) (def: #export (apply poly) (All [a] (-> (Parser a) (Parser a))) (do //.monad [headT any - #let [[funcT paramsT] (type.flatten-application (type.un-name headT))]] + #let [[funcT paramsT] (type.flatten_application (type.un_name headT))]] (if (n.= 0 (list.size paramsT)) - (//.fail (exception.construct ..not-application headT)) + (//.fail (exception.construct ..not_application headT)) (..local (#.Cons funcT paramsT) poly)))) (template [<name> <test>] @@ -232,19 +232,19 @@ [actual any] (if (<test> expected actual) (wrap []) - (//.fail (exception.construct ..types-do-not-match [expected actual])))))] + (//.fail (exception.construct ..types_do_not_match [expected actual])))))] [exactly type\=] [sub check.checks?] [super (function.flip check.checks?)] ) -(def: #export (adjusted-idx env idx) +(def: #export (adjusted_idx env idx) (-> Env Nat Nat) - (let [env-level (n./ 2 (dictionary.size env)) - parameter-level (n./ 2 idx) - parameter-idx (n.% 2 idx)] - (|> env-level dec (n.- parameter-level) (n.* 2) (n.+ parameter-idx)))) + (let [env_level (n./ 2 (dictionary.size env)) + parameter_level (n./ 2 idx) + parameter_idx (n.% 2 idx)] + (|> env_level dec (n.- parameter_level) (n.* 2) (n.+ parameter_idx)))) (def: #export parameter (Parser Code) @@ -253,15 +253,15 @@ headT any] (case headT (#.Parameter idx) - (case (dictionary.get (adjusted-idx env idx) env) - (#.Some [poly-type poly-code]) - (wrap poly-code) + (case (dictionary.get (adjusted_idx env idx) env) + (#.Some [poly_type poly_code]) + (wrap poly_code) #.None - (//.fail (exception.construct ..unknown-parameter headT))) + (//.fail (exception.construct ..unknown_parameter headT))) _ - (//.fail (exception.construct ..not-parameter headT))))) + (//.fail (exception.construct ..not_parameter headT))))) (def: #export (parameter! id) (-> Nat (Parser Any)) @@ -270,23 +270,23 @@ headT any] (case headT (#.Parameter idx) - (if (n.= id (adjusted-idx env idx)) + (if (n.= id (adjusted_idx env idx)) (wrap []) - (//.fail (exception.construct ..wrong-parameter [(#.Parameter id) headT]))) + (//.fail (exception.construct ..wrong_parameter [(#.Parameter id) headT]))) _ - (//.fail (exception.construct ..not-parameter headT))))) + (//.fail (exception.construct ..not_parameter headT))))) (def: #export existential (Parser Nat) (do //.monad [headT any] (case headT - (#.Ex ex-id) - (wrap ex-id) + (#.Ex ex_id) + (wrap ex_id) _ - (//.fail (exception.construct ..not-existential headT))))) + (//.fail (exception.construct ..not_existential headT))))) (def: #export named (Parser [Name Type]) @@ -297,7 +297,7 @@ (wrap [name anonymousT]) _ - (//.fail (exception.construct ..not-named inputT))))) + (//.fail (exception.construct ..not_named inputT))))) (template: (|nothing|) (#.Named ["lux" "Nothing"] @@ -308,33 +308,33 @@ (All [a] (-> (Parser a) (Parser [Code a]))) (do {! //.monad} [headT any] - (case (type.un-name headT) + (case (type.un_name headT) (^ (#.Apply (|nothing|) (#.UnivQ _ headT'))) (do ! [[recT _ output] (|> poly - (with-extension .Nothing) - (with-extension headT) + (with_extension .Nothing) + (with_extension headT) (local (list headT')))] (wrap [recT output])) _ - (//.fail (exception.construct ..not-recursive headT))))) + (//.fail (exception.construct ..not_recursive headT))))) -(def: #export recursive-self +(def: #export recursive_self (Parser Code) (do //.monad [env ..env headT any] - (case (type.un-name headT) - (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT-idx))) - (n.= 0 (adjusted-idx env funcT-idx)) - [(dictionary.get 0 env) (#.Some [self-type self-call])]) - (wrap self-call) + (case (type.un_name headT) + (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT_idx))) + (n.= 0 (adjusted_idx env funcT_idx)) + [(dictionary.get 0 env) (#.Some [self_type self_call])]) + (wrap self_call) _ - (//.fail (exception.construct ..not-recursive headT))))) + (//.fail (exception.construct ..not_recursive headT))))) -(def: #export recursive-call +(def: #export recursive_call (Parser Code) (do {! //.monad} [env ..env |