From 065e8a4d8122d4616b570496915d2c0e2c78cd6b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 11 Aug 2022 04:15:07 -0400 Subject: Re-named the "case" macro to "when". --- stdlib/source/specification/aedifex/repository.lux | 4 +- stdlib/source/specification/compositor.lux | 6 +-- .../specification/compositor/analysis/type.lux | 2 +- .../specification/compositor/generation/case.lux | 50 +++++++++++----------- .../specification/compositor/generation/common.lux | 42 +++++++++--------- .../compositor/generation/primitive.lux | 2 +- .../compositor/generation/reference.lux | 4 +- .../compositor/generation/structure.lux | 6 +-- stdlib/source/specification/lux/abstract/codec.lux | 2 +- stdlib/source/specification/lux/world/console.lux | 6 +-- stdlib/source/specification/lux/world/file.lux | 18 ++++---- stdlib/source/specification/lux/world/shell.lux | 6 +-- 12 files changed, 74 insertions(+), 74 deletions(-) (limited to 'stdlib/source/specification') diff --git a/stdlib/source/specification/aedifex/repository.lux b/stdlib/source/specification/aedifex/repository.lux index f5f278e7c..3d8b90459 100644 --- a/stdlib/source/specification/aedifex/repository.lux +++ b/stdlib/source/specification/aedifex/repository.lux @@ -40,7 +40,7 @@ bad_download! (at subject download bad_uri)] (unit.coverage [/.Repository] (let [successfull_flow! - (case [good_upload! good_download!] + (when [good_upload! good_download!] [{try.#Success _} {try.#Success actual}] (at binary.equivalence = expected actual) @@ -48,7 +48,7 @@ false) failed_flow! - (case [bad_upload! bad_download!] + (when [bad_upload! bad_download!] [{try.#Failure _} {try.#Failure _}] true diff --git a/stdlib/source/specification/compositor.lux b/stdlib/source/specification/compositor.lux index 1caf89d56..8526daba4 100644 --- a/stdlib/source/specification/compositor.lux +++ b/stdlib/source/specification/compositor.lux @@ -27,7 +27,7 @@ ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] - ["[1][0]" case] + ["[1][0]" when] ["[1][0]" function] ["[1][0]" common]]]) @@ -38,7 +38,7 @@ (/generation/primitive.spec runner) (/generation/structure.spec runner) (/generation/reference.spec runner definer) - (/generation/case.spec runner) + (/generation/when.spec runner) (/generation/function.spec runner) (/generation/common.spec runner) )) @@ -59,7 +59,7 @@ bundle expander program))]] - (case ?state,runner,definer + (when ?state,runner,definer {try.#Success [[declaration_bundle declaration_state] runner definer]} (..test runner definer (the [declaration.#analysis declaration.#state] declaration_state) diff --git a/stdlib/source/specification/compositor/analysis/type.lux b/stdlib/source/specification/compositor/analysis/type.lux index acd970ebc..3eab3d50d 100644 --- a/stdlib/source/specification/compositor/analysis/type.lux +++ b/stdlib/source/specification/compositor/analysis/type.lux @@ -27,7 +27,7 @@ (analysis/type.with_type output_type (analysis.phase expander (` ((, (code.text extension)) (,* params)))))) (phase.result state) - (pipe.case + (pipe.when {try.#Success _} true diff --git a/stdlib/source/specification/compositor/generation/case.lux b/stdlib/source/specification/compositor/generation/case.lux index ba1168ad0..8043bd2e0 100644 --- a/stdlib/source/specification/compositor/generation/case.lux +++ b/stdlib/source/specification/compositor/generation/case.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except case) + [lux (.except when) [abstract [monad (.only do)]] [control @@ -23,7 +23,7 @@ ["[0]" synthesis (.only Path Synthesis)] ["[0]" phase ["[1]/[0]" synthesis - ["[0]" case]] + ["[0]" when]] ["[0]" extension/synthesis]]]] [test ["_" property (.only Test)]]]] @@ -42,16 +42,16 @@ (def .public (verify expected) (-> Frac (Try Any) Bit) - (|>> (pipe.case + (|>> (pipe.when {try.#Success actual} (f.= expected (as Frac actual)) {try.#Failure _} false))) -(def case +(def when (Random [Synthesis Path]) - (<| r.rec (function (_ case)) + (<| r.rec (function (_ when)) (`` (all r.either (do r.monad [value r.i64] @@ -70,33 +70,33 @@ (do [! r.monad] [size ..size idx (|> r.nat (at ! each (n.% size))) - [subS subP] case + [subS subP] when .let [unitS (synthesis.text synthesis.unit) - caseS (synthesis.tuple + whenS (synthesis.tuple (list.together (list (list.repeated idx unitS) (list subS) (list.repeated (|> size -- (n.- idx)) unitS)))) - caseP (all synthesis.path/seq + whenP (all synthesis.path/seq (if (tail? size idx) (synthesis.member/right idx) (synthesis.member/left idx)) subP)]] - (in [caseS caseP])) + (in [whenS whenP])) (do [! r.monad] [size ..size idx (|> r.nat (at ! each (n.% size))) - [subS subP] case + [subS subP] when .let [right? (tail? size idx) - caseS (synthesis.variant + whenS (synthesis.variant [analysis.#lefts idx analysis.#right? right? analysis.#value subS]) - caseP (all synthesis.path/seq + whenP (all synthesis.path/seq (if right? (synthesis.side/right idx) (synthesis.side/left idx)) subP)]] - (in [caseS caseP])) + (in [whenS whenP])) )))) (def (let_spec run) @@ -123,21 +123,21 @@ (run "if_spec") (verify (if verdict on_true on_false)))))) -(def (case_spec run) +(def (when_spec run) (-> Runner Test) (do r.monad - [[inputS pathS] ..case + [[inputS pathS] ..when on_success r.safe_frac on_failure (|> r.safe_frac (r.only (|>> (f.= on_success) not)))] - (_.test (%.symbol (symbol synthesis.branch/case)) - (|> (synthesis.branch/case + (_.test (%.symbol (symbol synthesis.branch/when)) + (|> (synthesis.branch/when [inputS (all synthesis.path/alt (all synthesis.path/seq pathS (synthesis.path/then (synthesis.f64 on_success))) (synthesis.path/then (synthesis.f64 on_failure)))]) - (run "case_spec") + (run "when_spec") (verify on_success))))) (def special_input @@ -233,7 +233,7 @@ (<| try.trusted (phase.result [extension/synthesis.bundle synthesis.init]) - (case.path phase/synthesis.phase + (when.path phase/synthesis.phase special_pattern) (analysis.bit #1)) (all synthesis.path/seq @@ -252,27 +252,27 @@ (_.test "CODE" (|> special_input (run "special_input") - (pipe.case + (pipe.when {try.#Success output} true {try.#Failure _} false))) (_.test "PATTERN_MATCHING 0" - (|> (synthesis.branch/case [special_input + (|> (synthesis.branch/when [special_input special_path]) (run "special_path") - (pipe.case + (pipe.when {try.#Success output} true {try.#Failure _} false))) (_.test "PATTERN_MATCHING 1" - (|> (synthesis.branch/case [special_input + (|> (synthesis.branch/when [special_input special_pattern_path]) (run "special_pattern_path") - (pipe.case + (pipe.when {try.#Success output} true @@ -286,5 +286,5 @@ (..special_spec run) (..let_spec run) (..if_spec run) - (..case_spec run) + (..when_spec run) )) diff --git a/stdlib/source/specification/compositor/generation/common.lux b/stdlib/source/specification/compositor/generation/common.lux index e203a6098..b0f1c2390 100644 --- a/stdlib/source/specification/compositor/generation/common.lux +++ b/stdlib/source/specification/compositor/generation/common.lux @@ -28,7 +28,7 @@ [test ["_" property (.only Test)]]]] ["[0]" // - ["[1][0]" case] + ["[1][0]" when] [// [common (.only Runner)]]]) @@ -46,7 +46,7 @@ (|> {synthesis.#Extension (list (synthesis.i64 param) (synthesis.i64 subject))} (run (..safe )) - (pipe.case + (pipe.when {try.#Success valueT} (n.= ( param subject) (as Nat valueT)) @@ -67,7 +67,7 @@ (list (synthesis.i64 subject) (synthesis.i64 param))} (run (..safe "lux i64 arithmetic-right-shift")) - (pipe.case + (pipe.when {try.#Success valueT} ("lux i64 =" (i64.arithmetic_right_shifted param subject) @@ -88,7 +88,7 @@ [(_.test (|> {synthesis.#Extension (list (synthesis.i64 subject))} (run (..safe )) - (pipe.case + (pipe.when {try.#Success valueT} ( ( subject) (as valueT)) @@ -107,7 +107,7 @@ (|> {synthesis.#Extension (list (synthesis.i64 param) (synthesis.i64 subject))} (run (..safe )) - (pipe.case + (pipe.when {try.#Success valueT} ( ( param subject) (as valueT)) @@ -139,7 +139,7 @@ (|> {synthesis.#Extension (list (synthesis.f64 param) (synthesis.f64 subject))} (run (..safe )) - (//case.verify ( param subject))))] + (//when.verify ( param subject))))] ["lux f64 +" f.+ f.=] ["lux f64 -" f.- f.=] @@ -152,7 +152,7 @@ (|> {synthesis.#Extension (list (synthesis.f64 param) (synthesis.f64 subject))} (run (..safe )) - (pipe.case + (pipe.when {try.#Success valueV} (bit#= ( param subject) (as Bit valueV)) @@ -167,7 +167,7 @@ [(_.test (|> {synthesis.#Extension (list)} (run (..safe )) - (//case.verify )))] + (//when.verify )))] ["lux f64 min" ("lux f64 min")] ["lux f64 max" ("lux f64 max")] @@ -178,7 +178,7 @@ (|> subject synthesis.f64 (list) {synthesis.#Extension "lux f64 i64"} (list) {synthesis.#Extension "lux i64 f64"})) - (//case.verify subject))) + (//when.verify subject))) )))) (def (text run) @@ -202,7 +202,7 @@ (_.test "Can compare texts for equality." (and (|> {synthesis.#Extension "lux text =" (list sample_lowerS sample_lowerS)} (run (..safe "lux text =")) - (pipe.case + (pipe.when {try.#Success valueV} (as Bit valueV) @@ -210,7 +210,7 @@ false)) (|> {synthesis.#Extension "lux text =" (list sample_upperS sample_lowerS)} (run (..safe "lux text =")) - (pipe.case + (pipe.when {try.#Success valueV} (not (as Bit valueV)) @@ -219,7 +219,7 @@ (_.test "Can compare texts for order." (|> {synthesis.#Extension "lux text <" (list sample_lowerS sample_upperS)} (run (..safe "lux text <")) - (pipe.case + (pipe.when {try.#Success valueV} (as Bit valueV) @@ -228,7 +228,7 @@ (_.test "Can get length of text." (|> {synthesis.#Extension "lux text size" (list sample_lowerS)} (run (..safe "lux text size")) - (pipe.case + (pipe.when {try.#Success valueV} (n.= sample_size (as Nat valueV)) @@ -237,7 +237,7 @@ (_.test "Can concatenate text." (|> {synthesis.#Extension "lux text size" (list concatenatedS)} (run (..safe "lux text size")) - (pipe.case + (pipe.when {try.#Success valueV} (n.= (n.* 2 sample_size) (as Nat valueV)) @@ -248,7 +248,7 @@ (list concatenatedS sample_lowerS (synthesis.i64 +0))} (run (..safe "lux text index")) - (pipe.case + (pipe.when (^.multi {try.#Success valueV} [(as (Maybe Nat) valueV) {.#Some valueV}]) @@ -260,7 +260,7 @@ (list concatenatedS sample_upperS (synthesis.i64 +0))} (run (..safe "lux text index")) - (pipe.case + (pipe.when (^.multi {try.#Success valueV} [(as (Maybe Nat) valueV) {.#Some valueV}]) @@ -275,7 +275,7 @@ (synthesis.i64 offset) (synthesis.i64 length))} (run (..safe "lux text clip")) - (pipe.case + (pipe.when (^.multi {try.#Success valueV} [(as (Maybe Text) valueV) {.#Some valueV}]) @@ -291,7 +291,7 @@ (list sample_lowerS (synthesis.i64 char_idx))} (run (..safe "lux text char")) - (pipe.case + (pipe.when (^.multi {try.#Success valueV} [(as (Maybe Int) valueV) {.#Some valueV}]) @@ -311,7 +311,7 @@ (|> {synthesis.#Extension "lux io log" (list (synthesis.text (format "LOG: " message)))} (run (..safe "lux io log")) - (pipe.case + (pipe.when {try.#Success valueV} true @@ -325,7 +325,7 @@ synthesis.#body {synthesis.#Extension "lux io error" (list (synthesis.text message))}]))} (run (..safe "lux try")) - (pipe.case + (pipe.when (^.multi {try.#Success valueV} [(as (Try Text) valueV) {try.#Failure error}]) @@ -339,7 +339,7 @@ synthesis.#arity 1 synthesis.#body (synthesis.text message)]))} (run (..safe "lux try")) - (pipe.case + (pipe.when (^.multi {try.#Success valueV} [(as (Try Text) valueV) {try.#Success valueV}]) diff --git a/stdlib/source/specification/compositor/generation/primitive.lux b/stdlib/source/specification/compositor/generation/primitive.lux index 43637f7a2..b9aebc000 100644 --- a/stdlib/source/specification/compositor/generation/primitive.lux +++ b/stdlib/source/specification/compositor/generation/primitive.lux @@ -36,7 +36,7 @@ [expected ] (_.test (%.symbol (symbol )) (|> (run ( expected)) - (pipe.case + (pipe.when {try.#Success actual} ( expected (as_expected actual)) diff --git a/stdlib/source/specification/compositor/generation/reference.lux b/stdlib/source/specification/compositor/generation/reference.lux index 5e7516f20..ce0d00d1a 100644 --- a/stdlib/source/specification/compositor/generation/reference.lux +++ b/stdlib/source/specification/compositor/generation/reference.lux @@ -33,7 +33,7 @@ expected r.safe_frac] (_.test "Definitions." (|> (define name (synthesis.f64 expected)) - (pipe.case + (pipe.when {try.#Success actual} (f.= expected (as Frac actual)) @@ -50,7 +50,7 @@ register (synthesis.variable/local register)]) (run "variable") - (pipe.case + (pipe.when {try.#Success actual} (f.= expected (as Frac actual)) diff --git a/stdlib/source/specification/compositor/generation/structure.lux b/stdlib/source/specification/compositor/generation/structure.lux index 9ab5d02f2..acf9888e8 100644 --- a/stdlib/source/specification/compositor/generation/structure.lux +++ b/stdlib/source/specification/compositor/generation/structure.lux @@ -44,7 +44,7 @@ analysis.#right? last?_in analysis.#value (synthesis.i64 value_in)]) (run "variant") - (pipe.case + (pipe.when {try.#Success valueT} (let [valueT (as (Array Any) valueT)] (and (n.= 3 (array.size valueT)) @@ -52,7 +52,7 @@ last?_out (array.read! 1 valueT) value_out (as Any (maybe.trusted (array.read! 2 valueT))) same_tag? (|> tag_out ffi.int_to_long (as Nat) (n.= tag_in)) - same_flag? (case last?_out + same_flag? (when last?_out {.#Some last?_out'} (and last?_in (text#= "" (as Text last?_out'))) @@ -74,7 +74,7 @@ (_.test (%.symbol (symbol synthesis.tuple)) (|> (synthesis.tuple (list#each (|>> synthesis.i64) tuple_in)) (run "tuple") - (pipe.case + (pipe.when {try.#Success tuple_out} (let [tuple_out (as (Array Any) tuple_out)] (and (n.= size (array.size tuple_out)) diff --git a/stdlib/source/specification/lux/abstract/codec.lux b/stdlib/source/specification/lux/abstract/codec.lux index c2dd86e90..80fa0d327 100644 --- a/stdlib/source/specification/lux/abstract/codec.lux +++ b/stdlib/source/specification/lux/abstract/codec.lux @@ -20,7 +20,7 @@ [expected generator] (_.for [/.Codec] (_.test "Isomorphism." - (case (|> expected @//encoded @//decoded) + (when (|> expected @//encoded @//decoded) {try.#Success actual} (@//= expected actual) diff --git a/stdlib/source/specification/lux/world/console.lux b/stdlib/source/specification/lux/world/console.lux index 9fc830fd2..3fbdc42af 100644 --- a/stdlib/source/specification/lux/world/console.lux +++ b/stdlib/source/specification/lux/world/console.lux @@ -32,7 +32,7 @@ ?close/bad (at console close []) .let [can_write! - (case ?write + (when ?write {try.#Success _} true @@ -40,7 +40,7 @@ false) can_read! - (case [?read ?read_line] + (when [?read ?read_line] [{try.#Success _} {try.#Success _}] true @@ -48,7 +48,7 @@ false) can_close! - (case [?close/good ?close/bad] + (when [?close/good ?close/bad] [{try.#Success _} {try.#Failure _}] true diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux index b70555b6f..648449050 100644 --- a/stdlib/source/specification/lux/world/file.lux +++ b/stdlib/source/specification/lux/world/file.lux @@ -66,7 +66,7 @@ made? (at fs make_directory parent) directory_post! (at fs directory? parent)] (in (and (not directory_pre!) - (case made? + (when made? {try.#Success _} true {try.#Failure _} false) directory_post!)))) @@ -78,7 +78,7 @@ made? (at fs write path content) file_post! (at fs file? path)] (in (and (not file_pre!) - (case made? + (when made? {try.#Success _} true {try.#Failure _} false) file_post!)))) @@ -235,20 +235,20 @@ (and (not pre_dir/0) (not pre_dir/1) (not pre_dir/2) - (case made? + (when made? {try.#Success _} true {try.#Failure _} false) post_dir/0 post_dir/1 post_dir/2)) (unit.coverage [/.cannot_make_directory] - (and (case cannot_make_directory!/0 + (and (when cannot_make_directory!/0 {try.#Success _} false {try.#Failure error} (exception.match? /.cannot_make_directory error)) - (case cannot_make_directory!/1 + (when cannot_make_directory!/1 {try.#Success _} false @@ -267,11 +267,11 @@ make_file!/1 (/.make_file ! fs (utf8#encoded file/0) file/0)]) (all unit.and (unit.coverage [/.make_file] - (case make_file!/0 + (when make_file!/0 {try.#Success _} true {try.#Failure error} false)) (unit.coverage [/.cannot_make_file] - (case make_file!/1 + (when make_file!/1 {try.#Success _} false @@ -314,10 +314,10 @@ (not pre_dir/0) (not pre_dir/1) - (case made_file? + (when made_file? {try.#Success _} true {try.#Failure _} false) - (case made_dir? + (when made_dir? {try.#Success _} true {try.#Failure _} false) diff --git a/stdlib/source/specification/lux/world/shell.lux b/stdlib/source/specification/lux/world/shell.lux index be41059a0..d552c1bdb 100644 --- a/stdlib/source/specification/lux/world/shell.lux +++ b/stdlib/source/specification/lux/world/shell.lux @@ -54,13 +54,13 @@ (do async.monad [?destroy (at process destroy []) ?await (at process await [])] - (in (and (case ?destroy + (in (and (when ?destroy {try.#Success _} true {try.#Failure error} false) - (case ?await + (when ?await {try.#Success _} false @@ -77,7 +77,7 @@ (in (do [! async.monad] [?echo (at shell execute (..echo! message)) ?sleep (at shell execute (..sleep! seconds))] - (case [?echo ?sleep] + (when [?echo ?sleep] [{try.#Success echo} {try.#Success sleep}] (do ! [can_read! (..can_read! message echo) -- cgit v1.2.3