aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/control/concurrency/async.lux2
-rw-r--r--stdlib/source/library/lux/control/concurrency/atom.lux2
-rw-r--r--stdlib/source/library/lux/control/concurrency/behavioral.lux50
-rw-r--r--stdlib/source/library/lux/control/concurrency/stm.lux2
-rw-r--r--stdlib/source/library/lux/control/function/polymorphism/type.lux16
-rw-r--r--stdlib/source/library/lux/control/thread.lux2
-rw-r--r--stdlib/source/test/lux/control.lux4
-rw-r--r--stdlib/source/test/lux/control/concurrency/behavioral.lux85
-rw-r--r--stdlib/source/test/lux/control/function/contract.lux16
9 files changed, 168 insertions, 11 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux
index 6a4f582de..75bec2d4b 100644
--- a/stdlib/source/library/lux/control/concurrency/async.lux
+++ b/stdlib/source/library/lux/control/concurrency/async.lux
@@ -30,7 +30,7 @@
(template (_ a)
[(-> a (IO Any))]))
-(primitive .public (Async'' a)
+(primitive (Async'' a)
(Atom [(Value a) (List (Handler a))])
(type .public (Async' r w)
diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux
index 2a7fec64c..f6229b7f0 100644
--- a/stdlib/source/library/lux/control/concurrency/atom.lux
+++ b/stdlib/source/library/lux/control/concurrency/atom.lux
@@ -27,7 +27,7 @@
@.jvm <jvm>
(these)))
-(primitive .public (Atom'' a)
+(primitive (Atom'' a)
(with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)]
(for @.old <jvm>
@.jvm <jvm>
diff --git a/stdlib/source/library/lux/control/concurrency/behavioral.lux b/stdlib/source/library/lux/control/concurrency/behavioral.lux
new file mode 100644
index 000000000..1865558aa
--- /dev/null
+++ b/stdlib/source/library/lux/control/concurrency/behavioral.lux
@@ -0,0 +1,50 @@
+(.require
+ [library
+ [lux (.except)]]
+ [//
+ ["[0]" async (.only Async) (.use "[1]#[0]" monad)]
+ ["[0]" frp (.only Channel)]])
+
+(def <Event>
+ (template (_ Constructor data)
+ [[(Constructor data) data]]))
+
+(type .public (Constructor data)
+ (-> data (<Event> Constructor data)))
+
+(type .public Event
+ (Ex (_ data)
+ (<Event> Constructor data)))
+
+(def .public (event constructor)
+ (All (_ data)
+ (-> (-> data data)
+ (Constructor data)))
+ (exec
+ [] ... This was added to avoid having auto-currying to fuse the "event" and "self" functions.
+ ... Otherwise, the "same?" comparison done later would fail.
+ (function (self data)
+ [self (constructor data)])))
+
+(def .public (event? expected it)
+ (All (_ data)
+ (-> (Constructor data) Event
+ (Maybe data)))
+ (let [[actual data] it]
+ (if (same? expected actual)
+ {.#Some (as_expected data)}
+ {.#None})))
+
+(def .public (scenario events expected initial behavior)
+ (All (_ state data)
+ (-> (Channel Event) (Constructor data) state (-> data state (Async state))
+ (Async state)))
+ (frp.mix (function (_ event state)
+ (when (event? expected event)
+ {.#Some data}
+ (behavior data state)
+
+ {.#None}
+ (async#in state)))
+ initial
+ events))
diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux
index 280c0dee8..2b6118575 100644
--- a/stdlib/source/library/lux/control/concurrency/stm.lux
+++ b/stdlib/source/library/lux/control/concurrency/stm.lux
@@ -27,7 +27,7 @@
(type (Observer a)
(-> a (IO Any)))
-(primitive .public (Var'' a)
+(primitive (Var'' a)
(Atom [a (List (Sink a))])
(type .public (Var' r w)
diff --git a/stdlib/source/library/lux/control/function/polymorphism/type.lux b/stdlib/source/library/lux/control/function/polymorphism/type.lux
index 1159bc488..ffa657330 100644
--- a/stdlib/source/library/lux/control/function/polymorphism/type.lux
+++ b/stdlib/source/library/lux/control/function/polymorphism/type.lux
@@ -6,13 +6,14 @@
[control
["?" parser (.use "[1]#[0]" monad)]]
[data
- ["[0]" text (.use "[1]#[0]" equivalence)]
+ ["[0]" text (.use "[1]#[0]" equivalence)
+ ["%" \\format]]
[collection
["[0]" list (.use "[1]#[0]" functor)]]]
["[0]" meta (.only)
["[0]" code (.only)
["?[1]" \\parser (.only Parser)]]
- [macro (.only with_symbols)
+ ["[0]" macro (.only with_symbols)
["[0]" context]
[syntax (.only syntax)
["[0]" export]]]
@@ -22,6 +23,7 @@
(type Polymorphism
(Record
[#name Text
+ #export_policy Code
#interface Code
#method Code]))
@@ -35,8 +37,12 @@
(?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])
+ (<| (do meta.monad
+ [@ meta.current_module_name
+ g!interface (macro.symbol (%.symbol [@ name]))
+ g!method (macro.symbol (%.symbol [@ name]))])
+ (with_symbols [g!_ g!inputs])
+ (..declaration [#name name #export_policy export_policy #interface g!interface #method g!method])
(let [name (code.local name)
parameters (list#each code.local parameters)])
(` (these (type (, export_policy) (, g!interface)
@@ -65,7 +71,7 @@
[it (context.search (|>> (the #name) (text#= name)) ..stack)
.let [name (code.local name)]]
(with_symbols [g!self]
- (in (list (` (.def .public (, g!self)
+ (in (list (` (.def (, (the #export_policy it)) (, g!self)
((, (the #interface it)) (,* specialization))
(implementation
(.def ((, (the #method it)) (,* inputs))
diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux
index 665db5232..dd7b6208c 100644
--- a/stdlib/source/library/lux/control/thread.lux
+++ b/stdlib/source/library/lux/control/thread.lux
@@ -20,7 +20,7 @@
(type .public (Thread ! a)
(-> ! a))
-(primitive .public (Box'' t a)
+(primitive (Box'' t a)
(Array a)
(type .public (Box' t r w)
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 18ab1d19d..a53c174d5 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -17,7 +17,8 @@
["[1]/[0]" event]
["[1]/[0]" cps]
["[1]/[0]" incremental]
- ["[1]/[0]" structured]]
+ ["[1]/[0]" structured]
+ ["[1]/[0]" behavioral]]
["[1][0]" continuation]
["[1][0]" exception]
["[1][0]" function]
@@ -52,6 +53,7 @@
/concurrency/cps.test
/concurrency/incremental.test
/concurrency/structured.test
+ /concurrency/behavioral.test
))
(def security
diff --git a/stdlib/source/test/lux/control/concurrency/behavioral.lux b/stdlib/source/test/lux/control/concurrency/behavioral.lux
new file mode 100644
index 000000000..6728ad266
--- /dev/null
+++ b/stdlib/source/test/lux/control/concurrency/behavioral.lux
@@ -0,0 +1,85 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["|" pipe]
+ ["[0]" maybe (.use "[1]#[0]" functor)]]
+ [math
+ ["[0]" random (.only Random)]
+ [number
+ ["n" nat]]]
+ [test
+ ["_" property (.only Test)]
+ ["[0]" unit]]]]
+ [\\library
+ ["[0]" / (.only)
+ [//
+ ["[0]" atom (.only Atom)]
+ ["[0]" async]
+ ["[0]" frp]]]])
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [expected random.nat
+ shift (random.only (n.> 0) random.nat)])
+ (all _.and
+ (_.coverage [/.Constructor /.event]
+ (let [left (is (/.Constructor Nat)
+ (/.event (|>>)))
+ right (is (/.Constructor Nat)
+ (/.event (|>>)))]
+ (not (same? left right))))
+ (_.coverage [/.Event /.event?]
+ (let [left (is (/.Constructor Nat)
+ (/.event (|>>)))
+ right (is (/.Constructor Nat)
+ (/.event (|>>)))]
+ (`` (and (,, (with_template [<correct> <incorrect>]
+ [(|> (<correct> expected)
+ (/.event? <correct>)
+ (maybe#each (same? expected))
+ (maybe.else false))
+ (|> (<correct> expected)
+ (/.event? <incorrect>)
+ (|.when
+ {.#None} true
+ {.#Some _} false))]
+
+ [left right]
+ [right left]
+ ))))))
+ (in (let [increase (is (/.Constructor Any)
+ (/.event (|>>)))
+ decrease (is (/.Constructor Any)
+ (/.event (|>>)))
+ counter (is (Atom Nat)
+ (atom.atom expected))
+ [events feed!] (is [(frp.Channel /.Event) (frp.Sink /.Event)]
+ (frp.channel []))
+ scenario/+ (<| (/.scenario events increase expected)
+ (function (_ _ so_far)
+ (do async.monad
+ [[old new] (async.future (atom.update! (n.+ shift) counter))]
+ (in new))))
+ scenario/- (<| (/.scenario events decrease expected)
+ (function (_ _ so_far)
+ (do async.monad
+ [[old new] (async.future (atom.update! (n.- shift) counter))]
+ (in new))))]
+ (do async.monad
+ [_ (async.future (at feed! feed (increase [])))
+ _ (async.future (at feed! feed (increase [])))
+ _ (async.future (at feed! feed (decrease [])))
+ _ (async.future (at feed! close))
+ scenario/+ scenario/+
+ scenario/- scenario/-
+ count (async.future (atom.read! counter))]
+ (unit.coverage [/.scenario]
+ (and (n.= (all n.+ shift expected) count)
+ (n.= (all n.+ shift shift expected) scenario/+)
+ (n.= (all n.+ shift expected) scenario/-))))))
+ )))
diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux
index 44666a08d..e24d6f52f 100644
--- a/stdlib/source/test/lux/control/function/contract.lux
+++ b/stdlib/source/test/lux/control/function/contract.lux
@@ -21,7 +21,8 @@
Test
(<| (_.covering /._)
(do [! random.monad]
- [expected random.nat])
+ [expected random.nat
+ error_message (random.upper_case 5)])
(all _.and
(_.coverage [/.pre /.pre_condition_failed]
(when (try (/.pre (n.even? expected)
@@ -43,4 +44,17 @@
(and (text.contains? (the exception.#label /.post_condition_failed)
error)
(not (n.odd? expected)))))
+ (_.coverage [/.assert!]
+ (and (when (try (/.assert! error_message true))
+ {try.#Success actual}
+ true
+
+ {try.#Failure error}
+ false)
+ (when (try (/.assert! error_message false))
+ {try.#Success actual}
+ false
+
+ {try.#Failure error}
+ (text.contains? error_message error))))
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 05:20:17 +0000