From a02b7bf8ff358ccfa35b03272d28537aeac723ae Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 28 Nov 2020 19:45:56 -0400 Subject: Added "private" macro to lux/debug. --- stdlib/source/spec/compositor/analysis/type.lux | 4 ---- stdlib/source/spec/compositor/generation/case.lux | 10 +++++----- stdlib/source/spec/compositor/generation/common.lux | 18 +++++++++--------- stdlib/source/spec/compositor/generation/function.lux | 12 ++++++------ stdlib/source/spec/compositor/generation/primitive.lux | 8 ++++---- stdlib/source/spec/compositor/generation/structure.lux | 8 ++++---- stdlib/source/spec/lux/world/shell.lux | 7 ++++--- 7 files changed, 32 insertions(+), 35 deletions(-) (limited to 'stdlib/source/spec') diff --git a/stdlib/source/spec/compositor/analysis/type.lux b/stdlib/source/spec/compositor/analysis/type.lux index 718c1d01e..7cbd5884b 100644 --- a/stdlib/source/spec/compositor/analysis/type.lux +++ b/stdlib/source/spec/compositor/analysis/type.lux @@ -1,16 +1,12 @@ (.module: [lux #* ["_" test (#+ Test)] - ["." type ("#@." equivalence)] [abstract [monad (#+ do)]] [control [pipe (#+ case>)] ["." io] ["." try]] - [data - ["." bit ("#@." equivalence)] - ["." text ("#@." equivalence)]] [math ["r" random (#+ Random)]] [macro diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux index 764d7351b..908fef201 100644 --- a/stdlib/source/spec/compositor/generation/case.lux +++ b/stdlib/source/spec/compositor/generation/case.lux @@ -7,13 +7,13 @@ [pipe (#+ case>)] ["." try (#+ Try)]] [data - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [number ["n" nat] ["f" frac]] [collection - ["." list ("#@." fold)]]] + ["." list ("#\." fold)]]] [math ["r" random (#+ Random)]] [tool @@ -152,7 +152,7 @@ (function (_ head tail) (synthesis.variant [0 #1 (synthesis.tuple (list head tail))]))) _list_ (: (-> (List Synthesis) Synthesis) - (list@fold _cons_ _nil_))] + (list\fold _cons_ _nil_))] (let [__tuple__ (: (-> (List Synthesis) Synthesis) (|>> list.reverse _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@fold (function (_ head tail) + (list\fold (function (_ head tail) (__form__ (list (__tag__ ["" "Cons"]) head tail))) (__tag__ ["" "Nil"]))) __apply__ (: (-> Synthesis Synthesis Synthesis) @@ -247,7 +247,7 @@ (-> 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))) (_.test "CODE" diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux index 9060675f6..60caf1a32 100644 --- a/stdlib/source/spec/compositor/generation/common.lux +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -7,13 +7,13 @@ [pipe (#+ case>)] ["." try (#+ Try)]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["." i64] ["n" nat] ["i" int] ["f" frac]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." list]]] @@ -90,7 +90,7 @@ (let [subject ])))] ["lux i64 f64" Frac i.frac f.= subject] - ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text@= (|> subject + ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text\= (|> subject (:coerce Nat) (n.% (i64.left-shift 8 1)) (:coerce Int))] @@ -111,8 +111,8 @@ ["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\=] )) )))) @@ -145,7 +145,7 @@ (synthesis.f64 subject))) (run (..sanitize )) (case> (#try.Success valueV) - (bit@= ( param subject) + (bit\= ( param subject) (:coerce Bit valueV)) _ @@ -179,7 +179,7 @@ sample-lower (r.ascii/lower-alpha sample-size) sample-upper (r.ascii/upper-alpha sample-size) sample-alpha (|> (r.ascii/alpha sample-size) - (r.filter (|>> (text@= sample-upper) not))) + (r.filter (|>> (text\= sample-upper) not))) char-idx (|> r.nat (:: ! map (n.% sample-size))) #let [sample-lowerS (synthesis.text sample-lower) sample-upperS (synthesis.text sample-upper) @@ -259,7 +259,7 @@ (run (..sanitize "lux text clip")) (case> (^multi (#try.Success valueV) [(:coerce (Maybe Text) valueV) (#.Some valueV)]) - (text@= expected valueV) + (text\= expected valueV) _ false))))] @@ -316,7 +316,7 @@ (run (..sanitize "lux try")) (case> (^multi (#try.Success valueV) [(:coerce (Try Text) valueV) (#try.Success valueV)]) - (text@= message valueV) + (text\= message valueV) _ false)))) diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux index fefe039f7..21b2b4446 100644 --- a/stdlib/source/spec/compositor/generation/function.lux +++ b/stdlib/source/spec/compositor/generation/function.lux @@ -11,9 +11,9 @@ [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math - ["r" random (#+ Random) ("#@." monad)]] + ["r" random (#+ Random) ("#\." monad)]] [tool [compiler [analysis (#+ Arity)] @@ -28,11 +28,11 @@ (def: arity (Random Arity) - (|> r.nat (r@map (|>> (n.% max-arity) (n.max 1))))) + (|> r.nat (r\map (|>> (n.% max-arity) (n.max 1))))) (def: (local arity) (-> Arity (Random Register)) - (|> r.nat (r@map (|>> (n.% arity) inc)))) + (|> r.nat (r\map (|>> (n.% arity) inc)))) (def: function (Random [Arity Register Synthesis]) @@ -52,7 +52,7 @@ partial-arity (|> r.nat (:: ! map (|>> (n.% arity) (n.max 1)))) inputs (r.list arity r.safe-frac) #let [expectation (maybe.assume (list.nth (dec local) inputs)) - inputsS (list@map (|>> synthesis.f64) inputs)]] + inputsS (list\map (|>> synthesis.f64) inputs)]] ($_ _.and (_.test "Can read arguments." (|> (synthesis.function/apply {#synthesis.function functionS @@ -73,7 +73,7 @@ (or (n.= 1 arity) (let [environment (|> partial-arity (enum.range n.enum 1) - (list@map (|>> #reference.Local))) + (list\map (|>> #reference.Local))) variableS (if (n.<= partial-arity local) (synthesis.variable/foreign (dec local)) (synthesis.variable/local (|> local (n.- partial-arity)))) diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux index e5b601677..3b6dd657b 100644 --- a/stdlib/source/spec/compositor/generation/primitive.lux +++ b/stdlib/source/spec/compositor/generation/primitive.lux @@ -7,10 +7,10 @@ [pipe (#+ case>)] ["." try]] [data - ["." bit ("#@." equivalence)] + ["." bit ("#\." equivalence)] [number ["f" frac]] - ["." text ("#@." equivalence) + ["." text ("#\." 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/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux index cd790c6d2..e728867eb 100644 --- a/stdlib/source/spec/compositor/generation/structure.lux +++ b/stdlib/source/spec/compositor/generation/structure.lux @@ -11,11 +11,11 @@ [number ["n" nat] ["i" int]] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection ["." array (#+ Array)] - ["." list ("#@." functor)]]] + ["." list ("#\." functor)]]] [math ["r" random]] ["." host (#+ import:)] @@ -51,7 +51,7 @@ same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n.= tag-in)) same-flag? (case last?-out (#.Some last?-out') - (and last?-in (text@= "" (:coerce Text last?-out'))) + (and last?-in (text\= "" (:coerce Text last?-out'))) #.None (not last?-in)) @@ -69,7 +69,7 @@ [size (|> r.nat (:: ! map (|>> (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\map (|>> synthesis.i64) tuple-in)) (run "tuple") (case> (#try.Success tuple-out) (let [tuple-out (:coerce (Array Any) tuple-out)] diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index c10f77c12..e0eacbee6 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -23,12 +23,13 @@ {1 ["." / [// - [environment (#+ Environment)]]]}) + [environment (#+ Environment)] + [file (#+ Path)]]]}) (template [ ] [(def: - (-> [Environment /.Command (List /.Argument)]) - (|>> list [environment.empty ]))] + (-> [Environment Path /.Command (List /.Argument)]) + (|>> list [environment.empty "~" ]))] [echo! "echo" Text (|>)] [sleep! "sleep" Nat %.nat] -- cgit v1.2.3