diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux/control/function/named.lux | 76 | ||||
-rw-r--r-- | stdlib/source/library/lux/meta/macro/context.lux | 40 | ||||
-rw-r--r-- | stdlib/source/library/lux/meta/static.lux | 7 | ||||
-rw-r--r-- | stdlib/source/library/lux/meta/type/primitive.lux | 2 | ||||
-rw-r--r-- | stdlib/source/library/lux/world/time/instant.lux | 10 |
5 files changed, 115 insertions, 20 deletions
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 [<invalid_parameters> (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} + <invalid_parameters>) + + (, g!_) + <invalid_parameters>))))))))) + (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 <type> pair)]] (in (list (format expression))))))) +(with_expansions [<type> (Meta (List Code))] + (def .public expansion + (syntax (_ [expression <code>.any]) + (do meta.monad + [expression (meta.eval (.type_literal <type>) expression)] + (as <type> expression))))) + (with_expansions [<type> (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 |