From 8003796cce911fa7c4958a83a2c55e6cbe16c8aa Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 27 Nov 2017 02:34:07 -0400 Subject: - Got rid of even more dots. --- stdlib/source/lux.lux | 16 +++--- stdlib/source/lux/concurrency/actor.lux | 10 ++-- stdlib/source/lux/concurrency/promise.lux | 2 +- stdlib/source/lux/concurrency/space.lux | 4 +- stdlib/source/lux/concurrency/stm.lux | 2 +- stdlib/source/lux/concurrency/task.lux | 4 +- stdlib/source/lux/control/applicative.lux | 2 +- stdlib/source/lux/control/codec.lux | 2 +- stdlib/source/lux/control/concatenative.lux | 14 ++--- stdlib/source/lux/control/reader.lux | 2 +- stdlib/source/lux/data/coll/dict.lux | 8 +-- stdlib/source/lux/data/coll/list.lux | 2 +- stdlib/source/lux/data/coll/queue.lux | 6 +- stdlib/source/lux/data/coll/sequence.lux | 6 +- stdlib/source/lux/data/coll/tree/rose.lux | 2 +- stdlib/source/lux/data/coll/tree/zipper.lux | 2 +- stdlib/source/lux/data/color.lux | 12 ++-- stdlib/source/lux/data/format/html.lux | 2 +- stdlib/source/lux/data/format/xml.lux | 4 +- stdlib/source/lux/data/maybe.lux | 2 +- stdlib/source/lux/data/number.lux | 2 +- stdlib/source/lux/data/number/complex.lux | 70 ++++++++++++------------ stdlib/source/lux/data/number/ratio.lux | 50 ++++++++--------- stdlib/source/lux/data/tainted.lux | 4 +- stdlib/source/lux/data/text.lux | 2 +- stdlib/source/lux/data/text/regex.lux | 4 +- stdlib/source/lux/host.jvm.lux | 2 +- stdlib/source/lux/lang/syntax.lux | 2 +- stdlib/source/lux/macro.lux | 4 +- stdlib/source/lux/macro/poly.lux | 2 +- stdlib/source/lux/macro/poly/eq.lux | 8 +-- stdlib/source/lux/macro/poly/functor.lux | 4 +- stdlib/source/lux/macro/poly/json.lux | 26 ++++----- stdlib/source/lux/macro/syntax/common/reader.lux | 2 +- stdlib/source/lux/test.lux | 2 +- stdlib/source/lux/time/duration.lux | 4 +- stdlib/source/lux/time/instant.lux | 6 +- stdlib/source/lux/type/implicit.lux | 2 +- stdlib/source/lux/type/object.lux | 16 +++--- stdlib/source/lux/type/opaque.lux | 6 +- stdlib/source/lux/type/unit.lux | 16 +++--- stdlib/source/lux/world/blob.jvm.lux | 2 +- stdlib/source/lux/world/console.lux | 8 +-- 43 files changed, 174 insertions(+), 174 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index e5da4a105..65167b8e6 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -4602,9 +4602,9 @@ _ (fail "Wrong syntax for open"))) -(macro: #export (|>. tokens) +(macro: #export (|>> tokens) {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (|>. (map int/encode) (interpose \" \") (fold text/compose \"\")) + (|>> (map int/encode) (interpose \" \") (fold text/compose \"\")) ## => (function [] (fold text/compose \"\" @@ -4614,9 +4614,9 @@ [g!arg (gensym "arg")] (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) -(macro: #export (<|. tokens) +(macro: #export (<<| tokens) {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (<|. (fold text/compose \"\") (interpose \" \") (map int/encode)) + (<<| (fold text/compose \"\") (interpose \" \") (map int/encode)) ## => (function [] (fold text/compose \"\" @@ -4689,7 +4689,7 @@ (do Monad [*defs (exported-defs module-name) _ (test-referrals module-name *defs -defs)] - (wrap (filter (|>. (is-member? -defs) not) *defs))) + (wrap (filter (|>> (is-member? -defs) not) *defs))) #Nothing (wrap (list))) @@ -4728,11 +4728,11 @@ (list (' #refer) (' #all)) (#Only defs) - (list (' #refer) (`' (#only (~@ (map (|>. [""] symbol$) + (list (' #refer) (`' (#only (~@ (map (|>> [""] symbol$) defs))))) (#Exclude defs) - (list (' #refer) (`' (#exclude (~@ (map (|>. [""] symbol$) + (list (' #refer) (`' (#exclude (~@ (map (|>> [""] symbol$) defs))))) #Nothing @@ -5881,7 +5881,7 @@ ((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler)) (~ anns) (case (~ g!tokens) - (^ (list (~@ (map (|>. [""] symbol$) args)))) + (^ (list (~@ (map (|>> [""] symbol$) args)))) (#;Right [(~ g!compiler) (list (` (~ (replace-syntax rep-env input-template))))]) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 18bdaa61d..abda284c0 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -146,7 +146,7 @@ (do-template [ ] [(def: #hidden ( name) (-> Ident cs;Annotations cs;Annotations) - (|>. (#;Cons [(ident-for ) + (|>> (#;Cons [(ident-for ) (code;tag name)]))) (def: #hidden ( name) @@ -172,7 +172,7 @@ (do-template [ ] [(def: #hidden (-> Text Text) - (|>. (format "@")))] + (|>> (format "@")))] [state-name "State"] [behavior-name "Behavior"] @@ -315,7 +315,7 @@ g!actor-vars (list/map code;local-symbol actor-vars) g!actor (` ((~ (code;symbol actor-name)) (~@ g!actor-vars))) g!all-vars (|> (get@ #vars signature) (list/map code;local-symbol) (list/compose g!actor-vars)) - g!inputsC (|> (get@ #inputs signature) (list/map (|>. product;left code;local-symbol))) + g!inputsC (|> (get@ #inputs signature) (list/map (|>> product;left code;local-symbol))) g!inputsT (|> (get@ #inputs signature) (list/map product;right)) g!state (|> signature (get@ #state) code;local-symbol) g!self (|> signature (get@ #self) code;local-symbol) @@ -323,11 +323,11 @@ (if (list;empty? actor-vars) (list) (|> actor-vars list;size n/dec - (list;n/range +0) (list/map (|>. code;nat (~) ($) (`)))))) + (list;n/range +0) (list/map (|>> code;nat (~) ($) (`)))))) ref-replacements (|> (if (list;empty? actor-vars) (list) (|> actor-vars list;size n/dec - (list;n/range +0) (list/map (|>. code;nat (~) ($) (`))))) + (list;n/range +0) (list/map (|>> code;nat (~) ($) (`))))) (: (List Code)) (list;zip2 g!all-vars) (: (List [Code Code]))) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 9baaded11..9984ad96a 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -82,7 +82,7 @@ (io;run (f value)) #;None - (let [new (update@ #observers (|>. (#;Cons f)) old)] + (let [new (update@ #observers (|>> (#;Cons f)) old)] (if (io;run (atom;compare-and-swap old new promise)) [] (await f promise)))))) diff --git a/stdlib/source/lux/concurrency/space.lux b/stdlib/source/lux/concurrency/space.lux index 87a1d3c22..091cae7fc 100644 --- a/stdlib/source/lux/concurrency/space.lux +++ b/stdlib/source/lux/concurrency/space.lux @@ -42,7 +42,7 @@ (All [e s] (-> (A;Actor s) (Action e s) (Space e) (T;Task Unit))) (send-space (function [subscriptions _] (T;return (|> subscriptions - (list;filter (|>. product;left (:! []) (is (:! [] actor)) not)) + (list;filter (|>> product;left (:! []) (is (:! [] actor)) not)) (#;Cons [actor action])))) space)) @@ -50,7 +50,7 @@ (All [e s] (-> (A;Actor s) (Space e) (T;Task Unit))) (send-space (function [subscriptions _] (T;return (|> subscriptions - (list;filter (|>. product;left (:! []) (is (:! [] actor)) not))))) + (list;filter (|>> product;left (:! []) (is (:! [] actor)) not))))) space)) (def: #export (emit event space sender) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index b845c3538..4aaee3580 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -47,7 +47,7 @@ (def: raw-read (All [a] (-> (Var a) a)) - (|>. atom;read io;run (get@ #value))) + (|>> atom;read io;run (get@ #value))) (def: (find-var-value var tx) (All [a] (-> (Var a) Tx (Maybe a))) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index 374acee46..b65d7c563 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -27,7 +27,7 @@ (def: #export (try computation) (All [a] (-> (Task a) (Task (E;Error a)))) - (:: P;Functor map (|>. #E;Success) computation)) + (:: P;Functor map (|>> #E;Success) computation)) (struct: #export _ (F;Functor Task) (def: (map f fa) @@ -76,4 +76,4 @@ (def: #export (from-promise promise) (All [a] (-> (P;Promise a) (Task a))) - (:: P;Functor map (|>. #E;Success) promise)) + (:: P;Functor map (|>> #E;Success) promise)) diff --git a/stdlib/source/lux/control/applicative.lux b/stdlib/source/lux/control/applicative.lux index 935fda18e..dead34d03 100644 --- a/stdlib/source/lux/control/applicative.lux +++ b/stdlib/source/lux/control/applicative.lux @@ -20,7 +20,7 @@ (def: functor (functor;compose (get@ #functor Applicative) (get@ #functor Applicative))) (def: wrap - (|>. (:: Applicative wrap) (:: Applicative wrap))) + (|>> (:: Applicative wrap) (:: Applicative wrap))) (def: (apply fgf fgx) ## (let [fgf' (:: Applicative apply ## (:: Applicative wrap (:: Applicative apply)) diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux index 55095ee3c..fdd571a10 100644 --- a/stdlib/source/lux/control/codec.lux +++ b/stdlib/source/lux/control/codec.lux @@ -18,7 +18,7 @@ (-> (Codec c b) (Codec b a) (Codec c a))) (def: encode - (|>. (:: Codec encode) + (|>> (:: Codec encode) (:: Codec encode))) (def: (decode cy) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index ef66ffac8..9451fa111 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -38,7 +38,7 @@ (s;Syntax Stack) (p;either (p;seq (p;maybe bottom^) (s;tuple (p;some s;any))) - (p;seq (|> bottom^ (p/map (|>. #;Some))) + (p;seq (|> bottom^ (p/map (|>> #;Some))) (p/wrap (list))))) (def: (stack-fold tops bottom) @@ -68,8 +68,8 @@ (code;replace (code;local-symbol from) to pre)) aliased aliases))] - (case [(|> inputs (get@ #bottom) (m/map (|>. code;nat (~) #;Bound (`)))) - (|> outputs (get@ #bottom) (m/map (|>. code;nat (~) #;Bound (`))))] + (case [(|> inputs (get@ #bottom) (m/map (|>> code;nat (~) #;Bound (`)))) + (|> outputs (get@ #bottom) (m/map (|>> code;nat (~) #;Bound (`))))] [(#;Some bottomI) (#;Some bottomO)] (monad;do @ [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) bottomI))) @@ -104,7 +104,7 @@ (` (;;push (~ command))) [_ (#;Tuple block)] - (` (;;push (|>. (~@ (L/map prepare block))))) + (` (;;push (|>> (~@ (L/map prepare block))))) _ command)) @@ -119,7 +119,7 @@ (wrap (list (` (def: (~@ (csw;export export)) (~ (code;local-symbol name)) (~ (csw;annotations annotations)) (~ type) - (|>. (~@ (L/map prepare commands)))))))) + (|>> (~@ (L/map prepare commands)))))))) (syntax: #export (apply [arity (|> s;nat (p;filter (;n/> +0)))]) (with-gensyms [g!func g!stack g!output] @@ -310,14 +310,14 @@ (=> [(=> ..a ..b) (=> ..b ..c)] [(=> ..a ..c)])) (function [[[stack f] g]] - [stack (|>. f g)])) + [stack (|>> f g)])) (def: #export curry (All [..a ..b a] (=> ..a [a (=> ..a [a] ..b)] ..a [(=> ..a ..b)])) (function [[[stack arg] quote]] - [stack (|>. (push arg) quote)])) + [stack (|>> (push arg) quote)])) ## [Words] (word: #export when diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux index b080d75ec..41ac32f08 100644 --- a/stdlib/source/lux/control/reader.lux +++ b/stdlib/source/lux/control/reader.lux @@ -41,7 +41,7 @@ (def: #export (local change proc) {#;doc "Run computation with a locally-modified environment."} (All [r a] (-> (-> r r) (Reader r a) (Reader r a))) - (|>. change proc)) + (|>> change proc)) (def: #export (run env proc) (All [r a] (-> r (Reader r a) a)) diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index 0273dc852..5ab078e28 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -148,7 +148,7 @@ ## Given a top-limit for indices, produces all indices in [0, R). (def: indices-for (-> Nat (List Index)) - (|>. n/dec (list;n/range +0))) + (|>> n/dec (list;n/range +0))) ## Increases the level-shift by the branching-exponent, to explore ## levels further down the tree. @@ -514,7 +514,7 @@ ## For #Collisions nodes, do a linear scan of all the known KV-pairs. (#Collisions _hash _colls) (:: Monad map product;right - (array;find (|>. product;left (:: Hash = key)) + (array;find (|>> product;left (:: Hash = key)) _colls)) )) @@ -610,11 +610,11 @@ (def: #export size (All [k v] (-> (Dict k v) Nat)) - (|>. product;right size')) + (|>> product;right size')) (def: #export empty? (All [k v] (-> (Dict k v) Bool)) - (|>. size (n/= +0))) + (|>> size (n/= +0))) (def: #export (entries dict) (All [k v] (-> (Dict k v) (List [k v]))) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index d00428478..6de9eeaa2 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -285,7 +285,7 @@ (struct: #export _ (Monad List) (def: applicative Applicative) - (def: join (|>. reverse (fold compose identity)))) + (def: join (|>> reverse (fold compose identity)))) ## [Functions] (def: #export (sort < xs) diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux index dd26ccc32..2d45dd995 100644 --- a/stdlib/source/lux/data/coll/queue.lux +++ b/stdlib/source/lux/data/coll/queue.lux @@ -25,7 +25,7 @@ (def: #export peek (All [a] (-> (Queue a) (Maybe a))) - (|>. (get@ #front) list;head)) + (|>> (get@ #front) list;head)) (def: #export (size queue) (All [a] (-> (Queue a) Nat)) @@ -35,7 +35,7 @@ (def: #export empty? (All [a] (-> (Queue a) Bool)) - (|>. (get@ #front) list;empty?)) + (|>> (get@ #front) list;empty?)) (def: #export (member? Eq queue member) (All [a] (-> (Eq a) (Queue a) a Bool)) @@ -65,7 +65,7 @@ (set@ #front (list val) queue) _ - (update@ #rear (|>. (#;Cons val)) queue))) + (update@ #rear (|>> (#;Cons val)) queue))) (struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Queue a)))) diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index d8c3ddfb9..b97a51450 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -263,9 +263,9 @@ (n/< vec-size idx)) (if (n/>= (tail-off vec-size) idx) (|> vec - ## (update@ #tail (|>. array;clone (array;write (branch-idx idx) val))) + ## (update@ #tail (|>> array;clone (array;write (branch-idx idx) val))) (update@ #tail (: (-> (Base ($ +0)) (Base ($ +0))) - (|>. array;clone (array;write (branch-idx idx) val)))) + (|>> array;clone (array;write (branch-idx idx) val)))) ) (|> vec (update@ #root (put' (get@ #level vec) idx val)))) @@ -363,7 +363,7 @@ (def: #export empty? (All [a] (-> (Sequence a) Bool)) - (|>. (get@ #size) (n/= +0))) + (|>> (get@ #size) (n/= +0))) ## [Syntax] (syntax: #export (sequence [elems (p;some s;any)]) diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux index 546982dba..e86dac944 100644 --- a/stdlib/source/lux/data/coll/tree/rose.lux +++ b/stdlib/source/lux/data/coll/tree/rose.lux @@ -37,7 +37,7 @@ (def: tree^ (Syntax Tree-Code) - (|> (|>. p;some s;record (p;seq s;any)) + (|> (|>> p;some s;record (p;seq s;any)) p;rec p;some s;record diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index c8f9a9059..e355f7238 100644 --- a/stdlib/source/lux/data/coll/tree/zipper.lux +++ b/stdlib/source/lux/data/coll/tree/zipper.lux @@ -168,7 +168,7 @@ (#;Some next) (#;Some (|> next - (update@ [#node #rose;children] (|>. list;tail (maybe;default (list))))))) + (update@ [#node #rose;children] (|>> list;tail (maybe;default (list))))))) (#;Cons next side) (#;Some (|> zipper diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 17546902a..3340629c3 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -8,18 +8,18 @@ (def: rgb Nat +256) (def: top Nat (n/dec rgb)) -(def: nat-to-frac (-> Nat Frac) (|>. nat-to-int int-to-frac)) -(def: frac-to-nat (-> Frac Nat) (|>. frac-to-int int-to-nat)) +(def: nat-to-frac (-> Nat Frac) (|>> nat-to-int int-to-frac)) +(def: frac-to-nat (-> Frac Nat) (|>> frac-to-int int-to-nat)) (def: rgb-factor Frac (nat-to-frac top)) (def: scale-down (-> Nat Frac) - (|>. nat-to-frac (f// rgb-factor))) + (|>> nat-to-frac (f// rgb-factor))) (def: scale-up (-> Frac Nat) - (|>. (f/* rgb-factor) frac-to-nat)) + (|>> (f/* rgb-factor) frac-to-nat)) (opaque: #export Color {} {#red Nat @@ -34,7 +34,7 @@ (def: #export unpack (-> Color [Nat Nat Nat]) - (|>. @repr)) + (|>> @repr)) (struct: #export _ (eq;Eq Color) (def: (= reference sample) @@ -298,7 +298,7 @@ (let [[hue saturation brightness] (to-hsb color) slice (|> 1.0 (f// (nat-to-frac results)))] (|> (list;n/range +0 (n/dec results)) - (L/map (|>. nat-to-frac + (L/map (|>> nat-to-frac (f/* slice) (f/+ brightness) normalize diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index e594b2232..e33e7d4ee 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -27,7 +27,7 @@ (def: attrs-to-text (-> Attributes Text) - (|>. (L/map (function [[key val]] (format key "=" "\"" (text val) "\""))) + (|>> (L/map (function [[key val]] (format key "=" "\"" (text val) "\""))) (text;join-with " "))) (def: #export (tag name attrs children) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 64b45851d..957628e94 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -85,7 +85,7 @@ (def: spaced^ (All [a] (-> (l;Lexer a) (l;Lexer a))) (let [white-space^ (p;some l;space)] - (|>. (p;before white-space^) + (|>> (p;before white-space^) (p;after white-space^)))) (def: attr-value^ @@ -140,7 +140,7 @@ (l;Lexer XML) (|> (p;either cdata^ (l;many xml-char^)) - (p/map (|>. #Text)))) + (p/map (|>> #Text)))) (def: xml^ (l;Lexer XML) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index c45e756a3..3c247eea3 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -98,4 +98,4 @@ (def: #export assume (All [a] (-> (Maybe a) a)) - (|>. (default (undefined)))) + (|>> (default (undefined)))) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 2749d566c..8e330e9d5 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -869,4 +869,4 @@ (struct: #export _ (Hash Deg) (def: eq Eq) - (def: hash (|>. (:! Nat)))) + (def: hash (|>> (:! Nat)))) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 15fee133f..783c8eb81 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -39,7 +39,7 @@ (or (number;not-a-number? (get@ #real complex)) (number;not-a-number? (get@ #imaginary complex)))) -(def: #export (c.= param input) +(def: #export (c/= param input) (-> Complex Complex Bool) (and (f/= (get@ #real param) (get@ #real input)) @@ -54,35 +54,35 @@ #imaginary ( (get@ #imaginary param) (get@ #imaginary input))})] - [c.+ f/+] - [c.- f/-] + [c/+ f/+] + [c/- f/-] ) (struct: #export _ (Eq Complex) - (def: = c.=)) + (def: = c/=)) -(def: #export c.negate +(def: #export c/negate (-> Complex Complex) - (|>. (update@ #real frac/negate) + (|>> (update@ #real frac/negate) (update@ #imaginary frac/negate))) -(def: #export c.signum +(def: #export c/signum (-> Complex Complex) - (|>. (update@ #real frac/signum) + (|>> (update@ #real frac/signum) (update@ #imaginary frac/signum))) (def: #export conjugate (-> Complex Complex) (update@ #imaginary frac/negate)) -(def: #export (c.*' param input) +(def: #export (c/*' param input) (-> Frac Complex Complex) {#real (f/* param (get@ #real input)) #imaginary (f/* param (get@ #imaginary input))}) -(def: #export (c.* param input) +(def: #export (c/* param input) (-> Complex Complex Complex) {#real (f/- (f/* (get@ #imaginary param) (get@ #imaginary input)) @@ -93,7 +93,7 @@ (f/* (get@ #imaginary param) (get@ #real input)))}) -(def: #export (c./ param input) +(def: #export (c// param input) (-> Complex Complex Complex) (let [(^slots [#real #imaginary]) param] (if (f/< (frac/abs imaginary) @@ -107,19 +107,19 @@ {#real (|> (get@ #imaginary input) (f/* quot) (f/+ (get@ #real input)) (f// denom)) #imaginary (|> (get@ #imaginary input) (f/- (f/* quot (get@ #real input))) (f// denom))})))) -(def: #export (c./' param subject) +(def: #export (c//' param subject) (-> Frac Complex Complex) (let [(^slots [#real #imaginary]) subject] {#real (f// param real) #imaginary (f// param imaginary)})) -(def: #export (c.% param input) +(def: #export (c/% param input) (-> Complex Complex Complex) - (let [scaled (c./ param input) + (let [scaled (c// param input) quotient (|> scaled (update@ #real math;floor) (update@ #imaginary math;floor))] - (c.- (c.* quotient param) + (c/- (c/* quotient param) input))) (def: #export (cos subject) @@ -172,7 +172,7 @@ {#real (f// d (math;sinh r2)) #imaginary (f// d (math;sin i2))})) -(def: #export (c.abs subject) +(def: #export (c/abs subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] (complex (if (f/< (frac/abs imaginary) @@ -190,16 +190,16 @@ )))) (struct: #export _ (Number Complex) - (def: + c.+) - (def: - c.-) - (def: * c.*) - (def: / c./) - (def: % c.%) + (def: + c/+) + (def: - c/-) + (def: * c/*) + (def: / c//) + (def: % c/%) (def: (negate x) (|> x (update@ #real frac/negate) (update@ #imaginary frac/negate))) - (def: abs c.abs) + (def: abs c/abs) (def: (signum x) (|> x (update@ #real frac/signum) @@ -215,7 +215,7 @@ (def: #export (log subject) (-> Complex Complex) (let [(^slots [#real #imaginary]) subject] - {#real (|> subject c.abs (get@ #real) math;log) + {#real (|> subject c/abs (get@ #real) math;log) #imaginary (math;atan2 real imaginary)})) (do-template [ ] @@ -223,8 +223,8 @@ (-> Complex Complex) (|> input log ( param) exp))] - [pow Complex c.*] - [pow' Frac c.*'] + [pow Complex c/*] + [pow' Frac c/*'] ) (def: (copy-sign sign magnitude) @@ -233,7 +233,7 @@ (def: #export (root2 (^@ input (^slots [#real #imaginary]))) (-> Complex Complex) - (let [t (|> input c.abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) math;root2)] + (let [t (|> input c/abs (get@ #real) (f/+ (frac/abs real)) (f// 2.0) math;root2)] (if (f/>= 0.0 real) {#real t #imaginary (f// (f/* 2.0 t) @@ -244,7 +244,7 @@ (def: #export (root2-1z input) (-> Complex Complex) - (|> (complex 1.0) (c.- (c.* input input)) root2)) + (|> (complex 1.0) (c/- (c/* input input)) root2)) (def: #export (reciprocal (^slots [#real #imaginary])) (-> Complex Complex) @@ -264,25 +264,25 @@ (def: #export (acos input) (-> Complex Complex) (|> input - (c.+ (|> input root2-1z (c.* i))) + (c/+ (|> input root2-1z (c/* i))) log - (c.* (c.negate i)))) + (c/* (c/negate i)))) (def: #export (asin input) (-> Complex Complex) (|> input root2-1z - (c.+ (c.* i input)) + (c/+ (c/* i input)) log - (c.* (c.negate i)))) + (c/* (c/negate i)))) (def: #export (atan input) (-> Complex Complex) (|> input - (c.+ i) - (c./ (c.- input i)) + (c/+ i) + (c// (c/- input i)) log - (c.* (c./ (complex 2.0) i)))) + (c/* (c// (complex 2.0) i)))) (def: #export (argument (^slots [#real #imaginary])) (-> Complex Frac) @@ -293,7 +293,7 @@ (if (n/= +0 nth) (list) (let [r-nth (|> nth nat-to-int int-to-frac) - nth-root-of-abs (|> input c.abs (get@ #real) (math;pow (f// r-nth 1.0))) + nth-root-of-abs (|> input c/abs (get@ #real) (math;pow (f// r-nth 1.0))) nth-phi (|> input argument (f// r-nth)) slice (|> math;pi (f/* 2.0) (f// r-nth))] (|> (list;n/range +0 (n/dec nth)) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index c056e740a..23e128464 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -27,21 +27,21 @@ {#numerator (n// common numerator) #denominator (n// common denominator)})) -(def: #export (q.* param input) +(def: #export (r/* param input) (-> Ratio Ratio Ratio) (normalize [(n/* (get@ #numerator param) (get@ #numerator input)) (n/* (get@ #denominator param) (get@ #denominator input))])) -(def: #export (q./ param input) +(def: #export (r// param input) (-> Ratio Ratio Ratio) (normalize [(n/* (get@ #denominator param) (get@ #numerator input)) (n/* (get@ #numerator param) (get@ #denominator input))])) -(def: #export (q.+ param input) +(def: #export (r/+ param input) (-> Ratio Ratio Ratio) (normalize [(n/+ (n/* (get@ #denominator input) (get@ #numerator param)) @@ -50,7 +50,7 @@ (n/* (get@ #denominator param) (get@ #denominator input))])) -(def: #export (q.- param input) +(def: #export (r/- param input) (-> Ratio Ratio Ratio) (normalize [(n/- (n/* (get@ #denominator input) (get@ #numerator param)) @@ -59,16 +59,16 @@ (n/* (get@ #denominator param) (get@ #denominator input))])) -(def: #export (q.% param input) +(def: #export (r/% param input) (-> Ratio Ratio Ratio) (let [quot (n// (n/* (get@ #denominator input) (get@ #numerator param)) (n/* (get@ #denominator param) (get@ #numerator input)))] - (q.- (update@ #numerator (n/* quot) param) + (r/- (update@ #numerator (n/* quot) param) input))) -(def: #export (q.= param input) +(def: #export (r/= param input) (-> Ratio Ratio Bool) (and (n/= (get@ #numerator param) (get@ #numerator input)) @@ -83,10 +83,10 @@ (n/* (get@ #denominator param) (get@ #numerator input)))))] - [q.< n/<] - [q.<= n/<=] - [q.> n/>] - [q.>= n/>=] + [r/< n/<] + [r/<= n/<=] + [r/> n/>] + [r/>= n/>=] ) (do-template [ ] @@ -96,26 +96,26 @@ right left))] - [q.min q.<] - [q.max q.>] + [r/min r/<] + [r/max r/>] ) (struct: #export _ (Eq Ratio) - (def: = q.=)) + (def: = r/=)) (struct: #export _ (order;Order Ratio) (def: eq Eq) - (def: < q.<) - (def: <= q.<=) - (def: > q.>) - (def: >= q.>=)) + (def: < r/<) + (def: <= r/<=) + (def: > r/>) + (def: >= r/>=)) (struct: #export _ (Number Ratio) - (def: + q.+) - (def: - q.-) - (def: * q.*) - (def: / q./) - (def: % q.%) + (def: + r/+) + (def: - r/-) + (def: * r/*) + (def: / r//) + (def: % r/%) (def: (negate (^slots [#numerator #denominator])) {#numerator denominator #denominator numerator}) @@ -128,11 +128,11 @@ (def: part-encode (-> Nat Text) - (|>. n/encode (text;split +1) maybe;assume product;right)) + (|>> n/encode (text;split +1) maybe;assume product;right)) (def: part-decode (-> Text (E;Error Nat)) - (|>. (format "+") n/decode)) + (|>> (format "+") n/decode)) (struct: #export _ (Codec Text Ratio) (def: (encode (^slots [#numerator #denominator])) diff --git a/stdlib/source/lux/data/tainted.lux b/stdlib/source/lux/data/tainted.lux index ffe128022..d65e9c56b 100644 --- a/stdlib/source/lux/data/tainted.lux +++ b/stdlib/source/lux/data/tainted.lux @@ -8,11 +8,11 @@ (def: #export taint (All [a] (-> a (Tainted a))) - (|>. @opaque)) + (|>> @opaque)) (def: #export trust (All [a] (-> (Tainted a) a)) - (|>. @repr))) + (|>> @repr))) (def: #export (validate pred tainted) (All [a] (-> (-> a Bool) (Tainted a) (Maybe a))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index d4476b5c2..534901e98 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -185,7 +185,7 @@ (-> (List Text) Text) (let [(^open) list;Fold (^open) Monoid] - (|>. list;reverse (fold text/compose identity)))) + (|>> list;reverse (fold text/compose identity)))) (def: #export (join-with sep texts) (-> Text (List Text) Text) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index d38111d7d..37cb091ee 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -78,9 +78,9 @@ (def: re-range^ (l;Lexer Code) (do p;Monad - [from (|> regex-char^ (:: @ map (|>. (text;nth +0) maybe;assume))) + [from (|> regex-char^ (:: @ map (|>> (text;nth +0) maybe;assume))) _ (l;this "-") - to (|> regex-char^ (:: @ map (|>. (text;nth +0) maybe;assume)))] + to (|> regex-char^ (:: @ map (|>> (text;nth +0) maybe;assume)))] (wrap (` (l;range (~ (code;nat from)) (~ (code;nat to))))))) (def: re-char^ diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 12f6d7abf..76f54d67f 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -343,7 +343,7 @@ (def: (get-import name imports) (-> Text ClassImports (Maybe Text)) (:: maybe;Functor map product;right - (list;find (|>. product;left (text/= name)) + (list;find (|>> product;left (text/= name)) imports))) (def: (add-import short+full imports) diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux index a0d65cc89..49e27aecd 100644 --- a/stdlib/source/lux/lang/syntax.lux +++ b/stdlib/source/lux/lang/syntax.lux @@ -582,7 +582,7 @@ (-> Text Aliases Cursor (l;Lexer [Cursor Code])) (do p;Monad [[value length] ] - (wrap [(update@ #;column (|>. ($_ n/+ length)) where) + (wrap [(update@ #;column (|>> ($_ n/+ length)) where) [where ( value)]])))] [symbol #;Symbol (ident^ current-module aliases) +0] diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 53fe18c82..8040d6ea5 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -433,7 +433,7 @@ (-> Text (Meta Type)) (function [compiler] (let [test (: (-> [Text [Type Top]] Bool) - (|>. product;left (text/= name)))] + (|>> product;left (text/= name)))] (case (do maybe;Monad [scope (list;find (function [env] (or (list;any? test (: (List [Text [Type Top]]) @@ -614,7 +614,7 @@ (#;Some scopes) (#e;Success [compiler - (list/map (|>. (get@ [#;locals #;mappings]) + (list/map (|>> (get@ [#;locals #;mappings]) (list/map (function [[name [type _]]] [name type]))) scopes)])))) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 17a5cdc94..994c719de 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -201,7 +201,7 @@ partial-varI (n/inc partialI) partial-varL (label partial-varI) partialC (` ((~ funcL) (~@ (|> (list;n/range +0 (n/dec num-args)) - (list/map (|>. (n/* +2) n/inc (n/+ funcI) label)) + (list/map (|>> (n/* +2) n/inc (n/+ funcI) label)) list;reverse))))] (recur (n/inc current-arg) (|> env' diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index a82b99814..55927e614 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -111,8 +111,8 @@ (do @ [g!eqs (poly;tuple (p;many Eq)) #let [indices (|> (list;size g!eqs) n/dec (list;n/range +0)) - g!lefts (list/map (|>. nat/encode (text/compose "left") code;local-symbol) indices) - g!rights (list/map (|>. nat/encode (text/compose "right") code;local-symbol) indices)]] + g!lefts (list/map (|>> nat/encode (text/compose "left") code;local-symbol) indices) + g!rights (list/map (|>> nat/encode (text/compose "right") code;local-symbol) indices)]] (wrap (` (: (~ (@Eq inputT)) (function [[(~@ g!lefts)] [(~@ g!rights)]] (and (~@ (|> (list;zip3 g!eqs g!lefts g!rights) @@ -135,13 +135,13 @@ (do @ [[funcC varsC bodyC] (poly;polymorphic Eq)] (wrap (` (: (All [(~@ varsC)] - (-> (~@ (list/map (|>. (~) eq;Eq (`)) varsC)) + (-> (~@ (list/map (|>> (~) eq;Eq (`)) varsC)) (eq;Eq ((~ (poly;to-ast *env* inputT)) (~@ varsC))))) (function (~ funcC) [(~@ varsC)] (~ bodyC)))))) poly;recursive-call ## If all else fails... (|> poly;any - (:: @ map (|>. %type (format "Cannot create Eq for: ") p;fail)) + (:: @ map (|>> %type (format "Cannot create Eq for: ") p;fail)) (:: @ join)) )))) diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index 2870fc63f..edd3efcc2 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -29,7 +29,7 @@ (function [unwrappedT] (if (n/= +1 num-vars) (` (functor;Functor (~ (poly;to-ast *env* unwrappedT)))) - (let [paramsC (|> num-vars n/dec list;indices (L/map (|>. %n code;local-symbol)))] + (let [paramsC (|> num-vars n/dec list;indices (L/map (|>> %n code;local-symbol)))] (` (All [(~@ paramsC)] (functor;Functor ((~ (poly;to-ast *env* unwrappedT)) (~@ paramsC))))))))) Arg (: (-> Code (poly;Poly Code)) @@ -73,7 +73,7 @@ (Arg outL)) #let [inC+ (|> (list;size inT+) n/dec (list;n/range +0) - (L/map (|>. %n (format "\u0000inC") code;local-symbol)))]] + (L/map (|>> %n (format "\u0000inC") code;local-symbol)))]] (wrap (` (function [(~@ inC+)] (let [(~ outL) ((~ valueC) (~@ inC+))] (~ outC)))))) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 02352109a..d001d4839 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -34,7 +34,7 @@ (def: tag (-> Nat Frac) - (|>. nat-to-int int-to-frac)) + (|>> nat-to-int int-to-frac)) (def: #hidden (rec-encode non-rec) (All [a] (-> (-> (-> a JSON) @@ -61,9 +61,9 @@ (|> low frac-to-int int-to-nat)))))) (struct: #hidden _ (Codec JSON Int) - (def: encode (|>. int-to-nat (:: Codec encode))) + (def: encode (|>> int-to-nat (:: Codec encode))) (def: decode - (|>. (:: Codec decode) (:: e;Functor map nat-to-int)))) + (|>> (:: Codec decode) (:: e;Functor map nat-to-int)))) (def: #hidden (nullable writer) {#;doc "Builds a JSON generator for potentially inexistent values."} @@ -76,9 +76,9 @@ (struct: #hidden (Codec carrier) (All [unit] (-> unit (Codec JSON (unit;Qty unit)))) (def: encode - (|>. unit;out (:: Codec encode))) + (|>> unit;out (:: Codec encode))) (def: decode - (|>. (:: Codec decode) (:: e;Functor map (unit;in carrier))))) + (|>> (:: Codec decode) (:: e;Functor map (unit;in carrier))))) (poly: #hidden Codec//encode (with-expansions @@ -89,16 +89,16 @@ ))))] [Unit poly;unit (function [(~ (code;symbol ["" "0"]))] #//;Null)] - [Bool poly;bool (|>. #//;Boolean)] + [Bool poly;bool (|>> #//;Boolean)] [Nat poly;nat (:: ;;Codec (~' encode))] [Int poly;int (:: ;;Codec (~' encode))] - [Frac poly;frac (|>. #//;Number)] - [Text poly;text (|>. #//;String)]) + [Frac poly;frac (|>> #//;Number)] + [Text poly;text (|>> #//;String)])