From 2dbbaaec93a53f8dd0b96a0028b9cf125c9066cd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 12 Sep 2021 15:39:55 -0400 Subject: Re-named \ => # && \\ => ## --- stdlib/source/specification/compositor/common.lux | 4 ++-- .../specification/compositor/generation/case.lux | 18 ++++++++-------- .../specification/compositor/generation/common.lux | 24 +++++++++++----------- .../compositor/generation/function.lux | 14 ++++++------- .../compositor/generation/primitive.lux | 8 ++++---- .../compositor/generation/reference.lux | 2 +- .../compositor/generation/structure.lux | 14 ++++++------- 7 files changed, 42 insertions(+), 42 deletions(-) (limited to 'stdlib/source/specification/compositor') diff --git a/stdlib/source/specification/compositor/common.lux b/stdlib/source/specification/compositor/common.lux index e5d3dab25..c71082a94 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)))] - (\ host evaluate! evaluation_name expressionG)))) + (# host evaluate! evaluation_name expressionG)))) (def: (definer (^slots [platform.#runtime platform.#phase platform.#host]) state) @@ -55,7 +55,7 @@ [host_name host_value host_directive] (generation.define! lux_name expressionG) _ (generation.learn lux_name host_name)] (phase (synthesis.constant lux_name))))] - (\ host evaluate! "definer" definitionG)))) + (# host evaluate! "definer" definitionG)))) (def: .public (executors target expander platform analysis_bundle generation_bundle directive_bundle diff --git a/stdlib/source/specification/compositor/generation/case.lux b/stdlib/source/specification/compositor/generation/case.lux index 52689480e..8343cbb67 100644 --- a/stdlib/source/specification/compositor/generation/case.lux +++ b/stdlib/source/specification/compositor/generation/case.lux @@ -7,13 +7,13 @@ [pipe {"+" [case>]}] ["[0]" try {"+" [Try]}]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [number ["n" nat] ["f" frac]] [collection - ["[0]" list ("[1]\[0]" mix)]]] + ["[0]" list ("[1]#[0]" mix)]]] [math ["r" random {"+" [Random]}]] [tool @@ -32,7 +32,7 @@ (def: size (Random Nat) - (|> r.nat (\ r.monad each (|>> (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 (\ ! each (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 (\ ! each (n.% size))) + idx (|> r.nat (# ! each (n.% size))) [subS subP] case .let [right? (tail? size idx) caseS (synthesis.variant @@ -152,7 +152,7 @@ (function (_ head tail) (synthesis.variant [0 #1 (synthesis.tuple (list head tail))]))) _list_ (: (-> (List Synthesis) Synthesis) - (list\mix _item_ _end_))] + (list#mix _item_ _end_))] (let [__tuple__ (: (-> (List Synthesis) Synthesis) (|>> list.reversed _list_ [9 #0] synthesis.variant _code_)) __form__ (: (-> (List Synthesis) Synthesis) @@ -169,7 +169,7 @@ (_code_ (synthesis.variant [7 #0 (synthesis.tuple (list (synthesis.text module) (synthesis.text short)))])))) __list__ (: (-> (List Synthesis) Synthesis) - (list\mix (function (_ head tail) + (list#mix (function (_ head tail) (__form__ (list (__tag__ ["" "Item"]) head tail))) (__tag__ ["" "End"]))) __apply__ (: (-> Synthesis Synthesis Synthesis) @@ -247,9 +247,9 @@ (-> Runner Test) ($_ _.and (_.test "===" - (and (text\= (synthesis.%path special_path) + (and (text#= (synthesis.%path special_path) (synthesis.%path special_pattern_path)) - (\ synthesis.path_equivalence = special_path special_pattern_path))) + (# 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 eeaa68a94..82dc698f9 100644 --- a/stdlib/source/specification/compositor/generation/common.lux +++ b/stdlib/source/specification/compositor/generation/common.lux @@ -7,13 +7,13 @@ [pipe {"+" [case>]}] ["[0]" try {"+" [Try]}]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [number ["[0]" i64] ["n" nat] ["i" int] ["f" frac]] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection ["[0]" list]]] @@ -90,7 +90,7 @@ (let [subject ])))] ["lux i64 f64" Frac i.frac f.= subject] - ["lux i64 char" Text (|>> (:as Nat) text.from_code) text\= (|> subject + ["lux i64 char" Text (|>> (:as Nat) text.from_code) text#= (|> subject (:as Nat) (n.% (i64.left_shifted 8 1)) (:as Int))] @@ -111,14 +111,14 @@ ["lux i64 *" i.* Int i.=] ["lux i64 /" i./ Int i.=] ["lux i64 %" i.% Int i.=] - ["lux i64 =" i.= Bit bit\=] - ["lux i64 <" i.< Bit bit\=] + ["lux i64 =" i.= Bit bit#=] + ["lux i64 <" i.< Bit bit#=] )) )))) (def: simple_frac (Random Frac) - (|> r.nat (\ r.monad each (|>> (n.% 1000) .int i.frac)))) + (|> r.nat (# r.monad each (|>> (n.% 1000) .int i.frac)))) (def: (f64 run) (-> Runner Test) @@ -145,7 +145,7 @@ (synthesis.f64 subject))} (run (..safe )) (case> {try.#Success valueV} - (bit\= ( param subject) + (bit#= ( param subject) (:as Bit valueV)) _ @@ -175,12 +175,12 @@ (def: (text run) (-> Runner Test) (do [! r.monad] - [sample_size (|> r.nat (\ ! each (|>> (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 (\ ! each (n.% sample_size))) + (r.only (|>> (text#= sample_upper) not))) + 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) @@ -262,7 +262,7 @@ (case> (^multi {try.#Success valueV} [(:as (Maybe Text) valueV) {.#Some valueV}]) - (text\= expected valueV) + (text#= expected valueV) _ false))))] @@ -322,7 +322,7 @@ (case> (^multi {try.#Success valueV} [(:as (Try Text) valueV) {try.#Success valueV}]) - (text\= message valueV) + (text#= message valueV) _ false)))) diff --git a/stdlib/source/specification/compositor/generation/function.lux b/stdlib/source/specification/compositor/generation/function.lux index 9a2f68a8a..8250a8d71 100644 --- a/stdlib/source/specification/compositor/generation/function.lux +++ b/stdlib/source/specification/compositor/generation/function.lux @@ -11,9 +11,9 @@ [number ["n" nat]] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math - ["r" random {"+" [Random]} ("[1]\[0]" monad)]] + ["r" random {"+" [Random]} ("[1]#[0]" monad)]] [tool [compiler [analysis {"+" [Arity]}] @@ -30,11 +30,11 @@ (def: arity (Random Arity) - (|> r.nat (r\each (|>> (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\each (|>> (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 (\ ! each (|>> (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\each (|>> 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\each (|>> {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/primitive.lux b/stdlib/source/specification/compositor/generation/primitive.lux index f4bf220a4..531b48c88 100644 --- a/stdlib/source/specification/compositor/generation/primitive.lux +++ b/stdlib/source/specification/compositor/generation/primitive.lux @@ -7,10 +7,10 @@ [pipe {"+" [case>]}] ["[0]" try]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [number ["f" frac]] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math ["r" random]] @@ -40,9 +40,9 @@ {try.#Failure _} false))))] - ["bit" synthesis.bit r.bit bit\=] + ["bit" synthesis.bit r.bit bit#=] ["i64" synthesis.i64 r.i64 "lux i64 ="] ["f64" synthesis.f64 r.frac f.='] - ["text" synthesis.text (r.ascii 5) text\=] + ["text" synthesis.text (r.ascii 5) text#=] )) ))) diff --git a/stdlib/source/specification/compositor/generation/reference.lux b/stdlib/source/specification/compositor/generation/reference.lux index a8391f63a..ddeab3146 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 (\ ! each (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 1b98fc558..9045c60e1 100644 --- a/stdlib/source/specification/compositor/generation/structure.lux +++ b/stdlib/source/specification/compositor/generation/structure.lux @@ -11,11 +11,11 @@ [number ["n" nat] ["i" int]] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection ["[0]" array {"+" [Array]}] - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["r" random]] ["[0]" ffi {"+" [import:]}] @@ -31,8 +31,8 @@ (def: (variant run) (-> Runner Test) (do [! r.monad] - [num_tags (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) - tag_in (|> r.nat (\ ! each (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)) @@ -51,7 +51,7 @@ same_tag? (|> tag_out ffi.int_to_long (:as Nat) (n.= tag_in)) same_flag? (case last?_out {.#Some last?_out'} - (and last?_in (text\= "" (:as Text last?_out'))) + (and last?_in (text#= "" (:as Text last?_out'))) {.#None} (not last?_in)) @@ -66,10 +66,10 @@ (def: (tuple run) (-> Runner Test) (do [! r.monad] - [size (|> r.nat (\ ! each (|>> (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\each (|>> 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)] -- cgit v1.2.3