aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux.lux9
-rw-r--r--stdlib/source/library/lux/control/function/polymorphism/context.lux203
-rw-r--r--stdlib/source/library/lux/control/function/predicate.lux10
-rw-r--r--stdlib/source/library/lux/test/unit.lux26
4 files changed, 231 insertions, 17 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index d5c43cc7f..8a829ae10 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -3769,7 +3769,7 @@
{#None}
(failure (..wrong_syntax_error (symbol ..def))))))
-(with_template [<name> <form> <message>]
+(with_template [<name> <nullary> <form>]
[(def .public <name>
(macro (_ tokens)
(when (list#reversed tokens)
@@ -3780,10 +3780,11 @@
init)))
_
- (failure <message>))))]
+ (meta#in (list (` <nullary>))))))]
- [and (if (, pre) (, post) #0) "'and' requires >=1 clauses."]
- [or (if (, pre) #1 (, post)) "'or' requires >=1 clauses."])
+ [and #1 (if (, pre) (, post) #0)]
+ [or #0 (if (, pre) #1 (, post))]
+ )
(def (index part text)
(-> Text Text (Maybe Nat))
diff --git a/stdlib/source/library/lux/control/function/polymorphism/context.lux b/stdlib/source/library/lux/control/function/polymorphism/context.lux
new file mode 100644
index 000000000..ee47ece31
--- /dev/null
+++ b/stdlib/source/library/lux/control/function/polymorphism/context.lux
@@ -0,0 +1,203 @@
+(.require
+ [library
+ [lux (.except def with)
+ [abstract
+ [monad (.only do)]
+ ["[0]" hash]]
+ [control
+ [reader (.only Reader)]
+ ["?" parser (.use "[1]#[0]" monad)]
+ [function
+ ["[0]" predicate (.only Predicate)]]]
+ [data
+ ["[0]" product]
+ ["[0]" text (.use "[1]#[0]" equivalence)]
+ [collection
+ ["[0]" set (.only Set)]
+ ["[0]" list (.use "[1]#[0]" functor)]]]
+ ["[0]" meta (.only)
+ ["[0]" symbol]
+ ["[0]" static]
+ ["[0]" code (.only)
+ ["?[1]" \\parser (.only Parser)]]
+ ["[0]" macro (.only with_symbols)
+ ["[0]" context]
+ [syntax (.only syntax)
+ ["[0]" export]]]
+ [type
+ [primitive (.except #name)]]]]]
+ [///
+ ["//" mixin]])
+
+(.def .public (altered alteration scope)
+ (All (_ context value)
+ (-> (-> context context) (Reader context value)
+ (Reader context value)))
+ (function (_ context)
+ (scope (alteration context))))
+
+(with_expansions [<representation> Symbol]
+ (primitive .public Layer
+ <representation>
+
+ (.def .public layer
+ (syntax (_ [[export_policy name] (export.parser ?code.local)])
+ (do meta.monad
+ [@ meta.current_module_name]
+ (in (list (` (.def (, export_policy) (, (code.local name))
+ Layer
+ (<| (as Layer)
+ (is <representation>)
+ [(, (code.text @))
+ (, (code.text name))]))))))))
+
+ (type .public Context
+ (Set Layer))
+
+ (.def .public empty
+ Context
+ (set.empty (at hash.functor each (|>> representation) symbol.hash)))
+ ))
+
+(with_template [<name> <change>]
+ [(.def .public (<name> layer scope)
+ (All (_ value)
+ (-> Layer (Reader Context value)
+ (Reader Context value)))
+ (function (_ context)
+ (scope (<change> layer context))))]
+
+ [with set.has]
+ [without set.lacks]
+ )
+
+(.def .public (active? layer)
+ (All (_ value)
+ (-> Layer (Predicate Context)))
+ (function (_ context)
+ (set.member? context layer)))
+
+(.def .public inactive?
+ (All (_ value)
+ (-> Layer (Predicate Context)))
+ (|>> active? predicate.complement))
+
+(type Polymorphism
+ (Record
+ [#function Text
+ #quantifications (List Code)
+ #context Code
+ #inputs (List Code)
+ #output Code
+ #default Code
+ #export_policy Code
+ #scenarios (List Code)]))
+
+(context.def [stack expression declaration] Polymorphism)
+
+(type Signature
+ (Record
+ [#name Text
+ #next Text
+ #parameters (List Code)]))
+
+(.def signature
+ (Parser Signature)
+ (?code.form
+ (all ?.and
+ ?code.local
+ ?code.local
+ (?.many ?code.any))))
+
+(.def (quoted it)
+ (-> Code Code)
+ (` ((,' .,') (, it))))
+
+(.def .public def
+ (syntax (_ [[export_policy signature] (export.parser ..signature)
+ quantifications (?code.tuple (?.some ?code.any))
+ context ?code.any
+ inputs (?code.tuple (?.many ?code.any))
+ output ?code.any
+ default ?code.any
+ methods (?.some ?code.any)])
+ (<| (with_symbols [g!self g!_ g!scenarios g!scenario g!mixin])
+ (..declaration [#function (the #name signature)
+ #quantifications quantifications
+ #context context
+ #inputs inputs
+ #output output
+ #default default
+ #export_policy export_policy
+ #scenarios (list)])
+ (let [name (quoted (code.local (the #name signature)))
+ next (quoted (code.local (the #next signature)))
+ parameters (list#each quoted (the #parameters signature))
+ [@ _] (symbol .._)
+
+ g!self (quoted g!self)])
+ (` (these (,* methods)
+
+ (static.expansion
+ (do meta.monad
+ [[(, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!scenarios)]
+ (context.search' (|>> product.left
+ (at text.equivalence (,' =) (, (code.text (the #name signature)))))
+ [("lux in-module" (, (code.text @)) ..stack)
+ (symbol ..stack)])]
+ (at meta.monad (,' in)
+ (list (` (.def (, export_policy) (, name)
+ (, (quoted (` (<| (,* quantifications)
+ (-> (,* inputs) (Reader (, context) (, output)))))))
+ (let [(, (quoted g!mixin)) (is (, (quoted (` (<| (,* quantifications)
+ (-> [(,* inputs)] (Reader (, context) (, output)))))))
+ (//.fixed (all //.mixed
+ ((,' .,*) (, g!scenarios))
+ (is (, (quoted (` (<| (,* quantifications)
+ (//.Mixin [(,* inputs)] (Reader (, context) (, output)))))))
+ (function ((, g!self) (, next) (, name) [(,* parameters)])
+ (, (quoted default))))
+ )))]
+ (, (when (the #parameters signature)
+ (list _)
+ (quoted g!mixin)
+
+ _
+ (` (function ((, name) (,* parameters))
+ ((, (quoted g!mixin)) [(,* parameters)]))))))))))))
+ )))))
+
+(.def .public method
+ (syntax (_ [signature ..signature
+ predicate ?code.any
+ body ?code.any])
+ (do [! meta.monad]
+ [.let [criterion (is (Predicate Polymorphism)
+ (|>> (the #function)
+ (text#= (the #name signature))))]
+ it (context.search criterion ..stack)]
+ (with_symbols [g!self g!predicate g!parameters g!context g!_ g!next g!again]
+ (do !
+ [_ (context.revised {.#Some criterion}
+ (revised #scenarios (|>> {.#Item (` (let [(, g!predicate) (is (<| (,* (the #quantifications it))
+ (Predicate (, (the #context it))))
+ (, predicate))]
+ (is (<| (,* (the #quantifications it))
+ (//.Mixin [(,* (the #inputs it))]
+ (Reader (, (the #context it))
+ (, (the #output it)))))
+ (function ((, g!_) (, g!next) (, g!again) (, g!parameters) (, g!context))
+ (if ((, g!predicate) (, g!context))
+ ((, g!self) (, g!next) (, g!again) (, g!parameters) (, g!context))
+ ((, g!next) (, g!parameters) (, g!context)))))))}))
+ ..stack)]
+ (in (list (` (.def (, (the #export_policy it)) (, g!self)
+ (<| (,* (the #quantifications it))
+ (//.Mixin [(,* (the #inputs it))]
+ (Reader (, (the #context it))
+ (, (the #output it)))))
+ (function ((, g!self)
+ (, (code.local (the #next signature)))
+ (, (code.local (the #name signature)))
+ [(,* (the #parameters signature))])
+ (, body)))))))))))
diff --git a/stdlib/source/library/lux/control/function/predicate.lux b/stdlib/source/library/lux/control/function/predicate.lux
index 131a6520f..80703dbb6 100644
--- a/stdlib/source/library/lux/control/function/predicate.lux
+++ b/stdlib/source/library/lux/control/function/predicate.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except all or and)
+ [lux (.except all or and not)
[abstract
[monoid (.only Monoid)]
[functor
@@ -38,13 +38,17 @@
(def .public (complement predicate)
(All (_ a) (-> (Predicate a) (Predicate a)))
- (|>> predicate not))
+ (|>> predicate .not))
+
+(def .public not
+ (All (_ a) (-> (Predicate a) (Predicate a)))
+ ..complement)
(def .public (difference sub base)
(All (_ a) (-> (Predicate a) (Predicate a) (Predicate a)))
(function (_ value)
(.and (base value)
- (not (sub value)))))
+ (.not (sub value)))))
(def .public (rec predicate)
(All (_ a)
diff --git a/stdlib/source/library/lux/test/unit.lux b/stdlib/source/library/lux/test/unit.lux
index 62e075537..14b09f014 100644
--- a/stdlib/source/library/lux/test/unit.lux
+++ b/stdlib/source/library/lux/test/unit.lux
@@ -1,6 +1,7 @@
(.require
[library
[lux (.except and for)
+ ["[0]" debug]
[abstract
[monad (.only do)]]
[control
@@ -92,7 +93,7 @@
(%.Format Symbol)
(|>> %.symbol (format ..clean_up_marker)))
-(def .public (with_coverage coverage condition)
+(def (with_coverage coverage condition)
(-> (List Symbol) Bit Test)
(let [message (|> coverage
(list#each ..coverage_format)
@@ -109,11 +110,12 @@
(let [coverage (list#each (function (_ definition)
(` (coverage.of (, definition))))
coverage)]
- (in (list (` (..with_coverage (is (.List .Symbol)
- (.list (,* coverage)))
- (, condition))))))))
+ (in (list (` ((debug.private ..with_coverage)
+ (is (.List .Symbol)
+ (.list (,* coverage)))
+ (, condition))))))))
-(def .public (for' coverage test)
+(def (for' coverage test)
(-> (List Symbol) Test Test)
(let [context (|> coverage
(list#each ..coverage_format)
@@ -130,11 +132,12 @@
(let [coverage (list#each (function (_ definition)
(` (coverage.of (, definition))))
coverage)]
- (in (list (` (..for' (is (.List .Symbol)
- (.list (,* coverage)))
- (, test))))))))
+ (in (list (` ((debug.private ..for')
+ (is (.List .Symbol)
+ (.list (,* coverage)))
+ (, test))))))))
-(def .public (covering' module coverage test)
+(def (covering' module coverage test)
(-> Text Text Test Test)
(let [coverage (coverage.decoded module coverage)]
(|> (..context' module test)
@@ -157,4 +160,7 @@
aggregate))
{.#End})
coverage.encoded)]]
- (in (list (` (..covering' (, (code.text module)) (, (code.text coverage)) (, test))))))))
+ (in (list (` ((debug.private ..covering')
+ (, (code.text module))
+ (, (code.text coverage))
+ (, test))))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 05:56:46 +0000