diff options
Diffstat (limited to 'stdlib/source/library')
| -rw-r--r-- | stdlib/source/library/lux/control/parser.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/library/lux/data/text.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/frac.lux | 52 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/int.lux | 25 | ||||
| -rw-r--r-- | stdlib/source/library/lux/math/number/nat.lux | 61 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta.lux | 106 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/code.lux | 155 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/macro/context.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/macro/custom.lux | 53 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/macro/syntax/export.lux | 39 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/type.lux | 519 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/type/primitive.lux | 1 |
12 files changed, 566 insertions, 465 deletions
diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index 6b57ce695..d7cf37138 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -11,10 +11,7 @@ [data ["[0]" product] [collection - ["[0]" list (.use "[1]#[0]" functor monoid)]]] - [math - [number - ["n" nat]]]]]) + ["[0]" list (.use "[1]#[0]" functor monoid)]]]]]) (type .public (Parser s a) (-> s (Try [s a]))) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 8b0547523..e9fa52957 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -18,9 +18,7 @@ ["n" nat] ["[0]" i64]]] [meta - ["@" target] - [macro - ["^" pattern]]]]]) + ["@" target]]]]) (type .public Char Nat) @@ -316,7 +314,7 @@ (def .public together (-> (List Text) Text) - (let [(^.open "[0]") ..monoid] + (with ..monoid (|>> list.reversed (list#mix composite identity)))) @@ -339,7 +337,8 @@ (def .public (space? char) (-> Char Bit) (with_expansions [<options> (with_template [<char>] - [(.char (,, (static <char>)))] + [(.char (,, (static <char>))) + true] [..tab] [..vertical_tab] @@ -349,8 +348,7 @@ [..form_feed] )] (`` (case char - (^.or <options>) - true + <options> _ false)))) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index fb2f1b85f..a11b95741 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -16,9 +16,7 @@ [data ["[0]" text]] [meta - ["@" target] - [macro - ["^" pattern]]]]] + ["@" target]]]] ["[0]" // ["[1][0]" i64] ["[1][0]" nat] @@ -754,29 +752,31 @@ (..* exponent) (..* sign))))) -(def (representation_exponent codec representation) - (-> (Codec Text Nat) Text (Try [Text Int])) - (case [("lux text index" 0 "e+" representation) - ("lux text index" 0 "E+" representation) - ("lux text index" 0 "e-" representation) - ("lux text index" 0 "E-" representation)] - (^.with_template [<factor> <patterns>] - [<patterns> - (do try.monad - [.let [after_offset (//nat.+ 2 split_index) - after_length (//nat.- after_offset ("lux text size" representation))] - exponent (|> representation - ("lux text clip" after_offset after_length) - (at codec decoded))] - (in [("lux text clip" 0 split_index representation) - (//int.* <factor> (.int exponent))]))]) - ([+1 (^.or [{.#Some split_index} {.#None} {.#None} {.#None}] - [{.#None} {.#Some split_index} {.#None} {.#None}])] - [-1 (^.or [{.#None} {.#None} {.#Some split_index} {.#None}] - [{.#None} {.#None} {.#None} {.#Some split_index}])]) - - _ - {try.#Success [representation +0]})) +(`` (def (representation_exponent codec representation) + (-> (Codec Text Nat) Text (Try [Text Int])) + (case [("lux text index" 0 "e+" representation) + ("lux text index" 0 "E+" representation) + ("lux text index" 0 "e-" representation) + ("lux text index" 0 "E-" representation)] + (,, (with_template [<factor> <pattern>] + [<pattern> + (do try.monad + [.let [after_offset (//nat.+ 2 split_index) + after_length (//nat.- after_offset ("lux text size" representation))] + exponent (|> representation + ("lux text clip" after_offset after_length) + (at codec decoded))] + (in [("lux text clip" 0 split_index representation) + (//int.* <factor> (.int exponent))]))] + + [+1 [{.#Some split_index} {.#None} {.#None} {.#None}]] + [+1 [{.#None} {.#Some split_index} {.#None} {.#None}]] + + [-1 [{.#None} {.#None} {.#Some split_index} {.#None}]] + [-1 [{.#None} {.#None} {.#None} {.#Some split_index}]])) + + _ + {try.#Success [representation +0]}))) (with_template [<struct> <nat> <int> <error>] [(def .public <struct> diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 3eb21d465..d5a563dd5 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -15,10 +15,7 @@ [function [predicate (.only Predicate)]]] [data - [text (.only Char)]] - [meta - [macro - ["^" pattern]]]]] + [text (.only Char)]]]] ["[0]" // ["[1][0]" nat] ["[1][0]" i64]]) @@ -147,14 +144,18 @@ b1 (- (* q b1) a1)))))) ... https://en.wikipedia.org/wiki/Least_common_multiple -(def .public (lcm a b) - (-> Int Int Int) - (case [a b] - (^.or [_ +0] [+0 _]) - +0 - - _ - (|> a (/ (gcd a b)) (* b)))) +(`` (def .public (lcm a b) + (-> Int Int Int) + (case [a b] + (,, (with_template [<pattern>] + [<pattern> + +0] + + [[_ +0]] + [[+0 _]])) + + _ + (|> a (/ (gcd a b)) (* b))))) (def .public frac (-> Int Frac) diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index 75bf0fe2b..c502f4d96 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -12,10 +12,7 @@ [control ["[0]" function] ["[0]" maybe] - ["[0]" try (.only Try)]] - [meta - [macro - ["^" pattern]]]]]) + ["[0]" try (.only Try)]]]]) (with_template [<extension> <output> <name>] [(def .public (<name> parameter subject) @@ -122,14 +119,18 @@ (-> Nat Nat Bit) (..= 1 (..gcd a b))) -(def .public (lcm a b) - (-> Nat Nat Nat) - (case [a b] - (^.or [_ 0] [0 _]) - 0 +(`` (def .public (lcm a b) + (-> Nat Nat Nat) + (case [a b] + (,, (with_template [<pattern>] + [<pattern> + 0] + + [[_ 0]] + [[0 _]])) - _ - (|> a (../ (..gcd a b)) (..* b)))) + _ + (|> a (../ (..gcd a b)) (..* b))))) (def .public even? (-> Nat Bit) @@ -272,22 +273,28 @@ 15 "F" _ (undefined))) -(def (hexadecimal_value digit) - (-> Nat (Maybe Nat)) - (case digit - (^.with_template [<character> <number>] - [(char <character>) - {.#Some <number>}]) - (["0" 0] ["1" 1] ["2" 2] ["3" 3] ["4" 4] - ["5" 5] ["6" 6] ["7" 7] ["8" 8] ["9" 9]) - - (^.with_template [<lower> <upper> <number>] - [(^.or (char <lower>) - (char <upper>)) - {.#Some <number>}]) - (["a" "A" 10] ["b" "B" 11] ["c" "C" 12] - ["d" "D" 13] ["e" "E" 14] ["f" "F" 15]) - _ {.#None})) +(`` (def (hexadecimal_value digit) + (-> Nat (Maybe Nat)) + (case digit + (,, (with_template [<character> <number>] + [(char <character>) + {.#Some <number>}] + + ["0" 0] ["1" 1] ["2" 2] ["3" 3] ["4" 4] + ["5" 5] ["6" 6] ["7" 7] ["8" 8] ["9" 9])) + + (,, (with_template [<lower> <upper> <number>] + [(char <lower>) + {.#Some <number>} + + (char <upper>) + {.#Some <number>}] + + ["a" "A" 10] ["b" "B" 11] ["c" "C" 12] + ["d" "D" 13] ["e" "E" 14] ["f" "F" 15])) + + _ + {.#None}))) (with_template [<shift> <struct> <to_character> <to_value> <error>] [(def .public <struct> diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index a1bb5d944..54f31901a 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -21,9 +21,7 @@ [/ ["[0]" location] ["[0]" symbol (.use "[1]#[0]" codec equivalence)] - ["[0]" code] - [macro - ["^" pattern]]]) + ["[0]" code]]) ... (.type (Meta a) ... (-> Lux (Try [Lux a]))) @@ -234,23 +232,27 @@ bound (type_variable idx bindings')))) -(def (clean_type type) - (-> Type (Meta Type)) - (case type - {.#Var var} - (function (_ lux) - (case (|> lux - (the [.#type_context .#var_bindings]) - (type_variable var)) - (^.or {.#None} - {.#Some {.#Var _}}) - {try.#Success [lux type]} +(`` (def (clean_type type) + (-> Type (Meta Type)) + (case type + {.#Var var} + (function (_ lux) + (case (|> lux + (the [.#type_context .#var_bindings]) + (type_variable var)) + (,, (with_template [<pattern>] + [<pattern> + {try.#Success [lux type]}] - {.#Some type'} - {try.#Success [lux type']})) + [{.#None}] + [{.#Some {.#Var _}}])) + - _ - (at ..monad in type))) + {.#Some type'} + {try.#Success [lux type']})) + + _ + (at ..monad in type)))) (def .public (var_type name) (-> Text (Meta Type)) @@ -324,22 +326,25 @@ (|> module (the .#definitions) (list.all (function (_ [def_name global]) - (case global - (^.or {.#Definition [exported? _]} - {.#Type [exported? _]}) - (if (and exported? - (text#= normal_short def_name)) - {.#Some (symbol#encoded [module_name def_name])} - {.#None}) - - {.#Alias _} - {.#None} - - {.#Tag _} - {.#None} - - {.#Slot _} - {.#None})))))) + (`` (case global + (,, (with_template [<pattern>] + [<pattern> + (if (and exported? + (text#= normal_short def_name)) + {.#Some (symbol#encoded [module_name def_name])} + {.#None})] + + [{.#Definition [exported? _]}] + [{.#Type [exported? _]}])) + + {.#Alias _} + {.#None} + + {.#Tag _} + {.#None} + + {.#Slot _} + {.#None}))))))) list.together (list.sorted text#<) (text.interposed ..listing_separator)) @@ -500,21 +505,24 @@ [lux] {try.#Success}))) -(def .public (tags_of type_name) - (-> Symbol (Meta (Maybe (List Symbol)))) - (do ..monad - [.let [[module_name name] type_name] - module (..module module_name)] - (case (property.value name (the .#definitions module)) - {.#Some {.#Type [exported? type labels]}} - (case labels - (^.or {.#Left labels} - {.#Right labels}) - (in {.#Some (list#each (|>> [module_name]) - {.#Item labels})})) - - _ - (in {.#None})))) +(`` (def .public (tags_of type_name) + (-> Symbol (Meta (Maybe (List Symbol)))) + (do ..monad + [.let [[module_name name] type_name] + module (..module module_name)] + (case (property.value name (the .#definitions module)) + {.#Some {.#Type [exported? type labels]}} + (case labels + (,, (with_template [<pattern>] + [<pattern> + (in {.#Some (list#each (|>> [module_name]) + {.#Item labels})})] + + [{.#Left labels}] + [{.#Right labels}]))) + + _ + (in {.#None}))))) (def .public location (Meta Location) diff --git a/stdlib/source/library/lux/meta/code.lux b/stdlib/source/library/lux/meta/code.lux index c65f613c5..68d5327b1 100644 --- a/stdlib/source/library/lux/meta/code.lux +++ b/stdlib/source/library/lux/meta/code.lux @@ -17,9 +17,7 @@ ["[0]" frac]]] [meta ["[0]" location] - ["[0]" symbol] - [macro - ["^" pattern]]]]]) + ["[0]" symbol]]]]) ... (type (Code' w) ... {.#Bit Bit} @@ -60,76 +58,81 @@ [local .#Symbol]) -(def .public equivalence - (Equivalence Code) - (implementation - (def (= x y) - (case [x y] - (^.with_template [<tag> <eq>] - [[[_ {<tag> x'}] [_ {<tag> y'}]] - (at <eq> = x' y')]) - ([.#Bit bit.equivalence] - [.#Nat nat.equivalence] - [.#Int int.equivalence] - [.#Rev rev.equivalence] - [.#Frac frac.equivalence] - [.#Text text.equivalence] - [.#Symbol symbol.equivalence]) - - (^.with_template [<tag>] - [[[_ {<tag> xs'}] [_ {<tag> ys'}]] - (at (list.equivalence =) = xs' ys')]) - ([.#Form] - [.#Variant] - [.#Tuple]) - - _ - false)))) - -(def .public (format ast) - (-> Code Text) - (case ast - (^.with_template [<tag> <struct>] - [[_ {<tag> value}] - (at <struct> encoded value)]) - ([.#Bit bit.codec] - [.#Nat nat.decimal] - [.#Int int.decimal] - [.#Rev rev.decimal] - [.#Frac frac.decimal] - [.#Symbol symbol.codec]) - - [_ {.#Text value}] - (text.format value) - - (^.with_template [<tag> <open> <close>] - [[_ {<tag> members}] - (all text#composite - <open> - (list#mix (function (_ next prev) - (let [next (format next)] - (if (text#= "" prev) - next - (all text#composite prev " " next)))) - "" - members) - <close>)]) - ([.#Form "(" ")"] - [.#Variant "{" "}"] - [.#Tuple "[" "]"]) - )) - -(def .public (replaced original substitute ast) - (-> Code Code Code Code) - (if (at ..equivalence = original ast) - substitute - (case ast - (^.with_template [<tag>] - [[location {<tag> parts}] - [location {<tag> (list#each (replaced original substitute) parts)}]]) - ([.#Form] - [.#Variant] - [.#Tuple]) - - _ - ast))) +(`` (def .public equivalence + (Equivalence Code) + (implementation + (def (= x y) + (case [x y] + (,, (with_template [<tag> <eq>] + [[[_ {<tag> x'}] [_ {<tag> y'}]] + (at <eq> = x' y')] + + [.#Bit bit.equivalence] + [.#Nat nat.equivalence] + [.#Int int.equivalence] + [.#Rev rev.equivalence] + [.#Frac frac.equivalence] + [.#Text text.equivalence] + [.#Symbol symbol.equivalence])) + + (,, (with_template [<tag>] + [[[_ {<tag> xs'}] [_ {<tag> ys'}]] + (at (list.equivalence =) = xs' ys')] + + [.#Form] + [.#Variant] + [.#Tuple])) + + _ + false))))) + +(`` (def .public (format ast) + (-> Code Text) + (case ast + (,, (with_template [<tag> <struct>] + [[_ {<tag> value}] + (at <struct> encoded value)] + + [.#Bit bit.codec] + [.#Nat nat.decimal] + [.#Int int.decimal] + [.#Rev rev.decimal] + [.#Frac frac.decimal] + [.#Symbol symbol.codec])) + + [_ {.#Text value}] + (text.format value) + + (,, (with_template [<tag> <open> <close>] + [[_ {<tag> members}] + (all text#composite + <open> + (list#mix (function (_ next prev) + (let [next (format next)] + (if (text#= "" prev) + next + (all text#composite prev " " next)))) + "" + members) + <close>)] + + [.#Form "(" ")"] + [.#Variant "{" "}"] + [.#Tuple "[" "]"])) + ))) + +(`` (def .public (replaced original substitute ast) + (-> Code Code Code Code) + (if (at ..equivalence = original ast) + substitute + (case ast + (,, (with_template [<tag>] + [[location {<tag> parts}] + [location {<tag> (list#each (replaced original substitute) parts)}]] + + [.#Form] + [.#Variant] + [.#Tuple])) + + _ + ast)))) diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux index 0cf61b454..99b62e8ab 100644 --- a/stdlib/source/library/lux/meta/macro/context.lux +++ b/stdlib/source/library/lux/meta/macro/context.lux @@ -19,8 +19,7 @@ ["[0]" code (.only) ["?[1]" \\parser]]]]] ["[0]" // (.only) - [syntax (.only syntax)] - ["^" pattern]]) + [syntax (.only syntax)]]) (type .public Stack List) diff --git a/stdlib/source/library/lux/meta/macro/custom.lux b/stdlib/source/library/lux/meta/macro/custom.lux new file mode 100644 index 000000000..632219851 --- /dev/null +++ b/stdlib/source/library/lux/meta/macro/custom.lux @@ -0,0 +1,53 @@ +(.require + [library + [lux (.except local) + [abstract + [monad (.only do)]] + [control + ["?" parser (.use "[1]#[0]" functor)] + ["[0]" exception (.only exception)]]]] + ["[0]" // (.only) + [syntax (.only syntax) + ["[0]" export]] + ["/[1]" // (.only) + ["[0]" code (.only) + ["?[1]" \\parser (.only Parser)]] + ["[0]" type (.only) + [primitive (.except)]]]]) + +(exception .public (invalid_type [expected Type + actual Type]) + (exception.report + (list ["Expected" (type.format expected)] + ["Actual" (type.format actual)]))) + +(def local + (Parser Code) + (?#each code.local ?code.local)) + +(def .public custom + (syntax (_ [[public|private <type> <in> <out> <by_name>] + (export.parser (all ?.and + ..local + ..local + ..local + ..local))]) + (//.with_symbols [g!_ g!type g!value] + (in (list (` (primitive (, public|private) (, <type>) + Macro)) + + (` (def (, public|private) (, <in>) + (-> Macro (, <type>)) + (|>> abstraction))) + + (` (def (, public|private) (, <out>) + (-> (, <type>) Macro) + (|>> representation))) + + (` (def (, public|private) ((, <by_name>) (, g!_)) + (-> Symbol (Meta (, <type>))) + ((,! do) (,! ///.monad) + [[(, g!_) (, g!type) (, g!value)] ((,! ///.export) (, g!_))] + (if (at (,! type.equivalence) (,' =) (, <type>) (, g!type)) + ((,' in) (as (, <type>) (, g!value))) + ((,! ///.failure) ((,! exception.except) ..invalid_type [(, <type>) (, g!type)]))))))))))) diff --git a/stdlib/source/library/lux/meta/macro/syntax/export.lux b/stdlib/source/library/lux/meta/macro/syntax/export.lux index d68b4a678..1bc78cb9f 100644 --- a/stdlib/source/library/lux/meta/macro/syntax/export.lux +++ b/stdlib/source/library/lux/meta/macro/syntax/export.lux @@ -7,30 +7,31 @@ ["<>" parser]] [meta ["[0]" code - ["<[1]>" \\parser (.only Parser)]] - [macro - ["^" pattern]]]]]) + ["<[1]>" \\parser (.only Parser)]]]]]) (def .public default_policy Code (` .private)) -(def policy - (Parser Code) - (do [! <>.monad] - [candidate <code>.next] - (case candidate - [_ {.#Symbol ["" _]}] - (in default_policy) - - (^.or [_ {.#Bit _}] - [_ {.#Symbol _}]) - (do ! - [_ <code>.any] - (in candidate)) - - _ - (in default_policy)))) +(`` (def policy + (Parser Code) + (do [! <>.monad] + [candidate <code>.next] + (case candidate + [_ {.#Symbol ["" _]}] + (in default_policy) + + (,, (with_template [<pattern>] + [<pattern> + (do ! + [_ <code>.any] + (in candidate))] + + [[_ {.#Bit _}]] + [[_ {.#Symbol _}]])) + + _ + (in default_policy))))) (def .public parser (All (_ a) (-> (Parser a) (Parser [Code a]))) diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux index 4d4293e6d..9af406098 100644 --- a/stdlib/source/library/lux/meta/type.lux +++ b/stdlib/source/library/lux/meta/type.lux @@ -24,8 +24,7 @@ ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] ["[0]" macro (.only) - [syntax (.only syntax)] - ["^" pattern]]]]]) + [syntax (.only syntax)]]]]]) (with_template [<name> <tag>] [(def .public (<name> type) @@ -77,202 +76,226 @@ [flat_tuple .#Product] ) -(def .public (format type) - (-> Type Text) - (case type - {.#Primitive name params} - (all text#composite - "(Primitive " - (text.enclosed' text.double_quote name) - (|> params - (list#each (|>> format (text#composite " "))) - (list#mix (function.flipped text#composite) "")) - ")") - - (^.with_template [<tag> <open> <close> <flat>] - [{<tag> _} - (all text#composite <open> - (|> (<flat> type) - (list#each format) - list.reversed - (list.interposed " ") - (list#mix text#composite "")) - <close>)]) - ([.#Sum "(Or " ")" flat_variant] - [.#Product "[" "]" flat_tuple]) - - {.#Function input output} - (.let [[ins out] (flat_function type)] - (all text#composite "(-> " - (|> ins - (list#each format) - list.reversed - (list.interposed " ") - (list#mix text#composite "")) - " " (format out) ")")) - - {.#Parameter idx} - (n#encoded idx) - - {.#Var id} - (all text#composite "-" (n#encoded id)) - - {.#Ex id} - (all text#composite "+" (n#encoded id)) - - {.#Apply param fun} - (.let [[type_func type_args] (flat_application type)] - (all text#composite "(" (format type_func) " " (|> type_args (list#each format) list.reversed (list.interposed " ") (list#mix text#composite "")) ")")) - - (^.with_template [<tag> <desc>] - [{<tag> env body} - (all text#composite "(" <desc> " {" (|> env (list#each format) (text.interposed " ")) "} " (format body) ")")]) - ([.#UnivQ "All"] - [.#ExQ "Ex"]) - - {.#Named [module name] type} - (all text#composite module "." name) - )) +(`` (def .public (format type) + (-> Type Text) + (case type + {.#Primitive name params} + (all text#composite + "(Primitive " + (text.enclosed' text.double_quote name) + (|> params + (list#each (|>> format (text#composite " "))) + (list#mix (function.flipped text#composite) "")) + ")") + + (,, (with_template [<tag> <open> <close> <flat>] + [{<tag> _} + (all text#composite <open> + (|> (<flat> type) + (list#each format) + list.reversed + (list.interposed " ") + (list#mix text#composite "")) + <close>)] + + [.#Sum "(Or " ")" flat_variant] + [.#Product "[" "]" flat_tuple])) + + {.#Function input output} + (.let [[ins out] (flat_function type)] + (all text#composite "(-> " + (|> ins + (list#each format) + list.reversed + (list.interposed " ") + (list#mix text#composite "")) + " " (format out) ")")) + + {.#Parameter idx} + (n#encoded idx) + + {.#Var id} + (all text#composite "-" (n#encoded id)) + + {.#Ex id} + (all text#composite "+" (n#encoded id)) + + {.#Apply param fun} + (.let [[type_func type_args] (flat_application type)] + (all text#composite "(" (format type_func) " " (|> type_args (list#each format) list.reversed (list.interposed " ") (list#mix text#composite "")) ")")) + + (,, (with_template [<tag> <desc>] + [{<tag> env body} + (all text#composite "(" <desc> " {" (|> env (list#each format) (text.interposed " ")) "} " (format body) ")")] + + [.#UnivQ "All"] + [.#ExQ "Ex"])) + + {.#Named [module name] type} + (all text#composite module "." name) + ))) ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction -(def (reduced env type) - (-> (List Type) Type Type) - (case type - {.#Primitive name params} - {.#Primitive name (list#each (reduced env) params)} - - (^.with_template [<tag>] - [{<tag> left right} - {<tag> (reduced env left) (reduced env right)}]) - ([.#Sum] [.#Product] - [.#Function] [.#Apply]) - - (^.with_template [<tag>] - [{<tag> old_env def} - (case old_env - {.#End} - {<tag> env def} +(`` (def (reduced env type) + (-> (List Type) Type Type) + (case type + {.#Primitive name params} + {.#Primitive name (list#each (reduced env) params)} + + (,, (with_template [<tag>] + [{<tag> left right} + {<tag> (reduced env left) (reduced env right)}] - _ - {<tag> (list#each (reduced env) old_env) def})]) - ([.#UnivQ] - [.#ExQ]) - - {.#Parameter idx} - (maybe.else (panic! (all text#composite - "Unknown type parameter" text.new_line - " Index: " (n#encoded idx) text.new_line - "Environment: " (|> env - list.enumeration - (list#each (.function (_ [index type]) - (all text#composite - (n#encoded index) - " " (..format type)))) - (text.interposed (text#composite text.new_line " "))))) - (list.item idx env)) - - _ - type - )) - -(def .public equivalence - (Equivalence Type) - (implementation - (def (= x y) - (or (for @.php - ... TODO: Remove this once JPHP is gone. - false - (same? x y)) - (case [x y] - [{.#Primitive xname xparams} {.#Primitive yname yparams}] - (and (text#= xname yname) - (n.= (list.size yparams) (list.size xparams)) - (list#mix (.function (_ [x y] prev) (and prev (= x y))) - #1 - (list.zipped_2 xparams yparams))) - - (^.with_template [<tag>] - [[{<tag> xid} {<tag> yid}] - (n.= yid xid)]) - ([.#Var] [.#Ex] [.#Parameter]) - - (^.or [{.#Function xleft xright} {.#Function yleft yright}] - [{.#Apply xleft xright} {.#Apply yleft yright}]) - (and (= xleft yleft) - (= xright yright)) - - [{.#Named xname xtype} {.#Named yname ytype}] - (and (symbol#= xname yname) - (= xtype ytype)) - - (^.with_template [<tag>] - [[{<tag> xL xR} {<tag> yL yR}] - (and (= xL yL) (= xR yR))]) - ([.#Sum] [.#Product]) - - (^.or [{.#UnivQ xenv xbody} {.#UnivQ yenv ybody}] - [{.#ExQ xenv xbody} {.#ExQ yenv ybody}]) - (and (n.= (list.size yenv) (list.size xenv)) - (= xbody ybody) - (list#mix (.function (_ [x y] prev) (and prev (= x y))) - #1 - (list.zipped_2 xenv yenv))) - - _ - #0 - ))))) - -(def .public (applied params func) - (-> (List Type) Type (Maybe Type)) - (case params - {.#End} - {.#Some func} + [.#Sum] [.#Product] + [.#Function] [.#Apply])) + + (,, (with_template [<tag>] + [{<tag> old_env def} + (case old_env + {.#End} + {<tag> env def} - {.#Item param params'} - (case func - (^.with_template [<tag>] - [{<tag> env body} - (|> body - (reduced (list.partial func param env)) - (applied params'))]) - ([.#UnivQ] [.#ExQ]) - - {.#Apply A F} - (applied (list.partial A params) F) - - {.#Named name unnamed} - (applied params unnamed) - - _ - {.#None}))) + _ + {<tag> (list#each (reduced env) old_env) def})] -(def .public (code type) - (-> Type Code) - (case type - {.#Primitive name params} - (` {.#Primitive (, (code.text name)) - (.list (,* (list#each code params)))}) - - (^.with_template [<tag>] - [{<tag> idx} - (` {<tag> (, (code.nat idx))})]) - ([.#Var] [.#Ex] [.#Parameter]) - - (^.with_template [<tag>] - [{<tag> left right} - (` {<tag> (, (code left)) - (, (code right))})]) - ([.#Sum] [.#Product] [.#Function] [.#Apply]) - - {.#Named name sub_type} - (code.symbol name) - - (^.with_template [<tag>] - [{<tag> env body} - (` {<tag> (.list (,* (list#each code env))) - (, (code body))})]) - ([.#UnivQ] [.#ExQ]) - )) + [.#UnivQ] + [.#ExQ])) + + {.#Parameter idx} + (maybe.else (panic! (all text#composite + "Unknown type parameter" text.new_line + " Index: " (n#encoded idx) text.new_line + "Environment: " (|> env + list.enumeration + (list#each (.function (_ [index type]) + (all text#composite + (n#encoded index) + " " (..format type)))) + (text.interposed (text#composite text.new_line " "))))) + (list.item idx env)) + + _ + type + ))) + +(`` (def .public equivalence + (Equivalence Type) + (implementation + (def (= x y) + (or (for @.php + ... TODO: Remove this once JPHP is gone. + false + (same? x y)) + (case [x y] + [{.#Primitive xname xparams} {.#Primitive yname yparams}] + (and (text#= xname yname) + (n.= (list.size yparams) (list.size xparams)) + (list#mix (.function (_ [x y] prev) (and prev (= x y))) + #1 + (list.zipped_2 xparams yparams))) + + (,, (with_template [<tag>] + [[{<tag> xid} {<tag> yid}] + (n.= yid xid)] + + [.#Var] + [.#Ex] + [.#Parameter] + )) + + (,, (with_template [<tag>] + [[{<tag> ll lr} {<tag> rl rr}] + (and (= ll rl) + (= lr rr))] + + [.#Function] + [.#Apply] + [.#Sum] + [.#Product] + )) + + [{.#Named xname xtype} {.#Named yname ytype}] + (and (symbol#= xname yname) + (= xtype ytype)) + + (,, (with_template [<tag>] + [[{<tag> xenv xbody} {<tag> yenv ybody}] + (and (n.= (list.size yenv) (list.size xenv)) + (= xbody ybody) + (list#mix (.function (_ [x y] prev) (and prev (= x y))) + #1 + (list.zipped_2 xenv yenv)))] + + [.#UnivQ] + [.#ExQ] + )) + + _ + #0 + )))))) + +(`` (def .public (applied params func) + (-> (List Type) Type (Maybe Type)) + (case params + {.#End} + {.#Some func} + + {.#Item param params'} + (case func + (,, (with_template [<tag>] + [{<tag> env body} + (|> body + (reduced (list.partial func param env)) + (applied params'))] + + [.#UnivQ] + [.#ExQ])) + + {.#Apply A F} + (applied (list.partial A params) F) + + {.#Named name unnamed} + (applied params unnamed) + + _ + {.#None})))) + +(`` (def .public (code type) + (-> Type Code) + (case type + {.#Primitive name params} + (` {.#Primitive (, (code.text name)) + (.list (,* (list#each code params)))}) + + (,, (with_template [<tag>] + [{<tag> idx} + (` {<tag> (, (code.nat idx))})] + + [.#Var] + [.#Ex] + [.#Parameter])) + + (,, (with_template [<tag>] + [{<tag> left right} + (` {<tag> (, (code left)) + (, (code right))})] + + [.#Sum] + [.#Product] + [.#Function] + [.#Apply])) + + {.#Named name sub_type} + (code.symbol name) + + (,, (with_template [<tag>] + [{<tag> env body} + (` {<tag> (.list (,* (list#each code env))) + (, (code body))})] + + [.#UnivQ] + [.#ExQ])) + ))) (def .public (de_aliased type) (-> Type Type) @@ -338,22 +361,26 @@ [ex_q .#ExQ] ) -(def .public (quantified? type) - (-> Type Bit) - (case type - {.#Named [module name] _type} - (quantified? _type) +(`` (def .public (quantified? type) + (-> Type Bit) + (case type + {.#Named [module name] _type} + (quantified? _type) - {.#Apply A F} - (|> (..applied (list A) F) - (at maybe.monad each quantified?) - (maybe.else #0)) - - (^.or {.#UnivQ _} {.#ExQ _}) - #1 + {.#Apply A F} + (|> (..applied (list A) F) + (at maybe.monad each quantified?) + (maybe.else #0)) - _ - #0)) + (,, (with_template [<pattern>] + [<pattern> + #1] + + [{.#UnivQ _}] + [{.#ExQ _}])) + + _ + #0))) (def .public (array depth element_type) (-> Nat Type Type) @@ -366,14 +393,16 @@ (def .public (flat_array type) (-> Type [Nat Type]) - (case type - (^.multi {.#Primitive name (list element_type)} - (text#= array.type_name name)) - (.let [[depth element_type] (flat_array element_type)] - [(++ depth) element_type]) + (with_expansions [<default> [0 type]] + (case type + {.#Primitive name (list element_type)} + (if (text#= array.type_name name) + (.let [[depth element_type] (flat_array element_type)] + [(++ depth) element_type]) + <default>) - _ - [0 type])) + _ + <default>))) (def .public array? (-> Type Bit) @@ -476,34 +505,40 @@ ... The value of this expression will never be relevant, so it doesn't matter what it is. (.as .Nothing []))))))))) -(def .public (replaced before after) - (-> Type Type Type Type) - (.function (again it) - (if (at ..equivalence = before it) - after - (case it - {.#Primitive name co_variant} - {.#Primitive name (list#each again co_variant)} - - (^.with_template [<tag>] - [{<tag> left right} - {<tag> (again left) (again right)}]) - ([.#Sum] - [.#Product] - [.#Function] - [.#Apply]) - - (^.with_template [<tag>] - [{<tag> env body} - {<tag> (list#each again env) (again body)}]) - ([.#UnivQ] - [.#ExQ]) - - (^.or {.#Parameter _} - {.#Var _} - {.#Ex _} - {.#Named _}) - it)))) +(`` (def .public (replaced before after) + (-> Type Type Type Type) + (.function (again it) + (if (at ..equivalence = before it) + after + (case it + {.#Primitive name co_variant} + {.#Primitive name (list#each again co_variant)} + + (,, (with_template [<tag>] + [{<tag> left right} + {<tag> (again left) (again right)}] + + [.#Sum] + [.#Product] + [.#Function] + [.#Apply])) + + (,, (with_template [<tag>] + [{<tag> env body} + {<tag> (list#each again env) (again body)}] + + [.#UnivQ] + [.#ExQ])) + + (,, (with_template [<pattern>] + [<pattern> + it] + + [{.#Parameter _}] + [{.#Var _}] + [{.#Ex _}] + [{.#Named _}])) + ))))) (def .public let (syntax (_ [bindings (<code>.tuple (<>.some (<>.and <code>.any <code>.any))) diff --git a/stdlib/source/library/lux/meta/type/primitive.lux b/stdlib/source/library/lux/meta/type/primitive.lux index c1ead54eb..40bcdba68 100644 --- a/stdlib/source/library/lux/meta/type/primitive.lux +++ b/stdlib/source/library/lux/meta/type/primitive.lux @@ -15,7 +15,6 @@ ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] ["[0]" macro (.only) - ["^" pattern] ["[0]" context] [syntax (.only syntax) ["|[0]|" export]]]]]] |