diff options
Diffstat (limited to 'stdlib/source/library')
| -rw-r--r-- | stdlib/source/library/lux/control/function/polymorphism/type.lux | 72 | ||||
| -rw-r--r-- | stdlib/source/library/lux/meta/type/poly.lux | 11 |
2 files changed, 79 insertions, 4 deletions
diff --git a/stdlib/source/library/lux/control/function/polymorphism/type.lux b/stdlib/source/library/lux/control/function/polymorphism/type.lux new file mode 100644 index 000000000..1159bc488 --- /dev/null +++ b/stdlib/source/library/lux/control/function/polymorphism/type.lux @@ -0,0 +1,72 @@ +(.require + [library + [lux (.except def) + [abstract + [monad (.only do)]] + [control + ["?" parser (.use "[1]#[0]" monad)]] + [data + ["[0]" text (.use "[1]#[0]" equivalence)] + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + ["[0]" meta (.only) + ["[0]" code (.only) + ["?[1]" \\parser (.only Parser)]] + [macro (.only with_symbols) + ["[0]" context] + [syntax (.only syntax) + ["[0]" export]]] + [type + [implicit (.only a/an)]]]]]) + +(type Polymorphism + (Record + [#name Text + #interface Code + #method Code])) + +(context.def [stack expression declaration] Polymorphism) + +(.def .public def + (syntax (_ [[export_policy name parameters type methods] + (export.parser + (all ?.and + ?code.local + (?code.tuple (?.many ?code.local)) + ?code.any + (?.many ?code.any)))]) + (<| (with_symbols [g!_ g!interface g!method g!inputs]) + (..declaration [#name name #interface g!interface #method g!method]) + (let [name (code.local name) + parameters (list#each code.local parameters)]) + (` (these (type (, export_policy) (, g!interface) + (Interface + (is (All ((, g!_) (,* parameters)) + (, type)) + (, g!method)))) + (.def (, export_policy) (, name) + (syntax ((, g!_) [(, g!inputs) (?.many ?code.any)]) + (at meta.monad (,' in) + (list (` (a/an (, g!method) ((,' .,*) (, g!inputs)))))))) + (,* methods)))))) + +(.def method_declaration + (Parser [Text (List Code)]) + (?.either (?code.form (?.and ?code.local (?.some ?code.any))) + (?.and ?code.local (?#in (list))))) + +(.def .public method + (syntax (_ [[[name inputs] specialization body] + (all ?.and + ..method_declaration + (?code.tuple (?.many ?code.any)) + ?code.any)]) + (do meta.monad + [it (context.search (|>> (the #name) (text#= name)) ..stack) + .let [name (code.local name)]] + (with_symbols [g!self] + (in (list (` (.def .public (, g!self) + ((, (the #interface it)) (,* specialization)) + (implementation + (.def ((, (the #method it)) (,* inputs)) + (, body))))))))))) diff --git a/stdlib/source/library/lux/meta/type/poly.lux b/stdlib/source/library/lux/meta/type/poly.lux index cccc9e518..a98fd211c 100644 --- a/stdlib/source/library/lux/meta/type/poly.lux +++ b/stdlib/source/library/lux/meta/type/poly.lux @@ -39,7 +39,7 @@ (, body))) (.as .Type (, g!type)))) {.#Right (, g!output)} - ((,' in) (.list (, g!output))) + (at ///.monad (,' in) (.list (, g!output))) {.#Left (, g!output)} (///.failure (, g!output)))))))))))) @@ -54,7 +54,8 @@ (^.with_template [<tag>] [{<tag> idx} (` {<tag> (, (code.nat idx))})]) - ([.#Var] [.#Ex]) + ([.#Var] + [.#Ex]) {.#Parameter idx} (let [idx (<//>.argument env idx)] @@ -72,7 +73,8 @@ [{<tag> left right} (` {<tag> (, (code env left)) (, (code env right))})]) - ([.#Function] [.#Apply]) + ([.#Function] + [.#Apply]) (^.with_template [<macro> <tag> <flattener>] [{<tag> left right} @@ -87,4 +89,5 @@ [{<tag> scope body} (` {<tag> (.list (,* (list#each (code env) scope))) (, (code env body))})]) - ([.#UnivQ] [.#ExQ]))) + ([.#UnivQ] + [.#ExQ]))) |