From 36303d6cb2ce3ab9e36d045b9516c997bd461862 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 24 Aug 2021 05:23:45 -0400 Subject: Outsourced the syntax for labelled type definitions to macros. --- .../specification/compositor/generation/case.lux | 6 +++--- .../specification/compositor/generation/common.lux | 6 +++--- .../compositor/generation/function.lux | 10 +++++----- .../compositor/generation/reference.lux | 2 +- .../compositor/generation/structure.lux | 8 ++++---- stdlib/source/specification/lux/abstract/apply.lux | 10 +++++----- .../source/specification/lux/abstract/comonad.lux | 20 ++++++++++---------- .../source/specification/lux/abstract/functor.lux | 18 +++++++++--------- .../lux/abstract/functor/contravariant.lux | 2 +- stdlib/source/specification/lux/abstract/monad.lux | 20 ++++++++++---------- .../source/specification/lux/abstract/monoid.lux | 8 ++++---- stdlib/source/specification/lux/world/file.lux | 22 +++++++++++----------- stdlib/source/specification/lux/world/shell.lux | 14 +++++++------- 13 files changed, 73 insertions(+), 73 deletions(-) (limited to 'stdlib/source/specification') diff --git a/stdlib/source/specification/compositor/generation/case.lux b/stdlib/source/specification/compositor/generation/case.lux index 87fc1a5fc..3bfcec4e8 100644 --- a/stdlib/source/specification/compositor/generation/case.lux +++ b/stdlib/source/specification/compositor/generation/case.lux @@ -32,7 +32,7 @@ (def: size (Random Nat) - (|> r.nat (\ r.monad map (|>> (n.% ..limit) (n.max 2))))) + (|> r.nat (\ r.monad each (|>> (n.% ..limit) (n.max 2))))) (def: (tail? size idx) (-> Nat Nat Bit) @@ -66,7 +66,7 @@ [(r.unicode 5) synthesis.text synthesis.path/text])) (do {! r.monad} [size ..size - idx (|> r.nat (\ ! map (n.% size))) + idx (|> r.nat (\ ! each (n.% size))) [subS subP] case .let [unitS (synthesis.text synthesis.unit) caseS (synthesis.tuple @@ -81,7 +81,7 @@ (in [caseS caseP])) (do {! r.monad} [size ..size - idx (|> r.nat (\ ! map (n.% size))) + idx (|> r.nat (\ ! each (n.% size))) [subS subP] case .let [right? (tail? size idx) caseS (synthesis.variant diff --git a/stdlib/source/specification/compositor/generation/common.lux b/stdlib/source/specification/compositor/generation/common.lux index 6387b3013..729ce81f4 100644 --- a/stdlib/source/specification/compositor/generation/common.lux +++ b/stdlib/source/specification/compositor/generation/common.lux @@ -118,7 +118,7 @@ (def: simple_frac (Random Frac) - (|> r.nat (\ r.monad map (|>> (n.% 1000) .int i.frac)))) + (|> r.nat (\ r.monad each (|>> (n.% 1000) .int i.frac)))) (def: (f64 run) (-> Runner Test) @@ -175,12 +175,12 @@ (def: (text run) (-> Runner Test) (do {! r.monad} - [sample_size (|> r.nat (\ ! map (|>> (n.% 10) (n.max 1)))) + [sample_size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 1)))) sample_lower (r.ascii/lower_alpha sample_size) sample_upper (r.ascii/upper_alpha sample_size) sample_alpha (|> (r.ascii/alpha sample_size) (r.only (|>> (text\= sample_upper) not))) - char_idx (|> r.nat (\ ! map (n.% sample_size))) + char_idx (|> r.nat (\ ! each (n.% sample_size))) .let [sample_lowerS (synthesis.text sample_lower) sample_upperS (synthesis.text sample_upper) sample_alphaS (synthesis.text sample_alpha) diff --git a/stdlib/source/specification/compositor/generation/function.lux b/stdlib/source/specification/compositor/generation/function.lux index 8a090094f..36b45c283 100644 --- a/stdlib/source/specification/compositor/generation/function.lux +++ b/stdlib/source/specification/compositor/generation/function.lux @@ -30,11 +30,11 @@ (def: arity (Random Arity) - (|> r.nat (r\map (|>> (n.% max_arity) (n.max 1))))) + (|> r.nat (r\each (|>> (n.% max_arity) (n.max 1))))) (def: (local arity) (-> Arity (Random Register)) - (|> r.nat (r\map (|>> (n.% arity) ++)))) + (|> r.nat (r\each (|>> (n.% arity) ++)))) (def: function (Random [Arity Register Synthesis]) @@ -51,10 +51,10 @@ (-> Runner Test) (do {! r.monad} [[arity local functionS] ..function - partial_arity (|> r.nat (\ ! map (|>> (n.% arity) (n.max 1)))) + partial_arity (|> r.nat (\ ! each (|>> (n.% arity) (n.max 1)))) inputs (r.list arity r.safe_frac) .let [expectation (maybe.trusted (list.item (-- local) inputs)) - inputsS (list\map (|>> synthesis.f64) inputs)]] + inputsS (list\each (|>> synthesis.f64) inputs)]] ($_ _.and (_.test "Can read arguments." (|> (synthesis.function/apply {#synthesis.function functionS @@ -75,7 +75,7 @@ (or (n.= 1 arity) (let [environment (|> partial_arity (enum.range n.enum 1) - (list\map (|>> #reference.Local))) + (list\each (|>> #reference.Local))) variableS (if (n.<= partial_arity local) (synthesis.variable/foreign (-- local)) (synthesis.variable/local (|> local (n.- partial_arity)))) diff --git a/stdlib/source/specification/compositor/generation/reference.lux b/stdlib/source/specification/compositor/generation/reference.lux index 02338e915..ee9da7455 100644 --- a/stdlib/source/specification/compositor/generation/reference.lux +++ b/stdlib/source/specification/compositor/generation/reference.lux @@ -40,7 +40,7 @@ (def: (variable run) (-> Runner Test) (do {! r.monad} - [register (|> r.nat (\ ! map (n.% 100))) + [register (|> r.nat (\ ! each (n.% 100))) expected r.safe_frac] (_.test "Local variables." (|> (synthesis.branch/let [(synthesis.f64 expected) diff --git a/stdlib/source/specification/compositor/generation/structure.lux b/stdlib/source/specification/compositor/generation/structure.lux index de61ed882..ec9893e7c 100644 --- a/stdlib/source/specification/compositor/generation/structure.lux +++ b/stdlib/source/specification/compositor/generation/structure.lux @@ -31,8 +31,8 @@ (def: (variant run) (-> Runner Test) (do {! r.monad} - [num_tags (|> r.nat (\ ! map (|>> (n.% 10) (n.max 2)))) - tag_in (|> r.nat (\ ! map (n.% num_tags))) + [num_tags (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) + tag_in (|> r.nat (\ ! each (n.% num_tags))) .let [last?_in (|> num_tags -- (n.= tag_in))] value_in r.i64] (_.test (%.name (name_of synthesis.variant)) @@ -66,10 +66,10 @@ (def: (tuple run) (-> Runner Test) (do {! r.monad} - [size (|> r.nat (\ ! map (|>> (n.% 10) (n.max 2)))) + [size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) tuple_in (r.list size r.i64)] (_.test (%.name (name_of synthesis.tuple)) - (|> (synthesis.tuple (list\map (|>> synthesis.i64) tuple_in)) + (|> (synthesis.tuple (list\each (|>> synthesis.i64) tuple_in)) (run "tuple") (case> (#try.Success tuple_out) (let [tuple_out (:as (Array Any) tuple_out)] diff --git a/stdlib/source/specification/lux/abstract/apply.lux b/stdlib/source/specification/lux/abstract/apply.lux index e857c81e5..1e2c7b676 100644 --- a/stdlib/source/specification/lux/abstract/apply.lux +++ b/stdlib/source/specification/lux/abstract/apply.lux @@ -18,7 +18,7 @@ (def: (identity injection comparison (^open "\.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} - [sample (\ ! map injection random.nat)] + [sample (\ ! each injection random.nat)] (_.test "Identity." ((comparison n.=) (\on sample (injection function.identity)) @@ -28,7 +28,7 @@ (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat - increase (\ ! map n.+ random.nat)] + increase (\ ! each n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) (\on (injection sample) (injection increase)) @@ -38,7 +38,7 @@ (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat - increase (\ ! map n.+ random.nat)] + increase (\ ! each n.+ random.nat)] (_.test "Interchange." ((comparison n.=) (\on (injection sample) (injection increase)) @@ -49,8 +49,8 @@ (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat - increase (\ ! map n.+ random.nat) - decrease (\ ! map n.- random.nat)] + increase (\ ! each n.+ random.nat) + decrease (\ ! each n.- random.nat)] (_.test "Composition." ((comparison n.=) (|> (injection function.composite) diff --git a/stdlib/source/specification/lux/abstract/comonad.lux b/stdlib/source/specification/lux/abstract/comonad.lux index b1fca7ab7..785cc06fd 100644 --- a/stdlib/source/specification/lux/abstract/comonad.lux +++ b/stdlib/source/specification/lux/abstract/comonad.lux @@ -17,13 +17,13 @@ (All [f] (-> (Injection f) (CoMonad f) Test)) (do {! random.monad} [sample random.nat - morphism (\ ! map (function (_ diff) - (|>> _//out (n.+ diff))) + morphism (\ ! each (function (_ diff) + (|>> _//out (n.+ diff))) random.nat) .let [start (injection sample)]] (_.test "Left identity." (n.= (morphism start) - (|> start _//split (_//map morphism) _//out))))) + (|> start _//disjoint (_//each morphism) _//out))))) (def: (right_identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) @@ -33,23 +33,23 @@ == (comparison n.=)]] (_.test "Right identity." (== start - (|> start _//split (_//map _//out)))))) + (|> start _//disjoint (_//each _//out)))))) (def: (associativity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) (do {! random.monad} [sample random.nat - increase (\ ! map (function (_ diff) - (|>> _//out (n.+ diff))) + increase (\ ! each (function (_ diff) + (|>> _//out (n.+ diff))) random.nat) - decrease (\ ! map (function (_ diff) - (|>> _//out(n.- diff))) + decrease (\ ! each (function (_ diff) + (|>> _//out(n.- diff))) random.nat) .let [start (injection sample) == (comparison n.=)]] (_.test "Associativity." - (== (|> start _//split (_//map (|>> _//split (_//map increase) decrease))) - (|> start _//split (_//map increase) _//split (_//map decrease)))))) + (== (|> start _//disjoint (_//each (|>> _//disjoint (_//each increase) decrease))) + (|> start _//disjoint (_//each increase) _//disjoint (_//each decrease)))))) (def: .public (spec injection comparison subject) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) diff --git a/stdlib/source/specification/lux/abstract/functor.lux b/stdlib/source/specification/lux/abstract/functor.lux index d60555ae0..33c6506c5 100644 --- a/stdlib/source/specification/lux/abstract/functor.lux +++ b/stdlib/source/specification/lux/abstract/functor.lux @@ -25,32 +25,32 @@ (def: (identity injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} - [sample (\ ! map injection random.nat)] + [sample (\ ! each injection random.nat)] (_.test "Identity." ((comparison n.=) - (@//map function.identity sample) + (@//each function.identity sample) sample)))) (def: (homomorphism injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} [sample random.nat - increase (\ ! map n.+ random.nat)] + increase (\ ! each n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) - (@//map increase (injection sample)) + (@//each increase (injection sample)) (injection (increase sample)))))) (def: (composition injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} - [sample (\ ! map injection random.nat) - increase (\ ! map n.+ random.nat) - decrease (\ ! map n.- random.nat)] + [sample (\ ! each injection random.nat) + increase (\ ! each n.+ random.nat) + decrease (\ ! each n.- random.nat)] (_.test "Composition." ((comparison n.=) - (|> sample (@//map increase) (@//map decrease)) - (|> sample (@//map (|>> increase decrease))))))) + (|> sample (@//each increase) (@//each decrease)) + (|> sample (@//each (|>> increase decrease))))))) (def: .public (spec injection comparison functor) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) diff --git a/stdlib/source/specification/lux/abstract/functor/contravariant.lux b/stdlib/source/specification/lux/abstract/functor/contravariant.lux index 719398e71..9e50001c5 100644 --- a/stdlib/source/specification/lux/abstract/functor/contravariant.lux +++ b/stdlib/source/specification/lux/abstract/functor/contravariant.lux @@ -18,7 +18,7 @@ (All [f a] (-> (Equivalence (f a)) (f a) (Functor f) Test)) (_.test "Law of identity." (equivalence - (@//map function.identity value) + (@//each function.identity value) value))) (def: .public (spec equivalence value functor) diff --git a/stdlib/source/specification/lux/abstract/monad.lux b/stdlib/source/specification/lux/abstract/monad.lux index 01395330f..2e538db50 100644 --- a/stdlib/source/specification/lux/abstract/monad.lux +++ b/stdlib/source/specification/lux/abstract/monad.lux @@ -15,12 +15,12 @@ (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) (do {! random.monad} [sample random.nat - morphism (\ ! map (function (_ diff) - (|>> (n.+ diff) _//in)) + morphism (\ ! each (function (_ diff) + (|>> (n.+ diff) _//in)) random.nat)] (_.test "Left identity." ((comparison n.=) - (|> (injection sample) (_//map morphism) _//join) + (|> (injection sample) (_//each morphism) _//conjoint) (morphism sample))))) (def: (right_identity injection comparison (^open "_//.")) @@ -29,23 +29,23 @@ [sample random.nat] (_.test "Right identity." ((comparison n.=) - (|> (injection sample) (_//map _//in) _//join) + (|> (injection sample) (_//each _//in) _//conjoint) (injection sample))))) (def: (associativity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) (do {! random.monad} [sample random.nat - increase (\ ! map (function (_ diff) - (|>> (n.+ diff) _//in)) + increase (\ ! each (function (_ diff) + (|>> (n.+ diff) _//in)) random.nat) - decrease (\ ! map (function (_ diff) - (|>> (n.- diff) _//in)) + decrease (\ ! each (function (_ diff) + (|>> (n.- diff) _//in)) random.nat)] (_.test "Associativity." ((comparison n.=) - (|> (injection sample) (_//map increase) _//join (_//map decrease) _//join) - (|> (injection sample) (_//map (|>> increase (_//map decrease) _//join)) _//join))))) + (|> (injection sample) (_//each increase) _//conjoint (_//each decrease) _//conjoint) + (|> (injection sample) (_//each (|>> increase (_//each decrease) _//conjoint)) _//conjoint))))) (def: .public (spec injection comparison monad) (All [f] (-> (Injection f) (Comparison f) (/.Monad f) Test)) diff --git a/stdlib/source/specification/lux/abstract/monoid.lux b/stdlib/source/specification/lux/abstract/monoid.lux index c8e4e4e6e..a9ce67fd2 100644 --- a/stdlib/source/specification/lux/abstract/monoid.lux +++ b/stdlib/source/specification/lux/abstract/monoid.lux @@ -22,11 +22,11 @@ ($_ _.and (_.test "Left identity." (\= sample - (\compose \identity sample))) + (\composite \identity sample))) (_.test "Right identity." (\= sample - (\compose sample \identity))) + (\composite sample \identity))) (_.test "Associativity." - (\= (\compose left (\compose mid right)) - (\compose (\compose left mid) right))) + (\= (\composite left (\composite mid right)) + (\composite (\composite left mid) right))) )))) diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux index 504990ea4..8a618c3ae 100644 --- a/stdlib/source/specification/lux/world/file.lux +++ b/stdlib/source/specification/lux/world/file.lux @@ -48,7 +48,7 @@ (_.cover' [/.parent] (|> (/.rooted fs parent child) (/.parent fs) - (maybe\map (text\= parent)) + (maybe\each (text\= parent)) (maybe.else false))) (_.cover' [/.name] (|> (/.rooted fs parent child) @@ -91,18 +91,18 @@ (in (<| (try.else false) (do {! try.monad} [pre_file_size! - (\ ! map (n.= expected_file_size) pre_file_size) + (\ ! each (n.= expected_file_size) pre_file_size) pre_content! - (\ ! map (binary\= content) pre_content) + (\ ! each (binary\= content) pre_content) _ appended? post_file_size! - (\ ! map (n.= (n.* 2 expected_file_size)) post_file_size) + (\ ! each (n.= (n.* 2 expected_file_size)) post_file_size) post_content! - (\ ! map (binary\= (binary\compose content appendix)) post_content)] + (\ ! each (binary\= (binary\composite content appendix)) post_content)] (in (and pre_file_size! pre_content! post_file_size! @@ -116,7 +116,7 @@ (in (<| (try.else false) (do {! try.monad} [_ modified?] - (\ ! map (instant\= expected_time) last_modified)))))) + (\ ! each (instant\= expected_time) last_modified)))))) (def: (directory_files&sub_directories fs parent sub_dir child) (-> (/.System Async) /.Path /.Path /.Path (Async Bit)) @@ -131,10 +131,10 @@ (do try.monad [_ made_sub?] (in (and (|> directory_files - (try\map (list\= (list child))) + (try\each (list\= (list child))) (try.else false)) (|> sub_directories - (try\map (list\= (list sub_dir))) + (try\each (list\= (list sub_dir))) (try.else false)))))))))) (def: (move&delete fs parent child alternate_child) @@ -145,7 +145,7 @@ [moved? (\ fs move destination origin) lost? (|> origin (\ fs file?) - (\ ! map not)) + (\ ! each not)) found? (\ fs file? destination) deleted? (\ fs delete destination)] (in (<| (try.else false) @@ -166,7 +166,7 @@ (|>> (text\= child) not) (|>> (text\= sub_dir) not)) (random.ascii/numeric 2)) - expected_file_size (\ ! map (|>> (n.% 10) ++) random.nat) + expected_file_size (\ ! each (|>> (n.% 10) ++) random.nat) content ($binary.random expected_file_size) appendix ($binary.random expected_file_size) expected_time random.instant]) @@ -190,7 +190,7 @@ can_execute? (|> path (\ fs can_execute?) - (\ ! map (|>> (try.else true) not))) + (\ ! each (|>> (try.else true) not))) directory_files&sub_directories (..directory_files&sub_directories fs parent sub_dir child) diff --git a/stdlib/source/specification/lux/world/shell.lux b/stdlib/source/specification/lux/world/shell.lux index 6817d14be..cedfd317b 100644 --- a/stdlib/source/specification/lux/world/shell.lux +++ b/stdlib/source/specification/lux/world/shell.lux @@ -36,16 +36,16 @@ (def: (can_wait! process) (-> (/.Process Async) _.Assertion) (|> (\ process await []) - (async\map (|>> (try\map (i.= /.normal)) - (try.else false) - (_.cover' [/.Exit /.normal]))) - async\join)) + (async\each (|>> (try\each (i.= /.normal)) + (try.else false) + (_.cover' [/.Exit /.normal]))) + async\conjoint)) (def: (can_read! expected process) (-> Text (/.Process Async) (Async Bit)) (|> (\ process read []) - (async\map (|>> (try\map (text\= expected)) - (try.else false))))) + (async\each (|>> (try\each (text\= expected)) + (try.else false))))) (def: (can_destroy! process) (-> (/.Process Async) (Async Bit)) @@ -71,7 +71,7 @@ (<| (_.for [/.Shell /.Process]) (do {! random.monad} [message (random.ascii/alpha 10) - seconds (\ ! map (|>> (n.% 5) (n.+ 5)) random.nat)] + seconds (\ ! each (|>> (n.% 5) (n.+ 5)) random.nat)] (in (do {! async.monad} [?echo (\ shell execute (..echo! message)) ?sleep (\ shell execute (..sleep! seconds))] -- cgit v1.2.3