From 94e5802f594a73245fce0fbd885103b8bf210d57 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 2 Dec 2022 19:33:00 -0400 Subject: Added some simple time-series handling machinery. --- stdlib/source/specification/aedifex/repository.lux | 10 +-- stdlib/source/specification/compositor/common.lux | 4 +- .../specification/compositor/generation/case.lux | 8 +-- .../specification/compositor/generation/common.lux | 6 +- .../compositor/generation/function.lux | 2 +- .../compositor/generation/reference.lux | 2 +- .../compositor/generation/structure.lux | 6 +- stdlib/source/specification/lux/abstract/apply.lux | 4 +- .../source/specification/lux/abstract/comonad.lux | 6 +- .../source/specification/lux/abstract/functor.lux | 4 +- stdlib/source/specification/lux/abstract/monad.lux | 6 +- stdlib/source/specification/lux/world/console.lux | 10 +-- .../source/specification/lux/world/environment.lux | 4 +- stdlib/source/specification/lux/world/file.lux | 82 +++++++++++----------- stdlib/source/specification/lux/world/shell.lux | 14 ++-- 15 files changed, 84 insertions(+), 84 deletions(-) (limited to 'stdlib/source/specification') diff --git a/stdlib/source/specification/aedifex/repository.lux b/stdlib/source/specification/aedifex/repository.lux index 3d8b90459..52a7e1bfe 100644 --- a/stdlib/source/specification/aedifex/repository.lux +++ b/stdlib/source/specification/aedifex/repository.lux @@ -32,17 +32,17 @@ (in (all unit.and (do async.monad [.let [good_uri (/remote.uri (the //artifact.#version valid_artifact) valid_artifact //artifact/extension.lux_library)] - good_upload! (at subject upload good_uri expected) - good_download! (at subject download good_uri) + good_upload! (of subject upload good_uri expected) + good_download! (of subject download good_uri) .let [bad_uri (/remote.uri (the //artifact.#version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] - bad_upload! (at subject upload bad_uri expected) - bad_download! (at subject download bad_uri)] + bad_upload! (of subject upload bad_uri expected) + bad_download! (of subject download bad_uri)] (unit.coverage [/.Repository] (let [successfull_flow! (when [good_upload! good_download!] [{try.#Success _} {try.#Success actual}] - (at binary.equivalence = expected actual) + (of binary.equivalence = expected actual) _ false) diff --git a/stdlib/source/specification/compositor/common.lux b/stdlib/source/specification/compositor/common.lux index 9b3f398f4..6045d8db1 100644 --- a/stdlib/source/specification/compositor/common.lux +++ b/stdlib/source/specification/compositor/common.lux @@ -40,7 +40,7 @@ (do phase.monad [_ runtime] (phase expressionS)))] - (at host evaluate! evaluation_name expressionG)))) + (of host evaluate! evaluation_name expressionG)))) (def (definer (open "[0]") state) (Instancer Definer) @@ -54,7 +54,7 @@ [host_name host_value host_declaration] (translation.define! lux_name expressionG) _ (translation.learn lux_name host_name)] (phase (synthesis.constant lux_name))))] - (at host evaluate! "definer" definitionG)))) + (of host evaluate! "definer" definitionG)))) (def .public (executors target expander platform analysis_bundle translation_bundle declaration_bundle diff --git a/stdlib/source/specification/compositor/generation/case.lux b/stdlib/source/specification/compositor/generation/case.lux index 8043bd2e0..5b36db339 100644 --- a/stdlib/source/specification/compositor/generation/case.lux +++ b/stdlib/source/specification/compositor/generation/case.lux @@ -34,7 +34,7 @@ (def size (Random Nat) - (|> r.nat (at r.monad each (|>> (n.% ..limit) (n.max 2))))) + (|> r.nat (of r.monad each (|>> (n.% ..limit) (n.max 2))))) (def (tail? size idx) (-> Nat Nat Bit) @@ -69,7 +69,7 @@ [(r.unicode 5) synthesis.text synthesis.path/text])) (do [! r.monad] [size ..size - idx (|> r.nat (at ! each (n.% size))) + idx (|> r.nat (of ! each (n.% size))) [subS subP] when .let [unitS (synthesis.text synthesis.unit) whenS (synthesis.tuple @@ -84,7 +84,7 @@ (in [whenS whenP])) (do [! r.monad] [size ..size - idx (|> r.nat (at ! each (n.% size))) + idx (|> r.nat (of ! each (n.% size))) [subS subP] when .let [right? (tail? size idx) whenS (synthesis.variant @@ -248,7 +248,7 @@ (_.test "===" (and (text#= (synthesis.%path special_path) (synthesis.%path special_pattern_path)) - (at synthesis.path_equivalence = special_path special_pattern_path))) + (of synthesis.path_equivalence = special_path special_pattern_path))) (_.test "CODE" (|> special_input (run "special_input") diff --git a/stdlib/source/specification/compositor/generation/common.lux b/stdlib/source/specification/compositor/generation/common.lux index a0d202a2e..acb782c1f 100644 --- a/stdlib/source/specification/compositor/generation/common.lux +++ b/stdlib/source/specification/compositor/generation/common.lux @@ -126,7 +126,7 @@ (def simple_frac (Random Frac) - (|> r.nat (at r.monad each (|>> (n.% 1000) .int i.frac)))) + (|> r.nat (of r.monad each (|>> (n.% 1000) .int i.frac)))) (def (f64 run) (-> Runner Test) @@ -174,12 +174,12 @@ (def (text run) (-> Runner Test) (do [! r.monad] - [sample_size (|> r.nat (at ! each (|>> (n.% 10) (n.max 1)))) + [sample_size (|> r.nat (of ! each (|>> (n.% 10) (n.max 1)))) sample_lower (r.lower_case_alpha sample_size) sample_upper (r.upper_case_alpha sample_size) sample_alpha (|> (r.alphabetic sample_size) (r.only (|>> (text#= sample_upper) not))) - char_idx (|> r.nat (at ! each (n.% sample_size))) + char_idx (|> r.nat (of ! 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 92d0bdaa2..63b025065 100644 --- a/stdlib/source/specification/compositor/generation/function.lux +++ b/stdlib/source/specification/compositor/generation/function.lux @@ -52,7 +52,7 @@ (-> Runner Test) (do [! r.monad] [[arity local functionS] ..function - partial_arity (|> r.nat (at ! each (|>> (n.% arity) (n.max 1)))) + partial_arity (|> r.nat (of ! each (|>> (n.% arity) (n.max 1)))) inputs (r.list arity r.safe_frac) .let [expectation (maybe.trusted (list.item (-- local) inputs)) inputsS (list#each (|>> synthesis.f64) inputs)]] diff --git a/stdlib/source/specification/compositor/generation/reference.lux b/stdlib/source/specification/compositor/generation/reference.lux index ce0d00d1a..74c556d80 100644 --- a/stdlib/source/specification/compositor/generation/reference.lux +++ b/stdlib/source/specification/compositor/generation/reference.lux @@ -43,7 +43,7 @@ (def (variable run) (-> Runner Test) (do [! r.monad] - [register (|> r.nat (at ! each (n.% 100))) + [register (|> r.nat (of ! 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 acf9888e8..b28648520 100644 --- a/stdlib/source/specification/compositor/generation/structure.lux +++ b/stdlib/source/specification/compositor/generation/structure.lux @@ -33,8 +33,8 @@ (def (variant run) (-> Runner Test) (do [! r.monad] - [num_tags (|> r.nat (at ! each (|>> (n.% 10) (n.max 2)))) - tag_in (|> r.nat (at ! each (n.% num_tags))) + [num_tags (|> r.nat (of ! each (|>> (n.% 10) (n.max 2)))) + tag_in (|> r.nat (of ! each (n.% num_tags))) .let [last?_in (|> num_tags -- (n.= tag_in))] value_in r.i64] (_.test (%.symbol (symbol synthesis.variant)) @@ -69,7 +69,7 @@ (def (tuple run) (-> Runner Test) (do [! r.monad] - [size (|> r.nat (at ! each (|>> (n.% 10) (n.max 2)))) + [size (|> r.nat (of ! each (|>> (n.% 10) (n.max 2)))) tuple_in (r.list size r.i64)] (_.test (%.symbol (symbol synthesis.tuple)) (|> (synthesis.tuple (list#each (|>> synthesis.i64) tuple_in)) diff --git a/stdlib/source/specification/lux/abstract/apply.lux b/stdlib/source/specification/lux/abstract/apply.lux index eaf4d741c..1b9c0c941 100644 --- a/stdlib/source/specification/lux/abstract/apply.lux +++ b/stdlib/source/specification/lux/abstract/apply.lux @@ -25,9 +25,9 @@ (do [! random.monad] [sample random.nat increase (is (Random :$/1:) - (at ! each n.+ random.nat)) + (of ! each n.+ random.nat)) decrease (is (Random :$/1:) - (at ! each n.- random.nat))]) + (of ! each n.- random.nat))]) (all _.and (_.for [/.functor] (functorS.spec injection comparison (the /.functor it))) diff --git a/stdlib/source/specification/lux/abstract/comonad.lux b/stdlib/source/specification/lux/abstract/comonad.lux index 9763f136b..536970182 100644 --- a/stdlib/source/specification/lux/abstract/comonad.lux +++ b/stdlib/source/specification/lux/abstract/comonad.lux @@ -20,13 +20,13 @@ (do [! random.monad] [.let [(open "/#[0]") it] sample random.nat - increase (at ! each (function (_ diff) + increase (of ! each (function (_ diff) (|>> /#out (n.+ diff))) random.nat) - decrease (at ! each (function (_ diff) + decrease (of ! each (function (_ diff) (|>> /#out (n.- diff))) random.nat) - morphism (at ! each (function (_ diff) + morphism (of ! each (function (_ diff) (|>> /#out (n.+ diff))) random.nat) .let [start (injection sample) diff --git a/stdlib/source/specification/lux/abstract/functor.lux b/stdlib/source/specification/lux/abstract/functor.lux index d0f8327d5..c64be9401 100644 --- a/stdlib/source/specification/lux/abstract/functor.lux +++ b/stdlib/source/specification/lux/abstract/functor.lux @@ -31,8 +31,8 @@ Test)) (<| (do [! random.monad] [sample random.nat - increase (at ! each n.+ random.nat) - decrease (at ! each n.- random.nat)]) + increase (of ! each n.+ random.nat) + decrease (of ! each n.- random.nat)]) (_.for [/.Functor]) (_.coverage [/.each] (let [(open "/#[0]") functor diff --git a/stdlib/source/specification/lux/abstract/monad.lux b/stdlib/source/specification/lux/abstract/monad.lux index 422ce8cb8..82a7ff55b 100644 --- a/stdlib/source/specification/lux/abstract/monad.lux +++ b/stdlib/source/specification/lux/abstract/monad.lux @@ -16,7 +16,7 @@ (All (_ f) (-> (Injection f) (Comparison f) (/.Monad f) Test)) (do [! random.monad] [sample random.nat - morphism (at ! each (function (_ diff) + morphism (of ! each (function (_ diff) (|>> (n.+ diff) _//in)) random.nat)] (_.test "Left identity." @@ -37,10 +37,10 @@ (All (_ f) (-> (Injection f) (Comparison f) (/.Monad f) Test)) (do [! random.monad] [sample random.nat - increase (at ! each (function (_ diff) + increase (of ! each (function (_ diff) (|>> (n.+ diff) _//in)) random.nat) - decrease (at ! each (function (_ diff) + decrease (of ! each (function (_ diff) (|>> (n.- diff) _//in)) random.nat)] (_.test "Associativity." diff --git a/stdlib/source/specification/lux/world/console.lux b/stdlib/source/specification/lux/world/console.lux index 3fbdc42af..c941d4da7 100644 --- a/stdlib/source/specification/lux/world/console.lux +++ b/stdlib/source/specification/lux/world/console.lux @@ -25,11 +25,11 @@ [message (random.alphabetic 10)] (in (do async.monad [console (async.future console) - ?write (at console write (format message text.new_line)) - ?read (at console read []) - ?read_line (at console read_line []) - ?close/good (at console close []) - ?close/bad (at console close []) + ?write (of console write (format message text.new_line)) + ?read (of console read []) + ?read_line (of console read_line []) + ?close/good (of console close []) + ?close/bad (of console close []) .let [can_write! (when ?write diff --git a/stdlib/source/specification/lux/world/environment.lux b/stdlib/source/specification/lux/world/environment.lux index 066ad2783..1a586c554 100644 --- a/stdlib/source/specification/lux/world/environment.lux +++ b/stdlib/source/specification/lux/world/environment.lux @@ -30,5 +30,5 @@ (and (not (dictionary.empty? environment)) (list.every? (|>> text.empty? not) (dictionary.keys environment)) - (not (text.empty? (at subject home))) - (not (text.empty? (at subject directory))))))))) + (not (text.empty? (of subject home))) + (not (text.empty? (of subject directory))))))))) diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux index 648449050..59b0148ec 100644 --- a/stdlib/source/specification/lux/world/file.lux +++ b/stdlib/source/specification/lux/world/file.lux @@ -62,9 +62,9 @@ (def (directory?&make_directory fs parent) (-> (/.System Async) /.Path (Async Bit)) (do async.monad - [directory_pre! (at fs directory? parent) - made? (at fs make_directory parent) - directory_post! (at fs directory? parent)] + [directory_pre! (of fs directory? parent) + made? (of fs make_directory parent) + directory_post! (of fs directory? parent)] (in (and (not directory_pre!) (when made? {try.#Success _} true @@ -74,9 +74,9 @@ (def (file?&write fs content path) (-> (/.System Async) Binary /.Path (Async Bit)) (do async.monad - [file_pre! (at fs file? path) - made? (at fs write path content) - file_post! (at fs file? path)] + [file_pre! (of fs file? path) + made? (of fs write path content) + file_post! (of fs file? path)] (in (and (not file_pre!) (when made? {try.#Success _} true @@ -86,26 +86,26 @@ (def (file_size&read&append fs expected_file_size content appendix path) (-> (/.System Async) Nat Binary Binary /.Path (Async Bit)) (do async.monad - [pre_file_size (at fs file_size path) - pre_content (at fs read path) - appended? (at fs append path appendix) - post_file_size (at fs file_size path) - post_content (at fs read path)] + [pre_file_size (of fs file_size path) + pre_content (of fs read path) + appended? (of fs append path appendix) + post_file_size (of fs file_size path) + post_content (of fs read path)] (in (<| (try.else false) (do [! try.monad] [pre_file_size! - (at ! each (n.= expected_file_size) pre_file_size) + (of ! each (n.= expected_file_size) pre_file_size) pre_content! - (at ! each (binary#= content) pre_content) + (of ! each (binary#= content) pre_content) _ appended? post_file_size! - (at ! each (n.= (n.* 2 expected_file_size)) post_file_size) + (of ! each (n.= (n.* 2 expected_file_size)) post_file_size) post_content! - (at ! each (binary#= (binary#composite content appendix)) post_content)] + (of ! each (binary#= (binary#composite content appendix)) post_content)] (in (and pre_file_size! pre_content! post_file_size! @@ -114,21 +114,21 @@ (def (modified?&last_modified fs expected_time path) (-> (/.System Async) Instant /.Path (Async Bit)) (do async.monad - [modified? (at fs modify path expected_time) - last_modified (at fs last_modified path)] + [modified? (of fs modify path expected_time) + last_modified (of fs last_modified path)] (in (<| (try.else false) (do [! try.monad] [_ modified?] - (at ! each (instant#= expected_time) last_modified)))))) + (of ! each (instant#= expected_time) last_modified)))))) (def (directory_files&sub_directories fs parent sub_dir child) (-> (/.System Async) /.Path /.Path /.Path (Async Bit)) (let [sub_dir (/.rooted fs parent sub_dir) child (/.rooted fs parent child)] (do async.monad - [made_sub? (at fs make_directory sub_dir) - directory_files (at fs directory_files parent) - sub_directories (at fs sub_directories parent) + [made_sub? (of fs make_directory sub_dir) + directory_files (of fs directory_files parent) + sub_directories (of fs sub_directories parent) .let [(open "list#[0]") (list.equivalence text.equivalence)]] (in (<| (try.else false) (do try.monad @@ -145,12 +145,12 @@ (let [origin (/.rooted fs parent child) destination (/.rooted fs parent alternate_child)] (do [! async.monad] - [moved? (at fs move origin destination) + [moved? (of fs move origin destination) lost? (|> origin - (at fs file?) - (at ! each not)) - found? (at fs file? destination) - deleted? (at fs delete destination)] + (of fs file?) + (of ! each not)) + found? (of fs file? destination) + deleted? (of fs delete destination)] (in (<| (try.else false) (do try.monad [_ moved? @@ -169,7 +169,7 @@ (|>> (text#= child) not) (|>> (text#= sub_dir) not)) (random.numeric 2)) - expected_file_size (at ! each (|>> (n.% 10) ++) random.nat) + expected_file_size (of ! each (|>> (n.% 10) ++) random.nat) content ($binary.random expected_file_size) appendix ($binary.random expected_file_size) expected_time random.instant]) @@ -192,8 +192,8 @@ can_execute? (|> path - (at fs can_execute?) - (at ! each (|>> (try.else true) not))) + (of fs can_execute?) + (of ! each (|>> (try.else true) not))) directory_files&sub_directories (..directory_files&sub_directories fs parent sub_dir child) @@ -220,16 +220,16 @@ [fs (async.future fs) .let [dir/1 (/.rooted fs dir/0 dir/1) dir/2 (/.rooted fs dir/1 dir/2)] - pre_dir/0 (at fs directory? dir/0) - pre_dir/1 (at fs directory? dir/1) - pre_dir/2 (at fs directory? dir/2) + pre_dir/0 (of fs directory? dir/0) + pre_dir/1 (of fs directory? dir/1) + pre_dir/2 (of fs directory? dir/2) made? (/.make_directories ! fs dir/2) - post_dir/0 (at fs directory? dir/0) - post_dir/1 (at fs directory? dir/1) - post_dir/2 (at fs directory? dir/2) + post_dir/0 (of fs directory? dir/0) + post_dir/1 (of fs directory? dir/1) + post_dir/2 (of fs directory? dir/2) cannot_make_directory!/0 (/.make_directories ! fs "") - cannot_make_directory!/1 (/.make_directories ! fs (at fs separator))]) + cannot_make_directory!/1 (/.make_directories ! fs (of fs separator))]) (all unit.and (unit.coverage [/.make_directories] (and (not pre_dir/0) @@ -296,17 +296,17 @@ (do [! async.monad] [fs (async.future fs) - pre_file/0 (at fs file? file) + pre_file/0 (of fs file? file) pre_file/1 (/.exists? ! fs file) - pre_dir/0 (at fs directory? dir) + pre_dir/0 (of fs directory? dir) pre_dir/1 (/.exists? ! fs dir) made_file? (/.make_file ! fs (utf8#encoded file) file) - made_dir? (at fs make_directory dir) + made_dir? (of fs make_directory dir) - post_file/0 (at fs file? file) + post_file/0 (of fs file? file) post_file/1 (/.exists? ! fs file) - post_dir/0 (at fs directory? dir) + post_dir/0 (of fs directory? dir) post_dir/1 (/.exists? ! fs dir)]) (unit.coverage [/.exists?] (and (not pre_file/0) diff --git a/stdlib/source/specification/lux/world/shell.lux b/stdlib/source/specification/lux/world/shell.lux index d552c1bdb..eea350b90 100644 --- a/stdlib/source/specification/lux/world/shell.lux +++ b/stdlib/source/specification/lux/world/shell.lux @@ -37,7 +37,7 @@ (def (can_wait! process) (-> (/.Process Async) unit.Test) - (|> (at process await []) + (|> (of process await []) (async#each (|>> (try#each (i.= /.normal)) (try.else false) (unit.coverage [/.Exit /.normal]))) @@ -45,15 +45,15 @@ (def (can_read! expected process) (-> Text (/.Process Async) (Async Bit)) - (|> (at process read []) + (|> (of process read []) (async#each (|>> (try#each (text#= expected)) (try.else false))))) (def (can_destroy! process) (-> (/.Process Async) (Async Bit)) (do async.monad - [?destroy (at process destroy []) - ?await (at process await [])] + [?destroy (of process destroy []) + ?await (of process await [])] (in (and (when ?destroy {try.#Success _} true @@ -73,10 +73,10 @@ (<| (_.for [/.Shell /.Process]) (do [! random.monad] [message (random.alphabetic 10) - seconds (at ! each (|>> (n.% 5) (n.+ 5)) random.nat)] + seconds (of ! each (|>> (n.% 5) (n.+ 5)) random.nat)] (in (do [! async.monad] - [?echo (at shell execute (..echo! message)) - ?sleep (at shell execute (..sleep! seconds))] + [?echo (of shell execute (..echo! message)) + ?sleep (of shell execute (..sleep! seconds))] (when [?echo ?sleep] [{try.#Success echo} {try.#Success sleep}] (do ! -- cgit v1.2.3