diff options
Diffstat (limited to 'stdlib/source')
39 files changed, 378 insertions, 391 deletions
diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index a1839850d..aa56aadeb 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -2,7 +2,7 @@ lux (lux (control functor applicative - monad + ["M" monad #+ do Monad] [eq #+ Eq] ["p" parser]) [io #- run] @@ -99,7 +99,7 @@ (All [a] (-> (List (Channel a)) (Channel a))) (let [output (channel ($ +0))] (exec (do &;Monad<Promise> - [_ (mapM @ (function [input] (pipe' input output)) xss)] + [_ (M;map @ (function [input] (pipe' input output)) xss)] (exec (io;run (close output)) (wrap []))) output))) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 4492f955e..cb15c95c9 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -7,7 +7,7 @@ function (control functor applicative - monad + ["M" monad #+ do Monad] ["p" parser]) [macro] (macro ["s" syntax #+ syntax: Syntax]) @@ -69,8 +69,8 @@ succeeded? (atom;compare-and-swap old new promise)] (if succeeded? (do @ - [_ (mapM @ (function [f] (f value)) - (get@ #observers old))] + [_ (M;map @ (function [f] (f value)) + (get@ #observers old))] (wrap true)) (resolve value promise)))))) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index 946f9bac4..27dca629c 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -2,7 +2,7 @@ lux (lux (control functor applicative - monad) + ["M" monad #+ do Monad]) [io #- run] (data (coll [list "L/" Functor<List> Fold<List>] [dict #+ Dict] @@ -121,7 +121,7 @@ [_ (|> old (get@ #observers) dict;values - (mapM @ (function [f] (f new-value))))] + (M;map @ (function [f] (f new-value))))] (wrap [])) (write! new-value var)))) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index 9b908df9a..8f368d191 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -4,7 +4,7 @@ (applicative #as A))) ## [Utils] -(def: (fold f init xs) +(def: (L/fold f init xs) (All [a b] (-> (-> b a a) a (List b) a)) (case xs @@ -12,24 +12,14 @@ init (#;Cons x xs') - (fold f (f x init) xs'))) - -(def: (map f xs) - (All [a b] - (-> (-> a b) (List a) (List b))) - (case xs - #;Nil - #;Nil - - (#;Cons x xs') - (#;Cons (f x) (map f xs')))) + (L/fold f (f x init) xs'))) (def: (reverse xs) (All [a] (-> (List a) (List a))) - (fold (function [head tail] (#;Cons head tail)) - #;Nil - xs)) + (L/fold (function [head tail] (#;Cons head tail)) + #;Nil + xs)) (def: (as-pairs xs) (All [a] (-> (List a) (List [a a]))) @@ -62,18 +52,18 @@ (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) g!join (: Code [_cursor (#;Symbol ["" " join "])]) g!apply (: Code [_cursor (#;Symbol ["" " apply "])]) - body' (fold (: (-> [Code Code] Code Code) - (function [binding body'] - (let [[var value] binding] - (case var - [_ (#;Tag ["" "let"])] - (` (let (~ value) (~ body'))) - - _ - (` (|> (~ value) ((~ g!map) (function [(~ var)] (~ body'))) (~ g!join))) - )))) - body - (reverse (as-pairs bindings)))] + body' (L/fold (: (-> [Code Code] Code Code) + (function [binding body'] + (let [[var value] binding] + (case var + [_ (#;Tag ["" "let"])] + (` (let (~ value) (~ body'))) + + _ + (` (|> (~ value) ((~ g!map) (function [(~ var)] (~ body'))) (~ g!join))) + )))) + body + (reverse (as-pairs bindings)))] (#;Right [state (#;Cons (` (;_lux_case (~ monad) (~' @) (;_lux_case (~' @) @@ -88,7 +78,7 @@ (#;Left "Wrong syntax for do"))) ## [Functions] -(def: #export (seqM monad xs) +(def: #export (seq monad xs) {#;doc "Run all the monadic values in the list and produce a list of the base values."} (All [M a] (-> (Monad M) (List (M a)) (M (List a)))) @@ -99,11 +89,11 @@ (#;Cons x xs') (do monad [_x x - _xs (seqM monad xs')] + _xs (seq monad xs')] (wrap (#;Cons _x _xs))) )) -(def: #export (mapM monad f xs) +(def: #export (map monad f xs) {#;doc "Apply a monad-producing function to all values in a list."} (All [M a b] (-> (Monad M) (-> a (M b)) (List a) (M (List b)))) @@ -114,11 +104,11 @@ (#;Cons x xs') (do monad [_x (f x) - _xs (mapM monad f xs')] + _xs (map monad f xs')] (wrap (#;Cons _x _xs))) )) -(def: #export (foldM monad f init xs) +(def: #export (fold monad f init xs) {#;doc "Fold a list with a monad-producing function."} (All [M a b] (-> (Monad M) (-> b a (M a)) a (List b) @@ -130,9 +120,9 @@ (#;Cons x xs') (do monad [init' (f x init)] - (foldM monad f init' xs')))) + (fold monad f init' xs')))) -(def: #export (liftM Monad<M> f) +(def: #export (lift Monad<M> f) {#;doc "Lift a normal function into the space of monads."} (All [M a b] (-> (Monad M) (-> a b) (-> (M a) (M b)))) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 1e25032a8..e2c522188 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -2,7 +2,7 @@ [lux #- not default] (lux (control functor applicative - monad) + ["M" monad #+ do Monad]) (data (coll [list "L/" Functor<List> Monoid<List>]) [product] ["R" result]))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 3ed2bcbfc..e74ca1f06 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -1,9 +1,8 @@ (;module: {#;doc "Composable extensions to the piping macro |> that enhance it with various abilities."} lux - (lux (control monad + (lux (control ["M" monad #+ do Monad] ["p" parser]) - (data (coll [list #+ Monad<List> "" Fold<List> "List/" Monad<List>]) - maybe) + (data (coll [list #+ Monad<List> "L/" Fold<List> Monad<List>])) [macro #+ with-gensyms Monad<Lux>] (macro ["s" syntax #+ syntax: Syntax] [code]) @@ -37,12 +36,12 @@ (|> 5 (@> [(i.+ @ @)])))} - (wrap (list (fold (function [next prev] - (` (with-expansions - [(~ (code;symbol ["" name])) (~ prev)] - (~ next)))) - prev - body)))) + (wrap (list (L/fold (function [next prev] + (` (with-expansions + [(~ (code;symbol ["" name])) (~ prev)] + (~ next)))) + prev + body)))) (syntax: #export (?> [branches (p;many (p;seq body^ body^))] [?else (p;opt body^)] @@ -125,8 +124,8 @@ (do @ [g!temp (macro;gensym "")] (wrap (list (` (let [(~ g!temp) (~ prev)] - [(~@ (List/map (function [body] (` (|> (~ g!temp) (~@ body)))) - paths))])))))) + [(~@ (L/map (function [body] (` (|> (~ g!temp) (~@ body)))) + paths))])))))) (syntax: #export (case> [branches (p;many (p;seq s;any s;any))] prev) {#;doc (doc "Pattern-matching for pipes." @@ -143,7 +142,6 @@ 8 "eight" 9 "nine" _ "???")))} - (let [(^open "List/") Monad<List>] - (wrap (list (` (case (~ prev) - (~@ (List/join (List/map (function [[pattern body]] (list pattern body)) - branches))))))))) + (wrap (list (` (case (~ prev) + (~@ (L/join (L/map (function [[pattern body]] (list pattern body)) + branches)))))))) diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux index b63504294..21537c31b 100644 --- a/stdlib/source/lux/control/reader.lux +++ b/stdlib/source/lux/control/reader.lux @@ -2,7 +2,7 @@ lux (lux (control functor applicative - ["M" monad #*]))) + [monad #+ do Monad]))) ## [Types] (type: #export (Reader r a) @@ -50,7 +50,7 @@ (struct: #export (ReaderT Monad<M>) {#;doc "Monad transformer for Reader."} (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) - (def: applicative (compA Applicative<Reader> (get@ #M;applicative Monad<M>))) + (def: applicative (compA Applicative<Reader> (get@ #monad;applicative Monad<M>))) (def: (join eMeMa) (function [env] (do Monad<M> diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux index 9c6dd2922..3400ed07b 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -2,7 +2,7 @@ lux (lux (control functor ["A" applicative #*] - ["M" monad #*]))) + [monad #+ do Monad]))) ## [Types] (type: #export (State s a) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 41f1cddaf..0098b3b90 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -3,7 +3,7 @@ (lux (control monoid functor applicative - ["M" monad #*] + ["M" monad #+ do Monad] [eq #+ Eq] [fold]) (data [number "Nat/" Codec<Text,Nat>] @@ -483,12 +483,12 @@ (do Monad<M> [lMla MlMla lla (: (($ +0) (List (List ($ +1)))) - (seqM @ lMla))] + (M;seq @ lMla))] (wrap (concat lla))))) (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (List a))))) - (liftM Monad<M> (:: Monad<List> wrap))) + (M;lift Monad<M> (:: Monad<List> wrap))) (def: (enumerate' idx xs) (All [a] (-> Nat (List a) (List [Nat a]))) diff --git a/stdlib/source/lux/data/coll/ordered/dict.lux b/stdlib/source/lux/data/coll/ordered/dict.lux index 714f14b5d..d0d1e20cc 100644 --- a/stdlib/source/lux/data/coll/ordered/dict.lux +++ b/stdlib/source/lux/data/coll/ordered/dict.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control monad + (lux (control [monad #+ do Monad] eq [order #+ Order]) (data (coll [list "L/" Monad<List> Monoid<List> Fold<List>]) diff --git a/stdlib/source/lux/data/coll/ordered/set.lux b/stdlib/source/lux/data/coll/ordered/set.lux index 1ee2861e8..376624033 100644 --- a/stdlib/source/lux/data/coll/ordered/set.lux +++ b/stdlib/source/lux/data/coll/ordered/set.lux @@ -1,9 +1,9 @@ (;module: lux - (lux (control monad + (lux (control [monad #+ do Monad] eq [order #+ Order]) - (data (coll [list "" Monad<List> "L/" Monoid<List> Fold<List>] + (data (coll [list "L/" Monad<List> Monoid<List> Fold<List>] (ordered ["d" dict])) ["p" product] ["M" maybe #+ Functor<Maybe>]) diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux index 00c655d8e..b85b184fc 100644 --- a/stdlib/source/lux/data/coll/priority-queue.lux +++ b/stdlib/source/lux/data/coll/priority-queue.lux @@ -1,10 +1,10 @@ (;module: lux (lux (control [eq #+ Eq] - monad) + [monad #+ do Monad]) (data (coll (tree ["F" finger])) [number] - maybe))) + [maybe]))) (type: #export Priority Nat) @@ -20,7 +20,7 @@ (def: #export (peek queue) (All [a] (-> (Queue a) (Maybe a))) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [fingers queue] (wrap (default (undefined) (F;search (n.= (F;tag fingers)) fingers))))) @@ -58,7 +58,7 @@ (def: #export (pop queue) (All [a] (-> (Queue a) (Queue a))) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [fingers queue #let [highest-priority (F;tag fingers)] node' (loop [node (get@ #F;tree fingers)] diff --git a/stdlib/source/lux/data/coll/seq.lux b/stdlib/source/lux/data/coll/seq.lux index 9c981b6aa..e61845ac0 100644 --- a/stdlib/source/lux/data/coll/seq.lux +++ b/stdlib/source/lux/data/coll/seq.lux @@ -2,14 +2,14 @@ lux (lux (control functor applicative - monad + [monad #+ do Monad] [eq #+ Eq] fold ["p" parser]) (data (coll ["L" list "L/" Monoid<List> Fold<List>] (tree ["F" finger])) [number] - maybe) + [maybe]) [macro] (macro [code] ["s" syntax #+ syntax: Syntax]))) @@ -27,7 +27,7 @@ (do-template [<name> <side>] [(def: #export (<name> seq) (All [a] (-> (Seq a) (Maybe a))) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [fingers seq] (wrap (loop [node (get@ #F;tree fingers)] (case node @@ -73,7 +73,7 @@ (def: #export (nth idx seq) (All [a] (-> Nat (Seq a) (Maybe a))) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [fingers seq] (F;search (n.> idx) fingers))) @@ -106,7 +106,7 @@ (def: #export (from-list xs) (All [a] (-> (List a) (Seq a))) (loop [xs xs] - (do Monad<Maybe> + (do maybe;Monad<Maybe> [[_ tree] (loop [xs xs] (case xs #;Nil @@ -130,7 +130,7 @@ (def: #export (reverse seq) (All [a] (-> (Seq a) (Seq a))) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [fingers seq #let [node' (loop [node (get@ #F;tree fingers)] (case node @@ -186,7 +186,7 @@ {#;doc "Returns the first value in the sequence for which the predicate is true."} (All [a] (-> (-> a Bool) (Seq a) (Maybe a))) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [fingers seq] (loop [seq (get@ #F;tree fingers)] (case seq @@ -231,7 +231,7 @@ (struct: #export _ (Functor Seq) (def: (map f ma) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [fingers ma] (wrap {#F;monoid number;Add@Monoid<Nat> #F;tree (loop [tree (get@ #F;tree fingers)] @@ -248,7 +248,7 @@ (def: wrap (|>. new #;Some)) (def: (apply ff fa) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [ff' ff] (case (get@ #F;tree ff') (#F;Leaf tag f) @@ -264,7 +264,7 @@ (def: applicative Applicative<Seq>) (def: (join ffa) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [ffa' ffa] (case (get@ #F;tree ffa') (#F;Leaf tag fa) diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux index b4ac0c313..546982dba 100644 --- a/stdlib/source/lux/data/coll/tree/rose.lux +++ b/stdlib/source/lux/data/coll/tree/rose.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control functor - monad + [monad #+ do Monad] eq ["p" parser] fold) diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux index 5f7a91640..c9d223736 100644 --- a/stdlib/source/lux/data/coll/vector.lux +++ b/stdlib/source/lux/data/coll/vector.lux @@ -2,12 +2,12 @@ lux (lux (control functor applicative - monad + ["M" monad #+ do Monad] [eq #+ Eq] monoid fold ["p" parser]) - (data maybe + (data [maybe] (coll [list "List/" Fold<List> Functor<List> Monoid<List>] [array #+ Array "Array/" Functor<Array> Fold<Array>]) [bit] @@ -145,7 +145,7 @@ #;None (n.> branching-exponent level) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [base|hierarchy (array;get sub-idx hierarchy) sub (case base|hierarchy (#Hierarchy sub) @@ -252,7 +252,7 @@ (def: #export (nth idx vec) (All [a] (-> Nat (Vector a) (Maybe a))) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [base (base-for idx vec)] (array;get (branch-idx idx) base))) @@ -296,7 +296,7 @@ (set@ #tail (|> (array;new new-tail-size) (array;copy new-tail-size +0 old-tail +0))))) (default (undefined) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [new-tail (base-for (n.- +2 vec-size) vec) #let [[level' root'] (: [Level (Hierarchy ($ +0))] (let [init-level (get@ #level vec)] diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 61a104555..6d7ed16a7 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -4,7 +4,7 @@ lux (lux (control functor applicative - monad + ["M" monad #+ do Monad] [eq #+ Eq] codec ["p" parser "p/" Monad<Parser>]) @@ -90,15 +90,15 @@ [_ (#;Record pairs)] (do Monad<Lux> - [pairs' (mapM @ - (function [[slot value]] - (case slot - [_ (#;Text key-name)] - (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) - - _ - (macro;fail "Wrong syntax for JSON object."))) - pairs)] + [pairs' (M;map @ + (function [[slot value]] + (case slot + [_ (#;Text key-name)] + (wrap (` [(~ (code;text key-name)) (~ (wrapper value))])) + + _ + (macro;fail "Wrong syntax for JSON object."))) + pairs)] (wrap (list (` (: JSON (#Object (d;from-list text;Hash<Text> (list (~@ pairs'))))))))) _ @@ -449,7 +449,7 @@ (case json (#Array values) (do R;Monad<Result> - [elems (mapM @ parser (vector;to-list values))] + [elems (M;map @ parser (vector;to-list values))] (wrap elems)) _ @@ -462,12 +462,12 @@ (case json (#Object fields) (do R;Monad<Result> - [kvs (mapM @ - (function [[key val']] - (do @ - [val (parser val')] - (wrap [key val]))) - (d;entries fields))] + [kvs (M;map @ + (function [[key val']] + (do @ + [val (parser val')] + (wrap [key val]))) + (d;entries fields))] (wrap (d;from-list text;Hash<Text> kvs))) _ @@ -761,14 +761,14 @@ (with-gensyms [g!type-fun g!case g!input] (do @ [members (poly;sum+ :x:) - pattern-matching (mapM @ - (function [[tag :case:]] - (do @ - [g!encode (Codec<JSON,?>//encode env :case:)] - (wrap (list (` ((~ (code;nat tag)) (~ g!case))) - (` (;;json [(~ (code;int (nat-to-int tag))) - ((~ g!encode) (~ g!case))])))))) - (list;enumerate members))] + pattern-matching (M;map @ + (function [[tag :case:]] + (do @ + [g!encode (Codec<JSON,?>//encode env :case:)] + (wrap (list (` ((~ (code;nat tag)) (~ g!case))) + (` (;;json [(~ (code;int (nat-to-int tag))) + ((~ g!encode) (~ g!case))])))))) + (list;enumerate members))] (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:))) (function [(~ g!input)] (case (~ g!input) @@ -779,15 +779,15 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [[name :case:]] - (do @ - [#let [tag (code;tag name)] - encoder (Codec<JSON,?>//encode new-env :case:)] - (wrap (list (` ((~ tag) (~ g!case))) - (` (;;json [(~ (code;text (product;right name))) - ((~ encoder) (~ g!case))])))))) - members) + pattern-matching (M;map @ + (function [[name :case:]] + (do @ + [#let [tag (code;tag name)] + encoder (Codec<JSON,?>//encode new-env :case:)] + (wrap (list (` ((~ tag) (~ g!case))) + (` (;;json [(~ (code;text (product;right name))) + ((~ encoder) (~ g!case))])))))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//encode (poly;to-ast env :x:)) @@ -807,13 +807,13 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - synthesis (mapM @ - (function [[name :slot:]] - (do @ - [encoder (Codec<JSON,?>//encode new-env :slot:)] - (wrap [(` (~ (code;text (product;right name)))) - (` ((~ encoder) (get@ (~ (code;tag name)) (~ g!input))))]))) - members) + synthesis (M;map @ + (function [[name :slot:]] + (do @ + [encoder (Codec<JSON,?>//encode new-env :slot:)] + (wrap [(` (~ (code;text (product;right name)))) + (` ((~ encoder) (get@ (~ (code;tag name)) (~ g!input))))]))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//encode (poly;to-ast env :x:)) @@ -832,13 +832,13 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [:member:] - (do @ - [g!member (macro;gensym "g!member") - encoder (Codec<JSON,?>//encode new-env :member:)] - (wrap [g!member encoder]))) - members) + pattern-matching (M;map @ + (function [:member:] + (do @ + [g!member (macro;gensym "g!member") + encoder (Codec<JSON,?>//encode new-env :member:)] + (wrap [g!member encoder]))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//encode (poly;to-ast env :x:)) @@ -870,7 +870,7 @@ (do @ [[:func: :args:] (poly;apply :x:) .func. (Codec<JSON,?>//encode env :func:) - .args. (mapM @ (Codec<JSON,?>//encode env) :args:)] + .args. (M;map @ (Codec<JSON,?>//encode env) :args:)] (wrap (` (: (~ (->Codec//encode (poly;to-ast env :x:))) ((~ .func.) (~@ .args.)))))) ## Bound type-vars @@ -918,13 +918,13 @@ (function [(~ g!input)] (do R;Monad<Result> [(~ g!key) (;;fields (~ g!input)) - (~ g!output) (mapM R;Monad<Result> - (function [(~ g!key)] - (do R;Monad<Result> - [(~ g!val) (;;get (~ g!key) (~ g!input)) - (~ g!val) (;;run (~ g!val) (~ .val.))] - ((~ (' wrap)) [(~ g!key) (~ g!val)]))) - (~ g!key))] + (~ g!output) (M;map R;Monad<Result> + (function [(~ g!key)] + (do R;Monad<Result> + [(~ g!val) (;;get (~ g!key) (~ g!input)) + (~ g!val) (;;run (~ g!val) (~ .val.))] + ((~ (' wrap)) [(~ g!key) (~ g!val)]))) + (~ g!key))] ((~' wrap) (d;from-list text;Hash<Text> (~ g!output))))) ))) )) @@ -932,15 +932,15 @@ (with-gensyms [g!type-fun g!case g!input g!_] (do @ [members (poly;sum+ :x:) - pattern-matching (mapM @ - (function [[tag :case:]] - (do @ - [g!decode (Codec<JSON,?>//decode env :case:)] - (wrap (list (` (do Monad<Parser> - [(~ g!_) (;;nth +0 (;;int! (~ (code;int (nat-to-int tag))))) - (~ g!_) (;;nth +1 (~ g!decode))] - ((~' wrap) ((~ (code;nat tag)) (~ g!_))))))))) - (list;enumerate members))] + pattern-matching (M;map @ + (function [[tag :case:]] + (do @ + [g!decode (Codec<JSON,?>//decode env :case:)] + (wrap (list (` (do Monad<Parser> + [(~ g!_) (;;nth +0 (;;int! (~ (code;int (nat-to-int tag))))) + (~ g!_) (;;nth +1 (~ g!decode))] + ((~' wrap) ((~ (code;nat tag)) (~ g!_))))))))) + (list;enumerate members))] (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:))) ($_ ;;either (~@ (L/join pattern-matching)))))))) @@ -950,16 +950,16 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [[name :case:]] - (do @ - [#let [tag (code;tag name)] - decoder (Codec<JSON,?>//decode new-env :case:)] - (wrap (list (` (do Monad<Parser> - [(~ g!_) (;;nth +0 (;;text! (~ (code;text (product;right name))))) - (~ g!_) (;;nth +1 (~ decoder))] - ((~ (' wrap)) ((~ tag) (~ g!_))))))))) - members) + pattern-matching (M;map @ + (function [[name :case:]] + (do @ + [#let [tag (code;tag name)] + decoder (Codec<JSON,?>//decode new-env :case:)] + (wrap (list (` (do Monad<Parser> + [(~ g!_) (;;nth +0 (;;text! (~ (code;text (product;right name))))) + (~ g!_) (;;nth +1 (~ decoder))] + ((~ (' wrap)) ((~ tag) (~ g!_))))))))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//decode (poly;to-ast env :x:)) @@ -984,16 +984,16 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - extraction (mapM @ - (function [[name :slot:]] - (do @ - [#let [g!member (code;symbol ["" (product;right name)])] - decoder (Codec<JSON,?>//decode new-env :slot:)] - (wrap (list g!member - (` (;;get (~ (code;text (product;right name))) (~ g!input))) - g!member - (` ((~ decoder) (~ g!member))))))) - members) + extraction (M;map @ + (function [[name :slot:]] + (do @ + [#let [g!member (code;symbol ["" (product;right name)])] + decoder (Codec<JSON,?>//decode new-env :slot:)] + (wrap (list g!member + (` (;;get (~ (code;text (product;right name))) (~ g!input))) + g!member + (` ((~ decoder) (~ g!member))))))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//decode (poly;to-ast env :x:)) @@ -1016,13 +1016,13 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [:member:] - (do @ - [g!member (macro;gensym "g!member") - decoder (Codec<JSON,?>//decode new-env :member:)] - (wrap [g!member decoder]))) - members) + pattern-matching (M;map @ + (function [:member:] + (do @ + [g!member (macro;gensym "g!member") + decoder (Codec<JSON,?>//decode new-env :member:)] + (wrap [g!member decoder]))) + members) #let [:x:+ (case g!vars #;Nil (->Codec//decode (poly;to-ast env :x:)) @@ -1055,7 +1055,7 @@ (do @ [[:func: :args:] (poly;apply :x:) .func. (Codec<JSON,?>//decode env :func:) - .args. (mapM @ (Codec<JSON,?>//decode env) :args:)] + .args. (M;map @ (Codec<JSON,?>//decode env) :args:)] (wrap (` (: (~ (->Codec//decode (poly;to-ast env :x:))) ((~ .func.) (~@ .args.)))))) ## Bound type-vars diff --git a/stdlib/source/lux/data/log.lux b/stdlib/source/lux/data/log.lux index 896f19e94..19753199f 100644 --- a/stdlib/source/lux/data/log.lux +++ b/stdlib/source/lux/data/log.lux @@ -3,7 +3,7 @@ (lux/control monoid ["A" applicative #*] functor - ["M" monad #*])) + [monad #+ do Monad])) (type: #export (Log l a) {#;doc "Represents a value with an associated 'log' value to record arbitrary information."} @@ -43,7 +43,7 @@ (struct: #export (LogT Monoid<l> Monad<M>) (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Log l a)))))) - (def: applicative (A;compA (get@ #M;applicative Monad<M>) (Applicative<Log> Monoid<l>))) + (def: applicative (A;compA (get@ #monad;applicative Monad<M>) (Applicative<Log> Monoid<l>))) (def: (join MlMla) (do Monad<M> [[l1 Mla] (: (($ +1) (Log ($ +0) (($ +1) (Log ($ +0) ($ +2))))) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index e8404544f..9cf80d4a8 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -3,7 +3,7 @@ (lux (control (monoid #as m #refer #all) (functor #as F #refer #all) (applicative #as A #refer #all) - (monad #as M #refer #all) + ["M" monad #+ do Monad] [eq #+ Eq]))) ## [Types] @@ -74,4 +74,4 @@ (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) - (liftM Monad<M> (:: Monad<Maybe> wrap))) + (M;lift Monad<M> (:: Monad<Maybe> wrap))) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 09d596bc3..a3a2fe217 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -4,14 +4,14 @@ (control [eq #+ Eq] number codec - monad + ["M" monad #+ do Monad] ["p" parser]) (data [number "r/" Number<Real> Codec<Text,Real>] - [text "Text/" Monoid<Text>] + [text "text/" Monoid<Text>] text/format ["R" result] - maybe - (coll [list "List/" Monad<List>])) + [maybe] + (coll [list "L/" Monad<List>])) [macro] (macro [code] ["s" syntax #+ syntax: Syntax]))) @@ -300,27 +300,27 @@ nth-phi (|> input argument (r./ r-nth)) slice (|> math;pi (r.* 2.0) (r./ r-nth))] (|> (list;n.range +0 (n.dec nth)) - (List/map (function [nth'] - (let [inner (|> nth' nat-to-int int-to-real - (r.* slice) - (r.+ nth-phi)) - real (r.* nth-root-of-abs - (math;cos inner)) - imaginary (r.* nth-root-of-abs - (math;sin inner))] - {#real real - #imaginary imaginary}))))))) + (L/map (function [nth'] + (let [inner (|> nth' nat-to-int int-to-real + (r.* slice) + (r.+ nth-phi)) + real (r.* nth-root-of-abs + (math;cos inner)) + imaginary (r.* nth-root-of-abs + (math;sin inner))] + {#real real + #imaginary imaginary}))))))) (struct: #export _ (Codec Text Complex) (def: (encode (^slots [#real #imaginary])) - ($_ Text/append "(" (r/encode real) ", " (r/encode imaginary) ")")) + ($_ text/append "(" (r/encode real) ", " (r/encode imaginary) ")")) (def: (decode input) - (case (do Monad<Maybe> + (case (do maybe;Monad<Maybe> [input' (text;clip +1 (n.- +1 (text;size input)) input)] (text;split-with "," input')) #;None - (#;Left (Text/append "Wrong syntax for complex numbers: " input)) + (#;Left (text/append "Wrong syntax for complex numbers: " input)) (#;Some [r' i']) (do R;Monad<Result> diff --git a/stdlib/source/lux/data/result.lux b/stdlib/source/lux/data/result.lux index 99c52e664..791bdee48 100644 --- a/stdlib/source/lux/data/result.lux +++ b/stdlib/source/lux/data/result.lux @@ -2,7 +2,7 @@ [lux #- assume] (lux (control functor applicative - ["M" monad #*]))) + ["M" monad #+ do Monad]))) ## [Types] (type: #export (Result a) @@ -59,7 +59,7 @@ (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (Result a))))) - (liftM Monad<M> (:: Monad<Result> wrap))) + (M;lift Monad<M> (:: Monad<Result> wrap))) (def: #export (succeed value) (All [a] (-> a (Result a))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 13e57aa21..2819e9c16 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -3,11 +3,11 @@ (lux (control monoid [eq #+ Eq] [order] - monad + ["M" monad #+ do Monad] codec hash) (data (coll [list]) - maybe))) + [maybe]))) ## [Functions] (def: #export (size x) @@ -86,7 +86,7 @@ (def: #export (split-with token sample) (-> Text Text (Maybe [Text Text])) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [index (index-of' token sample) [pre post'] (split index sample) [_ post] (split (size token) post')] @@ -173,7 +173,7 @@ (def: #export (replace-once pattern value template) (-> Text Text Text Text) (default template - (do Monad<Maybe> + (do maybe;Monad<Maybe> [[pre post] (split-with pattern template)] (let [(^open) Monoid<Text>] (wrap ($_ append pre value post)))))) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 2dcd3f37f..61a8600cb 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -1,12 +1,12 @@ (;module: lux - (lux (control monad + (lux (control ["M" monad #+ do Monad] ["p" parser]) (data [bool] [number] [text] [ident] - (coll [list "" Monad<List>])) + (coll [list "L/" Monad<List>])) [type] [macro] (macro [code] @@ -54,4 +54,4 @@ "(list)" _ - (format "(list " (text;join-with " " (map formatter values)) ")")))) + (format "(list " (text;join-with " " (L/map formatter values)) ")")))) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 52c59d862..f30e09c94 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -2,13 +2,13 @@ [lux #- not] (lux (control functor applicative - monad + [monad #+ do Monad] codec ["p" parser]) (data [text "T/" Order<Text>] text/format [product] - maybe + [maybe] ["R" result] (coll [list "L/" Functor<List>])))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 50bd66a6d..058f34555 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control monad + (lux (control ["M" monad #+ do Monad] [enum] ["p" parser]) [io #+ IO Monad<IO> io] @@ -1575,14 +1575,14 @@ (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] (do Monad<Lux> - [arg-inputs (mapM @ - (: (-> [Bool GenericType] (Lux [Code Code])) - (function [[maybe? _]] - (with-gensyms [arg-name] - (wrap [arg-name (if maybe? - (` (!!! (~ arg-name))) - arg-name)])))) - import-member-args) + [arg-inputs (M;map @ + (: (-> [Bool GenericType] (Lux [Code Code])) + (function [[maybe? _]] + (with-gensyms [arg-name] + (wrap [arg-name (if maybe? + (` (!!! (~ arg-name))) + arg-name)])))) + import-member-args) #let [arg-classes (: (List Text) (L/map (. (simple-class$ (L/append type-params import-member-tvars)) product;right) import-member-args)) @@ -1970,7 +1970,7 @@ )} (do Monad<Lux> [kind (class-kind class-decl) - =members (mapM @ (member-import$ (product;right class-decl) long-name? kind class-decl) members)] + =members (M;map @ (member-import$ (product;right class-decl) long-name? kind class-decl) members)] (wrap (list& (class-import$ long-name? class-decl) (L/join =members))))) (syntax: #export (array [#let [imports (class-imports *compiler*)]] diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index d15c75729..11b97f0a7 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -2,8 +2,8 @@ lux (lux (control functor applicative - monad) - (data (coll list)))) + ["M" monad #+ do Monad]) + (data (coll [list])))) ## [Types] (type: #export (IO a) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index a888e6fe8..88e2b4d91 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -3,7 +3,7 @@ (lux (macro [code]) (control functor applicative - monad) + ["M" monad #+ do Monad]) (data (coll [list "L/" Monoid<List> Monad<List>]) [number] [text "T/" Monoid<Text> Eq<Text>] @@ -226,7 +226,7 @@ (do Monad<Maybe> [_args (get-ann (ident-for <tag>) anns) args (try-mlist _args)] - (mapM @ try-mtext args))))] + (M;map @ try-mtext args))))] [func-args #;func-args "function"] [type-args #;type-args "parameterized type"] @@ -305,7 +305,7 @@ (#;Some macro) (do Monad<Lux> [expansion (macro args) - expansion' (mapM Monad<Lux> expand expansion)] + expansion' (M;map Monad<Lux> expand expansion)] (wrap (L/join expansion'))) #;None @@ -326,23 +326,23 @@ (#;Some macro) (do Monad<Lux> [expansion (macro args) - expansion' (mapM Monad<Lux> expand-all expansion)] + expansion' (M;map Monad<Lux> expand-all expansion)] (wrap (L/join expansion'))) #;None (do Monad<Lux> - [parts' (mapM Monad<Lux> expand-all (list& (code;symbol name) args))] + [parts' (M;map Monad<Lux> expand-all (list& (code;symbol name) args))] (wrap (list (code;form (L/join parts'))))))) [_ (#;Form (#;Cons [harg targs]))] (do Monad<Lux> [harg+ (expand-all harg) - targs+ (mapM Monad<Lux> expand-all targs)] + targs+ (M;map Monad<Lux> expand-all targs)] (wrap (list (code;form (L/append harg+ (L/join (: (List (List Code)) targs+))))))) [_ (#;Tuple members)] (do Monad<Lux> - [members' (mapM Monad<Lux> expand-all members)] + [members' (M;map Monad<Lux> expand-all members)] (wrap (list (code;tuple (L/join members'))))) _ @@ -379,7 +379,7 @@ (case tokens (^ (list [_ (#;Tuple symbols)] body)) (do Monad<Lux> - [symbol-names (mapM @ get-local-symbol symbols) + [symbol-names (M;map @ get-local-symbol symbols) #let [symbol-defs (L/join (L/map (: (-> Text (List Code)) (function [name] (list (code;symbol ["" name]) (` (gensym (~ (code;text name))))))) symbol-names))]] diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index e2a438b00..b1031296b 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -1,6 +1,6 @@ (;module: [lux #- function] - (lux (control monad + (lux (control ["M" monad #+ do Monad] [eq] ["p" parser]) (data [text] @@ -258,14 +258,14 @@ (n.= +0 (adjusted-idx env t-func-idx)) [(do maybe;Monad<Maybe> [=func (dict;get +0 env) - =args (mapM @ (;function [t-arg] - (case t-arg - (#;Bound idx) - (dict;get (adjusted-idx env idx) env) - - _ - #;None)) - t-args)] + =args (M;map @ (;function [t-arg] + (case t-arg + (#;Bound idx) + (dict;get (adjusted-idx env idx) env) + + _ + #;None)) + t-args)] (wrap (` ((~ (product;right =func)) (~@ (List/map product;right =args)))))) (#;Some call)]) (wrap call) @@ -353,7 +353,7 @@ [[poly-func poly-args] (s;form (p;seq s;symbol (p;many s;symbol)))] [?custom-impl (p;opt s;any)]) (do @ - [poly-args (mapM @ macro;normalize poly-args) + [poly-args (M;map @ macro;normalize poly-args) name (case ?name (#;Some name) (wrap name) diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux index c9a58a6f5..0c36d307e 100644 --- a/stdlib/source/lux/macro/poly/eq.lux +++ b/stdlib/source/lux/macro/poly/eq.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control monad + (lux (control ["M" monad #+ do Monad] [eq]) (data [text] text/format @@ -83,14 +83,14 @@ (with-gensyms [g!type-fun g!left g!right] (do @ [members (poly;sum+ :x:) - pattern-matching (mapM @ - (function [[tag :case:]] - (do @ - [g!eq (Eq<?> env :case:)] - (wrap (list (` [((~ (code;nat tag)) (~ g!left)) - ((~ (code;nat tag)) (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))) - (list;enumerate members)) + pattern-matching (M;map @ + (function [[tag :case:]] + (do @ + [g!eq (Eq<?> env :case:)] + (wrap (list (` [((~ (code;nat tag)) (~ g!left)) + ((~ (code;nat tag)) (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))) + (list;enumerate members)) #let [base (` (function [(~ g!left) (~ g!right)] (case [(~ g!left) (~ g!right)] (~@ (List/join pattern-matching)))))]] @@ -102,14 +102,14 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [[name :case:]] - (do @ - [g!eq (Eq<?> new-env :case:)] - (wrap (list (` [((~ (code;tag name)) (~ g!left)) - ((~ (code;tag name)) (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))) - members) + pattern-matching (M;map @ + (function [[name :case:]] + (do @ + [g!eq (Eq<?> new-env :case:)] + (wrap (list (` [((~ (code;tag name)) (~ g!left)) + ((~ (code;tag name)) (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))) + members) #let [base (function$ g!type-fun g!vars (` (function [(~ g!left) (~ g!right)] (case [(~ g!left) (~ g!right)] @@ -123,14 +123,14 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [:member:] - (do @ - [g!left (macro;gensym "g!left") - g!right (macro;gensym "g!right") - g!eq (Eq<?> new-env :member:)] - (wrap [g!left g!right g!eq]))) - members) + pattern-matching (M;map @ + (function [:member:] + (do @ + [g!left (macro;gensym "g!left") + g!right (macro;gensym "g!right") + g!eq (Eq<?> new-env :member:)] + (wrap [g!left g!right g!eq]))) + members) #let [.left. (` [(~@ (List/map product;left pattern-matching))]) .right. (` [(~@ (List/map (|>. product;right product;left) pattern-matching))]) base (function$ g!type-fun g!vars @@ -155,7 +155,7 @@ (do @ [[:func: :args:] (poly;apply :x:) .func. (Eq<?> env :func:) - .args. (mapM @ (Eq<?> env) :args:)] + .args. (M;map @ (Eq<?> env) :args:)] (wrap (` (: (~ (->Eq (type;to-ast :x:))) ((~ .func.) (~@ .args.)))))) ## Bound type-vars diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux index 2272d38da..5212ad150 100644 --- a/stdlib/source/lux/macro/poly/functor.lux +++ b/stdlib/source/lux/macro/poly/functor.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control monad + (lux (control ["M" monad #+ do Monad] [functor]) (data [text] text/format @@ -30,7 +30,7 @@ (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] _ (macro;assert "Functors must have at least 1 type-variable." - (n.> +0 num-vars))] + (n.> +0 num-vars))] (let [->Functor (: (-> Code Code) (function [.type.] (if (n.= +1 num-vars) @@ -55,13 +55,13 @@ ## Tuples/records (do @ [[g!vars members] (poly;tuple :type:) - pm (mapM @ - (function [:slot:] - (do @ - [g!slot (macro;gensym "g!slot") - body (Arg<?> g!slot :slot:)] - (wrap [g!slot body]))) - members)] + pm (M;map @ + (function [:slot:] + (do @ + [g!slot (macro;gensym "g!slot") + body (Arg<?> g!slot :slot:)] + (wrap [g!slot body]))) + members)] (wrap (` (case (~ value) [(~@ (List/map product;left pm))] [(~@ (List/map product;right pm))]) @@ -75,14 +75,14 @@ ## Variants (do @ [[g!vars cases] (poly;variant :x:) - pattern-matching (mapM @ - (function [[name :case:]] - (do @ - [#let [analysis (` ((~ (code;tag name)) (~ g!input)))] - synthesis (Arg<?> g!input :case:)] - (wrap (list analysis - (` ((~ (code;tag name)) (~ synthesis))))))) - cases)] + pattern-matching (M;map @ + (function [[name :case:]] + (do @ + [#let [analysis (` ((~ (code;tag name)) (~ g!input)))] + synthesis (Arg<?> g!input :case:)] + (wrap (list analysis + (` ((~ (code;tag name)) (~ synthesis))))))) + cases)] (wrap (` (: (~ (->Functor (type;to-ast :x:))) (struct (def: ((~ g!map) (~ g!func) (~ g!input)) (case (~ g!input) @@ -91,13 +91,13 @@ ## Tuples/Records (do @ [[g!vars members] (poly;tuple :x:) - pm (mapM @ - (function [:slot:] - (do @ - [g!slot (macro;gensym "g!slot") - body (Arg<?> g!slot :slot:)] - (wrap [g!slot body]))) - members)] + pm (M;map @ + (function [:slot:] + (do @ + [g!slot (macro;gensym "g!slot") + body (Arg<?> g!slot :slot:)] + (wrap [g!slot body]))) + members)] (wrap (` (: (~ (->Functor (type;to-ast :x:))) (struct (def: ((~ g!map) (~ g!func) (~ g!input)) (case (~ g!input) @@ -109,9 +109,9 @@ (do @ [[g!vars [:ins: :out:]] (poly;function :x:) .out. (Arg<?> g!out :out:) - g!envs (seqM @ - (list;repeat (list;size :ins:) - (macro;gensym "g!envs")))] + g!envs (M;seq @ + (list;repeat (list;size :ins:) + (macro;gensym "g!envs")))] (wrap (` (: (~ (->Functor (type;to-ast :x:))) (struct (def: ((~ g!map) (~ g!func) (~ g!input)) (function [(~@ g!envs)] diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux index 27b26d1af..e66bfc680 100644 --- a/stdlib/source/lux/macro/poly/text-encoder.lux +++ b/stdlib/source/lux/macro/poly/text-encoder.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control monad + (lux (control ["M" monad #+ do Monad] [codec]) (data [text] text/format @@ -58,17 +58,17 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - pattern-matching (mapM @ - (function [[name :case:]] - (do @ - [encoder (Codec<Text,?>::encode new-env :case:)] - (wrap (list (` ((~ (code;tag name)) (~ g!case))) - (` (format "(#" - (~ (code;text (Ident/encode name))) - " " - ((~ encoder) (~ g!case)) - ")")))))) - cases) + pattern-matching (M;map @ + (function [[name :case:]] + (do @ + [encoder (Codec<Text,?>::encode new-env :case:)] + (wrap (list (` ((~ (code;tag name)) (~ g!case))) + (` (format "(#" + (~ (code;text (Ident/encode name))) + " " + ((~ encoder) (~ g!case)) + ")")))))) + cases) #let [base (function$ g!type-fun g!vars (` (function [(~ g!input)] (case (~ g!input) @@ -83,15 +83,15 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - synthesis (mapM @ - (function [[name :slot:]] - (do @ - [encoder (Codec<Text,?>::encode new-env :slot:)] - (wrap (` (format "#" - (~ (code;text (Ident/encode name))) - " " - ((~ encoder) (get@ (~ (code;tag name)) (~ g!input)))))))) - slots) + synthesis (M;map @ + (function [[name :slot:]] + (do @ + [encoder (Codec<Text,?>::encode new-env :slot:)] + (wrap (` (format "#" + (~ (code;text (Ident/encode name))) + " " + ((~ encoder) (get@ (~ (code;tag name)) (~ g!input)))))))) + slots) #let [base (function$ g!type-fun g!vars (` (function [(~ g!input)] (format "{" (~@ (list;interpose (' " ") synthesis)) "}"))))]] @@ -105,13 +105,13 @@ #let [new-env (poly;extend-env [:x: g!type-fun] (list;zip2 (|> g!vars list;size poly;type-var-indices) g!vars) env)] - parts (mapM @ - (function [:member:] - (do @ - [g!member (macro;gensym "g!member") - encoder (Codec<Text,?>::encode new-env :member:)] - (wrap [g!member encoder]))) - members) + parts (M;map @ + (function [:member:] + (do @ + [g!member (macro;gensym "g!member") + encoder (Codec<Text,?>::encode new-env :member:)] + (wrap [g!member encoder]))) + members) #let [analysis (` [(~@ (List/map product;left parts))]) synthesis (List/map (function [[g!member g!encoder]] (` ((~ g!encoder) (~ g!member)))) @@ -130,7 +130,7 @@ (do @ [[:func: :args:] (poly;apply :x:) .func. (Codec<Text,?>::encode env :func:) - .args. (mapM @ (Codec<Text,?>::encode env) :args:)] + .args. (M;map @ (Codec<Text,?>::encode env) :args:)] (wrap (` (: (~ (->Codec::encode (type;to-ast :x:))) ((~ .func.) (~@ .args.)))))) ## Bound type-variables diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 4838e16b1..f56c84e1b 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -3,7 +3,7 @@ (lux [macro #+ Monad<Lux> with-gensyms] (control functor applicative - monad + ["M" monad #+ do Monad] [eq #+ Eq] ["p" parser]) (data [bool] @@ -249,19 +249,19 @@ (#;Some [name args meta body]) (with-gensyms [g!tokens g!body g!msg] (do Monad<Lux> - [vars+parsers (mapM Monad<Lux> - (: (-> Code (Lux [Code Code])) - (function [arg] - (case arg - (^ [_ (#;Tuple (list var parser))]) - (wrap [var parser]) - - [_ (#;Symbol var-name)] - (wrap [(code;symbol var-name) (` any)]) - - _ - (macro;fail "Syntax pattern expects tuples or symbols.")))) - args) + [vars+parsers (M;map Monad<Lux> + (: (-> Code (Lux [Code Code])) + (function [arg] + (case arg + (^ [_ (#;Tuple (list var parser))]) + (wrap [var parser]) + + [_ (#;Symbol var-name)] + (wrap [(code;symbol var-name) (` any)]) + + _ + (macro;fail "Syntax pattern expects tuples or symbols.")))) + args) #let [g!state (code;symbol ["" "*compiler*"]) g!end (code;symbol ["" ""]) error-msg (code;text (Text/append "Wrong syntax for " name)) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index bde9d39c5..376dd9192 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -2,7 +2,7 @@ [lux #- list] (lux (control functor applicative - monad + ["M" monad #+ do Monad] hash) (data [bit] [text "Text/" Monoid<Text>] @@ -284,13 +284,13 @@ {#;doc "Shuffle a vector randomly based on a seed value."} (All [a] (-> Nat (V;Vector a) (V;Vector a))) (let [_size (V;size vector) - _shuffle (foldM Monad<Random> - (function [idx vec] - (do Monad<Random> - [rand nat] - (wrap (swap idx (n.% _size rand) vec)))) - vector - (list;n.range +0 (n.dec _size)))] + _shuffle (M;fold Monad<Random> + (function [idx vec] + (do Monad<Random> + [rand nat] + (wrap (swap idx (n.% _size rand) vec)))) + vector + (list;n.range +0 (n.dec _size)))] (|> _shuffle (run (pcg-32 [+123 seed])) product;right))) diff --git a/stdlib/source/lux/paradigm/concatenative.lux b/stdlib/source/lux/paradigm/concatenative.lux index 1c78d7be1..a0854ffcf 100644 --- a/stdlib/source/lux/paradigm/concatenative.lux +++ b/stdlib/source/lux/paradigm/concatenative.lux @@ -4,7 +4,7 @@ d.+ d.- d.* d./ d.% d.= d.< d.<= d.> d.>= r.+ r.- r.* r./ r.% r.= r.< r.<= r.> r.>=] (lux (control ["p" parser "p/" Monad<Parser>] - ["M" monad]) + [monad]) (data [text] text/format [maybe "m/" Monad<Maybe>] @@ -50,7 +50,7 @@ (def: (singleton expander) (-> (Lux (List Code)) (Lux Code)) - (M;do Monad<Lux> + (monad;do Monad<Lux> [expansion expander] (case expansion (#;Cons singleton #;Nil) @@ -71,7 +71,7 @@ (case [(|> inputs (get@ #bottom) (m/map (|>. code;nat (~) #;Bound (`)))) (|> outputs (get@ #bottom) (m/map (|>. code;nat (~) #;Bound (`))))] [(#;Some bottomI) (#;Some bottomO)] - (M;do @ + (monad;do @ [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) bottomI))) outputC (singleton (macro;expand-all (stack-fold (get@ #top outputs) bottomO)))] (wrap (list (` (-> (~ (de-alias inputC)) @@ -79,7 +79,7 @@ [?bottomI ?bottomO] (with-gensyms [g!stack] - (M;do @ + (monad;do @ [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) (default g!stack ?bottomI)))) outputC (singleton (macro;expand-all (stack-fold (get@ #top outputs) (default g!stack ?bottomO))))] (wrap (list (` (All [(~ g!stack)] @@ -123,8 +123,8 @@ (syntax: #export (apply [arity (|> s;nat (p;filter (;n.> +0)))]) (with-gensyms [g!func g!stack g!output] - (M;do @ - [g!inputs (|> (macro;gensym "input") (list;repeat arity) (M;seqM @))] + (monad;do @ + [g!inputs (|> (macro;gensym "input") (list;repeat arity) (monad;seq @))] (wrap (list (` (: (All [(~@ g!inputs) (~ g!output)] (-> (-> (~@ g!inputs) (~ g!output)) (=> [(~@ g!inputs)] [(~ g!output)]))) diff --git a/stdlib/source/lux/paradigm/object.lux b/stdlib/source/lux/paradigm/object.lux index 16269b66d..f215e4071 100644 --- a/stdlib/source/lux/paradigm/object.lux +++ b/stdlib/source/lux/paradigm/object.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control monad + (lux (control ["M" monad #+ do Monad] ["p" parser "p/" Monad<Parser>]) (data [text] text/format @@ -25,7 +25,7 @@ (case type (#;Host name params) (do Monad<Lux> - [paramsC+ (mapM @ type-to-code params)] + [paramsC+ (M;map @ type-to-code params)] (wrap (` (;host (~ (code;symbol ["" name])) (~@ paramsC+))))) @@ -38,7 +38,7 @@ (^template [<tag> <macro> <flatten>] (<tag> _) (do Monad<Lux> - [partsC+ (mapM @ type-to-code (<flatten> type))] + [partsC+ (M;map @ type-to-code (<flatten> type))] (wrap (` (<macro> (~@ partsC+)))))) ([#;Sum ;| type;flatten-variant] [#;Product ;& type;flatten-tuple]) @@ -46,7 +46,7 @@ (#;Function input output) (do Monad<Lux> [#let [[insT+ outT] (type;flatten-function type)] - insC+ (mapM @ type-to-code insT+) + insC+ (M;map @ type-to-code insT+) outC (type-to-code outT)] (wrap (` (;-> (~@ insC+) (~ outC))))) @@ -61,7 +61,7 @@ (do Monad<Lux> [#let [[funcT argsT+] (type;flatten-application type)] funcC (type-to-code funcT) - argsC+ (mapM @ type-to-code argsT+)] + argsC+ (M;map @ type-to-code argsT+)] (wrap (` ((~ funcC) (~@ argsC+))))) (#;Named name unnamedT) @@ -163,7 +163,7 @@ (do @ [newT (macro;find-def-type (product;both id ./n;new parent)) [depth rawT+] (./i;extract newT) - codeT+ (mapM @ type-to-code rawT+)] + codeT+ (M;map @ type-to-code rawT+)] (wrap (L/map (./i;specialize parent-mappings) codeT+))))) #let [g!parameters (L/map code;local-symbol parameters) @@ -177,8 +177,8 @@ g!parent-structs (if (./i;no-parent? parent) (list) (L/map (|>. (product;both id ./n;struct) code;symbol) (list& parent ancestors)))] - g!parent-inits (mapM @ (function [_] (macro;gensym "parent-init")) - g!parent-structs) + g!parent-inits (M;map @ (function [_] (macro;gensym "parent-init")) + g!parent-structs) #let [g!full-init (L/fold (function [[parent-struct parent-state] child] (` [(~ parent-struct) (~ parent-state) (~ child)])) (` [(~ g!struct) (~ g!init) []]) diff --git a/stdlib/source/lux/paradigm/object/notation.lux b/stdlib/source/lux/paradigm/object/notation.lux index 215963d41..a70ff5ece 100644 --- a/stdlib/source/lux/paradigm/object/notation.lux +++ b/stdlib/source/lux/paradigm/object/notation.lux @@ -1,11 +1,10 @@ (;module: [lux #- struct] - (lux (control monad + (lux (control [monad #+ do Monad] ["p" parser "p/" Monad<Parser>]) (data [text] text/format [product] - maybe [ident "Ident/" Eq<Ident>] (coll [list "L/" Functor<List> Fold<List> Monoid<List>] [set #+ Set])) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index f8e0425aa..1fa9b8b71 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -5,7 +5,7 @@ [code]) (control functor applicative - monad + ["M" monad #+ do Monad] ["p" parser]) (concurrency [promise #+ Promise Monad<Promise>]) (data (coll [list "L/" Monad<List> Fold<List>]) @@ -71,7 +71,7 @@ " in " (%i (i.- pre post)) "ms" "\n" documentation "\n"))]] (wrap counters))))) - (seqM @))] + (M;seq @))] (wrap (L/fold add-counters start test-runs)))) (def: pcg-32-magic-inc Nat +12345) @@ -280,7 +280,7 @@ tests (: (Lux (List [Text Text Text])) (|> (#;Cons current-module modules) list;reverse - (mapM @ exported-tests) + (M;map @ exported-tests) (:: @ map L/join))) #let [tests+ (L/map (function [[module-name test desc]] (` [(~ (code;text module-name)) (~ (code;symbol [module-name test])) (~ (code;text desc))])) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 618416c33..72d63483f 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -1,11 +1,11 @@ (;module: {#;doc "Basic functionality for working with types."} [lux #- function] (lux (control [eq #+ Eq] - monad) + ["M" monad #+ do Monad]) (data [text "Text/" Monoid<Text> Eq<Text>] [ident "Ident/" Eq<Ident>] [number "Nat/" Codec<Text,Nat>] - maybe + [maybe] (coll [list #+ "List/" Monad<List> Monoid<List> Fold<List>])) (macro [code]) )) @@ -337,7 +337,7 @@ (#;Apply A F) (default false - (do Monad<Maybe> + (do maybe;Monad<Maybe> [applied (apply (list A) F)] (wrap (quantified? applied)))) diff --git a/stdlib/source/lux/type/auto.lux b/stdlib/source/lux/type/auto.lux index 99e5e0431..08c5aa784 100644 --- a/stdlib/source/lux/type/auto.lux +++ b/stdlib/source/lux/type/auto.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control monad + (lux (control ["M" monad #+ do Monad] [eq] ["p" parser]) (data [text "Text/" Eq<Text>] @@ -83,7 +83,7 @@ (do Monad<Lux> [this-module-name macro;current-module-name imp-mods (macro;imported-modules this-module-name) - tag-lists (mapM @ macro;tag-lists imp-mods) + tag-lists (M;map @ macro;tag-lists imp-mods) #let [tag-lists (|> tag-lists List/join (List/map product;left) List/join) candidates (list;filter (. (Text/= simple-name) product;right) tag-lists)]] @@ -140,11 +140,11 @@ (do Monad<Lux> [this-module-name macro;current-module-name imp-mods (macro;imported-modules this-module-name) - export-batches (mapM @ (function [imp-mod] - (do @ - [exports (macro;exports imp-mod)] - (wrap (prepare-defs imp-mod exports)))) - imp-mods)] + export-batches (M;map @ (function [imp-mod] + (do @ + [exports (macro;exports imp-mod)] + (wrap (prepare-defs imp-mod exports)))) + imp-mods)] (wrap (List/join export-batches)))) (def: (apply-function-type func arg) @@ -185,11 +185,11 @@ (def: (check-apply member-type input-types output-type) (-> Type (List Type) Type (Check [])) (do Monad<Check> - [member-type' (foldM Monad<Check> - (function [input member] - (apply-function-type member input)) - member-type - input-types)] + [member-type' (M;fold Monad<Check> + (function [input member] + (apply-function-type member input)) + member-type + input-types)] (tc;check output-type member-type'))) (type: #rec Instance @@ -210,7 +210,7 @@ #let [[deps alt-type] (type;flatten-function alt-type)] _ (tc;check dep alt-type) context' tc;get-context - =deps (mapM @ (provision compiler context') deps)] + =deps (M;map @ (provision compiler context') deps)] (wrap =deps))) (#;Left error) (list) @@ -261,7 +261,7 @@ member-type (find-member-type member-idx alt-type) _ (check-apply member-type input-types output-type) context' tc;get-context - =deps (mapM @ (provision compiler context') deps)] + =deps (M;map @ (provision compiler context') deps)] (wrap =deps))) (#;Left error) (list) @@ -335,7 +335,7 @@ (#;Left [args _]) (do @ [[member-idx sig-type] (resolve-member member) - input-types (mapM @ resolve-type args) + input-types (M;map @ resolve-type args) output-type macro;expected-type chosen-ones (find-alternatives sig-type member-idx input-types output-type)] (case chosen-ones @@ -356,8 +356,8 @@ (#;Right [args _]) (do @ - [labels (seqM @ (list;repeat (list;size args) - (macro;gensym ""))) + [labels (M;seq @ (list;repeat (list;size args) + (macro;gensym ""))) #let [retry (` (let [(~@ (|> (list;zip2 labels args) (List/map join-pair) List/join))] (;;::: (~ (code;symbol member)) (~@ labels))))]] (wrap (list retry))) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index a51f641cd..fa73186af 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -4,7 +4,7 @@ lux (lux (control functor applicative - monad) + ["M" monad #+ do Monad]) (data [text "Text/" Monoid<Text> Eq<Text>] text/format maybe @@ -243,7 +243,7 @@ (#;Host name params) (do Monad<Check> - [=params (mapM @ (clean t-id) params)] + [=params (M;map @ (clean t-id) params)] (wrap (#;Host name =params))) (^template [<tag>] @@ -260,7 +260,7 @@ (^template [<tag>] (<tag> env body) (do Monad<Check> - [=env (mapM @ (clean t-id) env) + [=env (M;map @ (clean t-id) env) =body (clean t-id body)] ## TODO: DO NOT CLEAN THE BODY (wrap (<tag> =env =body)))) ([#;UnivQ] @@ -480,10 +480,10 @@ (n.= (list;size e-params) (list;size a-params))) (do Monad<Check> - [fixed (foldM Monad<Check> - (function [[e a] fixed] (check' e a fixed)) - fixed - (list;zip2 e-params a-params))] + [fixed (M;fold Monad<Check> + (function [[e a] fixed] (check' e a fixed)) + fixed + (list;zip2 e-params a-params))] (Check/wrap fixed)) (fail-check expected actual)) |