aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/control/function/named.lux76
-rw-r--r--stdlib/source/library/lux/meta/macro/context.lux40
-rw-r--r--stdlib/source/library/lux/meta/static.lux7
-rw-r--r--stdlib/source/library/lux/meta/type/primitive.lux2
-rw-r--r--stdlib/source/library/lux/world/time/instant.lux10
-rw-r--r--stdlib/source/test/lux/control/function.lux4
-rw-r--r--stdlib/source/test/lux/control/function/named.lux73
-rw-r--r--stdlib/source/test/lux/meta/macro.lux4
-rw-r--r--stdlib/source/test/lux/meta/macro/context.lux103
9 files changed, 297 insertions, 22 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
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 <code>.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 <code>.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 [<top> (static.random_nat)]
+ (<| static.expansion
+ (declaration <top>)
+ (` (def (,' declaration!) true))))
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (all _.and
+ (_.coverage [/.def]
+ (and declaration!
+ (with_expansions [<top> (static.random_nat)]
+ (<| static.expansion
+ (do meta.monad
+ [it (expression <top> (` true))]
+ (in (list it)))))))
+ (_.coverage [/.peek /.peek'
+ /.push /.push']
+ (with_expansions [<expected> (static.random_nat)]
+ (n.= <expected>
+ (<| static.expansion
+ (do meta.monad
+ [_ (/.push <expected> ..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 [<dummy> (static.random_nat)
+ <expected> (static.nat (++ <dummy>))]
+ (n.= <expected>
+ (<| static.expansion
+ (do meta.monad
+ [_ (/.push <dummy> ..stack)
+ _ (/.pop ..stack)
+ _ (/.push <expected> ..stack)
+ actual (/.peek ..stack)
+ _ (/.pop ..stack)]
+ (in (list (code.nat actual))))))))
+ (_.coverage [/.search /.search']
+ (with_expansions [<expected> (static.random_nat)]
+ (n.= <expected>
+ (<| static.expansion
+ (do meta.monad
+ [_ (/.push <expected> ..stack)
+ actual (/.search (n.= <expected>) ..stack)
+ _ (/.pop ..stack)]
+ (in (list (code.nat actual))))))))
+ (_.coverage [/.no_example]
+ (with_expansions [<expected> (static.random_nat)]
+ (<| (text.contains? (the exception.#label /.no_example))
+ macro_error
+ static.expansion
+ (do meta.monad
+ [_ (/.push <expected> ..stack)
+ actual (/.search (|>> (n.= <expected>) not) ..stack)
+ _ (/.pop ..stack)]
+ (in (list (code.nat actual)))))))
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 23:25:59 +0000