From 3f010de748ffccf304c4be09863f77d4020d610d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 25 Aug 2022 21:31:54 -0400 Subject: Added support for type-based polymorphism. --- .../lux/control/function/polymorphism/type.lux | 72 ++++++++++++++++++++++ stdlib/source/library/lux/meta/type/poly.lux | 11 ++-- stdlib/source/test/lux/control/function.lux | 5 +- .../lux/control/function/polymorphism/type.lux | 41 ++++++++++++ stdlib/source/test/lux/meta/type.lux | 4 +- stdlib/source/test/lux/meta/type/poly.lux | 48 +++++++++++++++ 6 files changed, 175 insertions(+), 6 deletions(-) create mode 100644 stdlib/source/library/lux/control/function/polymorphism/type.lux create mode 100644 stdlib/source/test/lux/control/function/polymorphism/type.lux create mode 100644 stdlib/source/test/lux/meta/type/poly.lux (limited to 'stdlib/source') 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 [] [{ idx} (` { (, (code.nat idx))})]) - ([.#Var] [.#Ex]) + ([.#Var] + [.#Ex]) {.#Parameter idx} (let [idx (.argument env idx)] @@ -72,7 +73,8 @@ [{ left right} (` { (, (code env left)) (, (code env right))})]) - ([.#Function] [.#Apply]) + ([.#Function] + [.#Apply]) (^.with_template [ ] [{ left right} @@ -87,4 +89,5 @@ [{ scope body} (` { (.list (,* (list#each (code env) scope))) (, (code env body))})]) - ([.#UnivQ] [.#ExQ]))) + ([.#UnivQ] + [.#ExQ]))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index aad5f2ebf..d87f6f3cd 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -23,7 +23,9 @@ ["[1][0]" predicate] ["[1][0]" variadic] ["[1][0]" named] - ["[1][0]" trampoline]]) + ["[1][0]" trampoline] + ["[1][0]" polymorphism + ["[1]/[0]" type]]]) (def .public test Test @@ -73,4 +75,5 @@ /variadic.test /named.test /trampoline.test + /polymorphism/type.test )))) diff --git a/stdlib/source/test/lux/control/function/polymorphism/type.lux b/stdlib/source/test/lux/control/function/polymorphism/type.lux new file mode 100644 index 000000000..a5ed74cca --- /dev/null +++ b/stdlib/source/test/lux/control/function/polymorphism/type.lux @@ -0,0 +1,41 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [data + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format]]] + [math + ["[0]" random]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(/.def .public format + [a] + (-> a Text) + + (/.method format + [Bit] + %.bit) + + (/.method (format it) + [Nat] + (%.nat it)) + ) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [bit random.bit + nat random.nat]) + (all _.and + (_.coverage [/.def /.method] + (and (text#= (%.bit bit) + (format bit)) + (text#= (%.nat nat) + (format nat)))) + ))) diff --git a/stdlib/source/test/lux/meta/type.lux b/stdlib/source/test/lux/meta/type.lux index 3c6872d26..67119dd60 100644 --- a/stdlib/source/test/lux/meta/type.lux +++ b/stdlib/source/test/lux/meta/type.lux @@ -41,7 +41,8 @@ ["[1][0]" refinement] ["[1][0]" resource] ["[1][0]" unit] - ["[1][0]" variance]]) + ["[1][0]" variance] + ["[1][0]" poly]]) (def !expect (template (_ ) @@ -570,4 +571,5 @@ /resource.test /unit.test /variance.test + /poly.test ))) diff --git a/stdlib/source/test/lux/meta/type/poly.lux b/stdlib/source/test/lux/meta/type/poly.lux new file mode 100644 index 000000000..e2aa7d03e --- /dev/null +++ b/stdlib/source/test/lux/meta/type/poly.lux @@ -0,0 +1,48 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["?" parser]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)]] + [math + ["[0]" random] + [number + ["[0]" nat (.use "[1]#[0]" equivalence)]]] + [meta + ["[0]" static] + ["[0]" type + ["?[1]" \\parser]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(with_expansions [ (static.random_bit) + (static.random_nat)] + (def constant + (/.polytypic constant + (`` (all ?.either + (,, (with_template [ ] + [(do ?.monad + [_ (?type.sub )] + (in (` (is + ))))] + + [Bit ] + [Nat ])) + )))) + + (def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (all _.and + (_.coverage [/.polytypic] + (and (bit#= (constant Bit)) + (nat#= (constant Nat)))) + ))) + ) -- cgit v1.2.3