From a0517211a4e107f013995cd10e9693acad6885a9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 19 Aug 2022 01:14:18 -0400 Subject: Added functions with named parameters. --- .../source/library/lux/control/function/named.lux | 76 +++++++++++++++ stdlib/source/library/lux/meta/macro/context.lux | 40 ++++---- stdlib/source/library/lux/meta/static.lux | 7 ++ stdlib/source/library/lux/meta/type/primitive.lux | 2 +- stdlib/source/library/lux/world/time/instant.lux | 10 +- stdlib/source/test/lux/control/function.lux | 4 +- stdlib/source/test/lux/control/function/named.lux | 73 +++++++++++++++ stdlib/source/test/lux/meta/macro.lux | 4 +- stdlib/source/test/lux/meta/macro/context.lux | 103 +++++++++++++++++++++ 9 files changed, 297 insertions(+), 22 deletions(-) create mode 100644 stdlib/source/library/lux/control/function/named.lux create mode 100644 stdlib/source/test/lux/control/function/named.lux create mode 100644 stdlib/source/test/lux/meta/macro/context.lux (limited to 'stdlib') diff --git a/stdlib/source/library/lux/control/function/named.lux b/stdlib/source/library/lux/control/function/named.lux new file mode 100644 index 000000000..eeade0ed5 --- /dev/null +++ b/stdlib/source/library/lux/control/function/named.lux @@ -0,0 +1,76 @@ +... https://en.wikipedia.org/wiki/Named_parameter +(.require + [library + [lux (.except def) + [abstract + ["[0]" monad (.only do)]] + [control + ["?" parser] + ["[0]" maybe] + ["[0]" exception (.only Exception)]] + [data + ["[0]" text (.only) + ["%" \\format]] + [collection + ["[0]" list (.use "[1]#[0]" monad)] + ["[0]" set] + ["[0]" dictionary]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" code (.only) + ["?[1]" \\parser]] + [macro (.only with_symbols) + [syntax (.only syntax) + ["[0]" export]]]]]]) + +(exception.def .public (duplicate_parameters [definition parameters]) + (Exception [Symbol (List Text)]) + (exception.report + (list ["Definition" (%.symbol definition)] + ["Parameters" (%.list %.text parameters)]))) + +(exception.def .public (invalid_parameters [definition expected actual]) + (Exception [Symbol (List Text) (List Text)]) + (exception.report + (list ["Definition" (%.symbol definition)] + ["Expected" (%.list %.text expected)] + ["Actual" (%.list %.text actual)]))) + +(.def .public def + (syntax (_ [[exported? [name parameters] type body] + (export.parser (all ?.and + (?code.form (?.and ?code.local (?.some ?code.local))) + ?code.any + ?code.any))]) + (do meta.monad + [here meta.current_module_name] + (if (n.= (list.size parameters) + (set.size (set.of_list text.hash parameters))) + (with_symbols [g!function g!parameters g!_ g!it] + (with_expansions [ (meta.failure (exception.error ..invalid_parameters [(symbol (, (code.symbol [here name]))) + (list (,* (list#each code.text parameters))) + (dictionary.keys (, g!parameters))]))] + (in (list (` (.def (, exported?) ((, g!function) (,* (list#each code.local parameters))) + (, type) + (, body))) + (` (.def (, exported?) (, (code.local name)) + (syntax ((, (code.local name)) [(, g!parameters) (?.some (?.and ?code.local ?code.any))]) + (let [(, g!parameters) (dictionary.of_list text.hash (, g!parameters))] + (when (dictionary.size (, g!parameters)) + (, (code.nat (list.size parameters))) + (when (monad.each maybe.monad + (function ((, g!_) (, g!it)) + (dictionary.value (, g!it) (, g!parameters))) + (list (,* (list#each code.text parameters)))) + {.#Some (, g!parameters)} + (at meta.monad (,' in) + (list (` ((, g!function) ((,' .,*) (, g!parameters)))))) + + {.#None} + ) + + (, g!_) + ))))))))) + (meta.failure (exception.error ..duplicate_parameters [[here name] parameters])))))) diff --git a/stdlib/source/library/lux/meta/macro/context.lux b/stdlib/source/library/lux/meta/macro/context.lux index dc2911506..9db9ef978 100644 --- a/stdlib/source/library/lux/meta/macro/context.lux +++ b/stdlib/source/library/lux/meta/macro/context.lux @@ -24,7 +24,7 @@ (type .public Stack List) -(exception.def .public (no_definition it) +(exception.def (no_definition it) (Exception Symbol) (exception.report (list ["Definition" (symbol#encoded it)]))) @@ -66,8 +66,8 @@ (exception.def .public no_example) -(.def .public (search' _ ? context) - (All (_ a) (-> (Stack a) (Predicate a) Symbol (Meta a))) +(.def .public (search' ? _ context) + (All (_ a) (-> (Predicate a) (Stack a) Symbol (Meta a))) (do meta.monad [stack (..global context)] (when (|> stack @@ -80,9 +80,9 @@ (meta.failure (exception.error ..no_example []))))) (.def .public search - (syntax (_ [g!context (at ?.monad each code.symbol ?code.global) - g!? ?code.any]) - (in (list (` (..search' (, g!context) (, g!?) (.symbol (, g!context)))))))) + (syntax (_ [g!? ?code.any + g!context (at ?.monad each code.symbol ?code.global)]) + (in (list (` (..search' (, g!?) (, g!context) (.symbol (, g!context)))))))) (.def (alter on_definition [@ context]) (-> (-> Definition Definition) Symbol (Meta Any)) @@ -102,8 +102,8 @@ {.#Right [(revised .#modules (property.revised @ on_module) lux) []]}))) -(.def .public (push' _ top) - (All (_ a) (-> (Stack a) a Symbol (Meta Any))) +(.def .public (push' top _) + (All (_ a) (-> a (Stack a) Symbol (Meta Any))) (alter (function (_ [exported? type stack]) (|> stack (as (Stack Any)) @@ -112,25 +112,29 @@ [exported? type])))) (.def .public push - (syntax (_ [g!context (at ?.monad each code.symbol ?code.global) - g!it ?code.any]) - (in (list (` (..push' (, g!context) (, g!it) (.symbol (, g!context)))))))) + (syntax (_ [g!it ?code.any + g!context (at ?.monad each code.symbol ?code.global)]) + (in (list (` (..push' (, g!it) (, g!context) (.symbol (, g!context)))))))) -(.def pop' +(.def .public pop'' (-> Symbol (Meta Any)) (alter (function (_ [exported? type value]) [exported? type (let [value (as (Stack Any) value)] (maybe.else value (list.tail value)))]))) -(.def .public pop +(.def .public pop' (syntax (_ [expression? ?code.bit context ?code.global]) (do meta.monad - [_ (..pop' context)] + [_ (..pop'' context)] (in (if expression? (list (' [])) (list)))))) +(.def .public pop + (syntax (_ [g!context (at ?.monad each code.symbol ?code.global)]) + (in (list (` (..pop'' (.symbol (, g!context)))))))) + (.def .public def (syntax (_ [.let [! ?.monad ?local (at ! each code.local ?code.local)] @@ -146,14 +150,14 @@ (` (.def ((, g!expression) (, g!it) (, g!body)) (-> (, context_type) Code (Meta Code)) (do meta.monad - [(, g!_) (..push (, g!context) (, g!it))] + [(, g!_) (..push (, g!it) (, g!context))] ((,' in) (` (let [((,' ,') (, g!body)) ((,' ,) (, g!body)) - ((,' ,') (, g!_)) (..pop #1 (, g!context))] + ((,' ,') (, g!_)) (..pop' #1 (, g!context))] ((,' ,') (, g!body)))))))) (` (.def ((, g!declaration) (, g!it) (, g!body)) (-> (, context_type) Code (Meta (List Code))) (do meta.monad - [(, g!_) (..push (, g!context) (, g!it))] + [(, g!_) (..push (, g!it) (, g!context))] ((,' in) (list (, g!body) - (` (..pop #0 (, g!context)))))))) + (` (..pop' #0 (, g!context)))))))) )))))) diff --git a/stdlib/source/library/lux/meta/static.lux b/stdlib/source/library/lux/meta/static.lux index 9a8d25cfe..3b2fd8065 100644 --- a/stdlib/source/library/lux/meta/static.lux +++ b/stdlib/source/library/lux/meta/static.lux @@ -48,6 +48,13 @@ .let [[format expression] (as pair)]] (in (list (format expression))))))) +(with_expansions [ (Meta (List Code))] + (def .public expansion + (syntax (_ [expression .any]) + (do meta.monad + [expression (meta.eval (.type_literal ) expression)] + (as expression))))) + (with_expansions [ (Ex (_ a) [(-> a Code) (List a)])] diff --git a/stdlib/source/library/lux/meta/type/primitive.lux b/stdlib/source/library/lux/meta/type/primitive.lux index 8c6b0a98e..5f7269bca 100644 --- a/stdlib/source/library/lux/meta/type/primitive.lux +++ b/stdlib/source/library/lux/meta/type/primitive.lux @@ -35,7 +35,7 @@ (.def .public (specific name) (-> Text (Meta Frame)) - (context.search ..frames (|>> (the #name) (text#= name)))) + (context.search (|>> (the #name) (text#= name)) ..frames)) (def cast (Parser [(Maybe Text) Code]) diff --git a/stdlib/source/library/lux/world/time/instant.lux b/stdlib/source/library/lux/world/time/instant.lux index 55bb1eae8..db4d3ffa6 100644 --- a/stdlib/source/library/lux/world/time/instant.lux +++ b/stdlib/source/library/lux/world/time/instant.lux @@ -6,7 +6,8 @@ [order (.only Order)] [enum (.only Enum)] [codec (.only Codec)] - [monad (.only Monad do)]] + [monad (.only Monad do)] + [hash (.only Hash)]] [control [io (.only IO io)] ["<>" parser (.only)] @@ -70,6 +71,13 @@ (def (< param subject) (at i.order < (representation param) (representation subject))))) + (def .public hash + (Hash Instant) + (implementation + (def equivalence ..equivalence) + (def hash + (|>> representation (at i.hash hash))))) + (`` (def .public enum (Enum Instant) (implementation diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index b3e79f47d..a2ac4a355 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -21,7 +21,8 @@ ["[1][0]" mutual] ["[1][0]" inline] ["[1][0]" predicate] - ["[1][0]" variadic]]) + ["[1][0]" variadic] + ["[1][0]" named]]) (def .public test Test @@ -69,4 +70,5 @@ /inline.test /predicate.test /variadic.test + /named.test )))) diff --git a/stdlib/source/test/lux/control/function/named.lux b/stdlib/source/test/lux/control/function/named.lux new file mode 100644 index 000000000..064e2e8ab --- /dev/null +++ b/stdlib/source/test/lux/control/function/named.lux @@ -0,0 +1,73 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" text]] + [math + ["[0]" random] + [number + ["n" nat]]] + [meta + ["[0]" code (.only) + ["<[1]>" \\parser]] + [macro + [syntax (.only syntax)] + ["[0]" expansion]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def macro_error + (syntax (_ [macro .any]) + (function (_ compiler) + (when ((expansion.complete macro) compiler) + {try.#Failure error} + {try.#Success [compiler (list (code.text error))]} + + {try.#Success _} + {try.#Failure "OOPS!"})))) + +(/.def (+ left right) + (-> Nat Nat Nat) + (n.+ left right)) + +(def .public test + Test + (do [! random.monad] + [p0 random.nat + p1 random.nat] + (<| (_.covering /._) + (all _.and + (_.coverage [/.def] + (n.= (n.+ p0 p1) + (+ left p0 + right p1))) + (_.coverage [/.duplicate_parameters] + (text.contains? (the exception.#label /.duplicate_parameters) + (macro_error + (/.def .public (- _ _) + (-> Nat (List Nat) Nat) + (undefined))))) + (_.coverage [/.invalid_parameters] + (and (text.contains? (the exception.#label /.invalid_parameters) + (macro_error + (+ left p0))) + (text.contains? (the exception.#label /.invalid_parameters) + (macro_error + (+ right p1))) + (text.contains? (the exception.#label /.invalid_parameters) + (macro_error + (+ left p0 + right p1 + yolo p0))) + (text.contains? (the exception.#label /.invalid_parameters) + (macro_error + (+ left p0 + yolo p0))))) + )))) diff --git a/stdlib/source/test/lux/meta/macro.lux b/stdlib/source/test/lux/meta/macro.lux index b2b7e0eda..270040d6d 100644 --- a/stdlib/source/test/lux/meta/macro.lux +++ b/stdlib/source/test/lux/meta/macro.lux @@ -30,6 +30,7 @@ ["[0]" template] ["[0]" expansion]]] ["[0]" / + ["[1][0]" context] ["[1][0]" local] ["[1][0]" syntax] ["[1][0]" template] @@ -247,7 +248,8 @@ )) ..test|expansion - + + /context.test /local.test /syntax.test /template.test diff --git a/stdlib/source/test/lux/meta/macro/context.lux b/stdlib/source/test/lux/meta/macro/context.lux new file mode 100644 index 000000000..cbcdf60e0 --- /dev/null +++ b/stdlib/source/test/lux/meta/macro/context.lux @@ -0,0 +1,103 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" text (.only) + ["%" \\format]]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" static] + ["[0]" code (.only) + ["<[1]>" \\parser]] + [macro + [syntax (.only syntax)] + ["[0]" expansion]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def macro_error + (syntax (_ [macro .any]) + (function (_ compiler) + (when ((expansion.complete macro) compiler) + {try.#Failure error} + {try.#Success [compiler (list (code.text error))]} + + {try.#Success _} + {try.#Failure "OOPS!"})))) + +(/.def [stack expression declaration] Nat) + +(with_expansions [ (static.random_nat)] + (<| static.expansion + (declaration ) + (` (def (,' declaration!) true)))) + +(def .public test + Test + (<| (_.covering /._) + (all _.and + (_.coverage [/.def] + (and declaration! + (with_expansions [ (static.random_nat)] + (<| static.expansion + (do meta.monad + [it (expression (` true))] + (in (list it))))))) + (_.coverage [/.peek /.peek' + /.push /.push'] + (with_expansions [ (static.random_nat)] + (n.= + (<| static.expansion + (do meta.monad + [_ (/.push ..stack) + actual (/.peek ..stack) + _ (/.pop ..stack)] + (in (list (code.nat actual)))))))) + (_.coverage [/.no_active_context] + (<| (text.contains? (the exception.#label /.no_active_context)) + macro_error + static.expansion + (do meta.monad + [top (/.peek ..stack)] + (in (list (code.nat top)))))) + (_.coverage [/.pop /.pop' /.pop''] + (with_expansions [ (static.random_nat) + (static.nat (++ ))] + (n.= + (<| static.expansion + (do meta.monad + [_ (/.push ..stack) + _ (/.pop ..stack) + _ (/.push ..stack) + actual (/.peek ..stack) + _ (/.pop ..stack)] + (in (list (code.nat actual)))))))) + (_.coverage [/.search /.search'] + (with_expansions [ (static.random_nat)] + (n.= + (<| static.expansion + (do meta.monad + [_ (/.push ..stack) + actual (/.search (n.= ) ..stack) + _ (/.pop ..stack)] + (in (list (code.nat actual)))))))) + (_.coverage [/.no_example] + (with_expansions [ (static.random_nat)] + (<| (text.contains? (the exception.#label /.no_example)) + macro_error + static.expansion + (do meta.monad + [_ (/.push ..stack) + actual (/.search (|>> (n.= ) not) ..stack) + _ (/.pop ..stack)] + (in (list (code.nat actual))))))) + ))) -- cgit v1.2.3