diff options
Diffstat (limited to 'stdlib')
66 files changed, 379 insertions, 366 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 6b29d7c42..58f8d342a 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -3269,7 +3269,7 @@ (-> Text Bottom) (_lux_proc ["io" "error"] [message])) -(macro: #export (default tokens state) +(macro: (default tokens state) {#;doc "## Allows you to provide a default value that will be used ## if a (Maybe x) value turns out to be #;None. (default 20 (#;Some 10)) => 10 @@ -5743,10 +5743,6 @@ ))))) )) -(def: #export assume - (All [a] (-> (Maybe a) a)) - (|>. (default (undefined)))) - (macro: #export (as-is tokens compiler) (#;Right [compiler tokens])) @@ -5755,7 +5751,7 @@ (^multi (^ (list [_ (#Text input)])) (n.= +1 (_lux_proc ["text" "size"] [input]))) (|> (_lux_proc ["text" "char"] [input +0]) - assume + (default (undefined)) nat$ list [compiler] #;Right) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 4fa625dfd..0756f058a 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -1,8 +1,6 @@ (;module: lux - (lux (control functor - applicative - monad + (lux (control monad ["p" parser]) (data (coll [list "L/" Monoid<List> Monad<List>]) [text "T/" Monoid<Text>] @@ -15,9 +13,9 @@ ["s" syntax #+ syntax: Syntax]))) ## [Types] -(type: #export CLI +(type: #export (CLI a) {#;doc "A command-line interface parser."} - (p;Parser (List Text))) + (p;Parser (List Text) a)) ## [Combinators] (def: #export (run inputs parser) diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index aa56aadeb..ed0560b84 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -1,7 +1,7 @@ (;module: lux - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad] [eq #+ Eq] ["p" parser]) @@ -276,7 +276,7 @@ (wrap (#;Some [value (sample time next-inputs)])))))) ## [Structures] -(struct: #export _ (Functor Channel) +(struct: #export _ (F;Functor Channel) (def: (map f xs) (:: &;Functor<Promise> map (function [?x+xs] @@ -285,7 +285,7 @@ (#;Some [x xs']) (#;Some [(f x) (map f xs')]))) xs))) -(struct: #export _ (Applicative Channel) +(struct: #export _ (A;Applicative Channel) (def: functor Functor<Channel>) (def: (wrap a) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index cb15c95c9..1e6bb72e9 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -5,8 +5,8 @@ text/format) [io #- run] function - (control functor - applicative + (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad] ["p" parser]) [macro] @@ -87,7 +87,7 @@ [] (await f promise)))))) -(struct: #export _ (Functor Promise) +(struct: #export _ (F;Functor Promise) (def: (map f fa) (let [fb (promise ($ +1))] (exec (await (function [a] (do Monad<IO> @@ -96,7 +96,7 @@ fa) fb)))) -(struct: #export _ (Applicative Promise) +(struct: #export _ (A;Applicative Promise) (def: functor Functor<Promise>) (def: (wrap a) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index 27dca629c..7886dda36 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -1,7 +1,7 @@ (;module: lux - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad]) [io #- run] (data (coll [list "L/" Functor<List> Fold<List>] @@ -156,13 +156,13 @@ target)] (wrap head)))) -(struct: #export _ (Functor STM) +(struct: #export _ (F;Functor STM) (def: (map f fa) (function [tx] (let [[tx' a] (fa tx)] [tx' (f a)])))) -(struct: #export _ (Applicative STM) +(struct: #export _ (A;Applicative STM) (def: functor Functor<STM>) (def: (wrap a) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index 9fc35ee5f..4be7ead9d 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -1,8 +1,8 @@ (;module: lux (lux (data ["R" result]) - (control functor - applicative + (control ["F" functor] + ["A" applicative] monad ["ex" exception #+ Exception]) (concurrency ["P" promise]) @@ -29,7 +29,7 @@ (All [a] (-> (Task a) (Task (R;Result a)))) (:: P;Functor<Promise> map (|>. #R;Success) computation)) -(struct: #export _ (Functor Task) +(struct: #export _ (F;Functor Task) (def: (map f fa) (:: P;Functor<Promise> map (function [fa'] @@ -41,7 +41,7 @@ (#R;Success (f a)))) fa))) -(struct: #export _ (Applicative Task) +(struct: #export _ (A;Applicative Task) (def: functor Functor<Task>) (def: wrap return) diff --git a/stdlib/source/lux/control/applicative.lux b/stdlib/source/lux/control/applicative.lux index c904535a9..187950aa9 100644 --- a/stdlib/source/lux/control/applicative.lux +++ b/stdlib/source/lux/control/applicative.lux @@ -13,11 +13,11 @@ (-> (f (-> a b)) (f a) (f b))) apply)) -(struct: #export (compA Applicative<F> Applicative<G>) +(struct: #export (compose Applicative<F> Applicative<G>) {#;doc "Applicative functor composition."} (All [F G] (-> (Applicative F) (Applicative G) (Applicative (All [a] (F (G a)))))) - (def: functor (F;compF (get@ #functor Applicative<F>) - (get@ #functor Applicative<G>))) + (def: functor (F;compose (get@ #functor Applicative<F>) + (get@ #functor Applicative<G>))) (def: wrap (|>. (:: Applicative<G> wrap) (:: Applicative<F> wrap))) (def: (apply fgf fgx) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index cdb9cc457..e96677b64 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -80,8 +80,8 @@ [?bottomI ?bottomO] (with-gensyms [g!stack] (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))))] + [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) (maybe;default g!stack ?bottomI)))) + outputC (singleton (macro;expand-all (stack-fold (get@ #top outputs) (maybe;default g!stack ?bottomO))))] (wrap (list (` (All [(~ g!stack)] (-> (~ (de-alias inputC)) (~ (de-alias outputC)))))))))))) diff --git a/stdlib/source/lux/control/cont.lux b/stdlib/source/lux/control/cont.lux index cbedc5df0..81f62eccb 100644 --- a/stdlib/source/lux/control/cont.lux +++ b/stdlib/source/lux/control/cont.lux @@ -1,7 +1,7 @@ (;module: lux - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] monad) function [macro #+ with-gensyms] @@ -22,11 +22,11 @@ (All [a] (-> (Cont a a) a)) (cont id)) -(struct: #export Functor<Cont> (All [o] (Functor (All [i] (Cont i o)))) +(struct: #export Functor<Cont> (All [o] (F;Functor (All [i] (Cont i o)))) (def: (map f fv) (function [k] (fv (. k f))))) -(struct: #export Applicative<Cont> (All [o] (Applicative (All [i] (Cont i o)))) +(struct: #export Applicative<Cont> (All [o] (A;Applicative (All [i] (Cont i o)))) (def: functor Functor<Cont>) (def: (wrap value) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index 560928bf2..b36c97268 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -2,6 +2,7 @@ lux (lux (control monad) (data ["R" result] + [maybe] [text "text/" Monoid<Text>]) [macro] (macro [code] @@ -40,7 +41,7 @@ (if (text;starts-with? reference error) (#R;Success (|> error (text;clip (text;size reference) (text;size error)) - assume + maybe;assume then)) (#R;Error error))))) diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux index 416223cd7..3c1f33eb8 100644 --- a/stdlib/source/lux/control/functor.lux +++ b/stdlib/source/lux/control/functor.lux @@ -17,7 +17,7 @@ (type: #export (<.> f g) (All [a] (f (g a)))) -(struct: #export (compF Functor<F> Functor<G>) +(struct: #export (compose Functor<F> Functor<G>) {#;doc "Functor composition."} (All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a)))))) (def: (map f fga) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 0c1b2cf32..174040805 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -1,7 +1,7 @@ (;module: - [lux #- not default] - (lux (control functor - applicative + [lux #- not] + (lux (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad] [codec]) (data (coll [list "L/" Functor<List> Monoid<List>]) @@ -13,7 +13,7 @@ (-> s (R;Result [s a]))) ## [Structures] -(struct: #export Functor<Parser> (All [s] (Functor (Parser s))) +(struct: #export Functor<Parser> (All [s] (F;Functor (Parser s))) (def: (map f ma) (function [input] (case (ma input) @@ -23,7 +23,7 @@ (#R;Success [input' a]) (#R;Success [input' (f a)]))))) -(struct: #export Applicative<Parser> (All [s] (Applicative (Parser s))) +(struct: #export Applicative<Parser> (All [s] (A;Applicative (Parser s))) (def: functor Functor<Parser>) (def: (wrap x) diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux index bbc368a0c..b080d75ec 100644 --- a/stdlib/source/lux/control/reader.lux +++ b/stdlib/source/lux/control/reader.lux @@ -1,7 +1,7 @@ (;module: lux - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] [monad #+ do Monad]))) ## [Types] @@ -10,12 +10,12 @@ (-> r a)) ## [Structures] -(struct: #export Functor<Reader> (All [r] (Functor (Reader r))) +(struct: #export Functor<Reader> (All [r] (F;Functor (Reader r))) (def: (map f fa) (function [env] (f (fa env))))) -(struct: #export Applicative<Reader> (All [r] (Applicative (Reader r))) +(struct: #export Applicative<Reader> (All [r] (A;Applicative (Reader r))) (def: functor Functor<Reader>) (def: (wrap x) @@ -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@ #monad;applicative Monad<M>))) + (def: applicative (A;compose 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 3400ed07b..e791542d5 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -1,7 +1,7 @@ (;module: lux - (lux (control functor - ["A" applicative #*] + (lux (control ["F" functor] + ["A" applicative] [monad #+ do Monad]))) ## [Types] @@ -10,13 +10,13 @@ (-> s [s a])) ## [Structures] -(struct: #export Functor<State> (All [s] (Functor (State s))) +(struct: #export Functor<State> (All [s] (F;Functor (State s))) (def: (map f ma) (function [state] (let [[state' a] (ma state)] [state' (f a)])))) -(struct: #export Applicative<State> (All [s] (Applicative (State s))) +(struct: #export Applicative<State> (All [s] (A;Applicative (State s))) (def: functor Functor<State>) (def: (wrap a) @@ -75,14 +75,14 @@ (action state)) (struct: (Functor<StateT> Functor<M>) - (All [M s] (-> (Functor M) (Functor (All [a] (-> s (M [s a])))))) + (All [M s] (-> (F;Functor M) (F;Functor (All [a] (-> s (M [s a])))))) (def: (map f sfa) (function [state] (:: Functor<M> map (function [[s a]] [s (f a)]) (sfa state))))) (struct: (Applicative<StateT> Monad<M>) - (All [M s] (-> (Monad M) (Applicative (All [a] (-> s (M [s a])))))) + (All [M s] (-> (Monad M) (A;Applicative (All [a] (-> s (M [s a])))))) (def: functor (Functor<StateT> (:: Monad<M> functor))) (def: (wrap a) diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux index 6a82df77c..10da747c9 100644 --- a/stdlib/source/lux/control/writer.lux +++ b/stdlib/source/lux/control/writer.lux @@ -1,8 +1,8 @@ (;module: lux (lux/control monoid - ["A" applicative #*] - functor + ["F" functor] + ["A" applicative] [monad #+ do Monad])) (type: #export (Writer l a) @@ -11,13 +11,13 @@ #value a}) (struct: #export Functor<Writer> (All [l] - (Functor (Writer l))) + (F;Functor (Writer l))) (def: (map f fa) (let [[log datum] fa] [log (f datum)]))) (struct: #export (Applicative<Writer> mon) (All [l] - (-> (Monoid l) (Applicative (Writer l)))) + (-> (Monoid l) (A;Applicative (Writer l)))) (def: functor Functor<Writer>) (def: (wrap x) @@ -43,7 +43,7 @@ (struct: #export (WriterT Monoid<l> Monad<M>) (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a)))))) - (def: applicative (A;compA (get@ #monad;applicative Monad<M>) (Applicative<Writer> Monoid<l>))) + (def: applicative (A;compose (get@ #monad;applicative Monad<M>) (Applicative<Writer> Monoid<l>))) (def: (join MlMla) (do Monad<M> [[l1 Mla] (: (($ +1) (Writer ($ +0) (($ +1) (Writer ($ +0) ($ +2))))) diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux index 4ab94fae8..507092de1 100644 --- a/stdlib/source/lux/data/coll/array.lux +++ b/stdlib/source/lux/data/coll/array.lux @@ -1,9 +1,7 @@ (;module: lux (lux (control monoid - functor - applicative - monad + ["F" functor] [eq #+ Eq] fold) (data (coll [list "List/" Fold<List>]) @@ -188,7 +186,7 @@ (copy sxs +0 xs +0) (copy sxy +0 ys sxs))))) -(struct: #export _ (Functor Array) +(struct: #export _ (F;Functor Array) (def: (map f ma) (let [arr-size (size ma)] (if (n.= +0 arr-size) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 0098b3b90..c2186fd8d 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -1,8 +1,8 @@ (;module: lux (lux (control monoid - functor - applicative + ["F" functor] + ["A" applicative] ["M" monad #+ do Monad] [eq #+ Eq] [fold]) @@ -260,7 +260,7 @@ (open Monoid<List>) -(struct: #export _ (Functor List) +(struct: #export _ (F;Functor List) (def: (map f ma) (case ma #;Nil #;Nil @@ -268,7 +268,7 @@ (open Functor<List>) -(struct: #export _ (Applicative List) +(struct: #export _ (A;Applicative List) (def: functor Functor<List>) (def: (wrap a) @@ -478,7 +478,7 @@ (struct: #export (ListT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (List a)))))) - (def: applicative (compA (get@ #M;applicative Monad<M>) Applicative<List>)) + (def: applicative (A;compose (get@ #M;applicative Monad<M>) Applicative<List>)) (def: (join MlMla) (do Monad<M> [lMla MlMla diff --git a/stdlib/source/lux/data/coll/ordered/dict.lux b/stdlib/source/lux/data/coll/ordered/dict.lux index d0d1e20cc..e51e23b70 100644 --- a/stdlib/source/lux/data/coll/ordered/dict.lux +++ b/stdlib/source/lux/data/coll/ordered/dict.lux @@ -5,7 +5,7 @@ [order #+ Order]) (data (coll [list "L/" Monad<List> Monoid<List> Fold<List>]) ["p" product] - ["M" maybe #+ Functor<Maybe>]) + [maybe]) [macro] (macro [code] ["s" syntax #+ syntax: Syntax]))) @@ -258,7 +258,7 @@ outcome (recur side-root)] (if (is side-root outcome) ?root - (#;Some (<add> (default (undefined) outcome) + (#;Some (<add> (maybe;assume outcome) root))))] [T/< #left add-left] @@ -351,7 +351,7 @@ (#;Some (right-balance (get@ #key right) (get@ #value right) (get@ #right right.left) - (:: Functor<Maybe> map redden (get@ #right right))))) + (:: maybe;Functor<Maybe> map redden (get@ #right right))))) _ (error! error-message)) @@ -378,7 +378,7 @@ (get@ #value left.right) (#;Some (left-balance (get@ #key left) (get@ #value left) - (:: Functor<Maybe> map redden (get@ #left left)) + (:: maybe;Functor<Maybe> map redden (get@ #left left)) (get@ #left left.right))) (#;Some (black key value (get@ #right left.right) ?right))) @@ -398,7 +398,7 @@ [(#;Some left) (#;Some right)] (case [(get@ #color left) (get@ #color right)] [#Red #Red] - (do M;Monad<Maybe> + (do maybe;Monad<Maybe> [fused (prepend (get@ #right left) (get@ #right right))] (case (get@ #color fused) #Red @@ -437,7 +437,7 @@ (get@ #right right))) [#Black #Black] - (do M;Monad<Maybe> + (do maybe;Monad<Maybe> [fused (prepend (get@ #right left) (get@ #left right))] (case (get@ #color fused) #Red diff --git a/stdlib/source/lux/data/coll/priority-queue.lux b/stdlib/source/lux/data/coll/priority-queue.lux index b85b184fc..5a79ccd0a 100644 --- a/stdlib/source/lux/data/coll/priority-queue.lux +++ b/stdlib/source/lux/data/coll/priority-queue.lux @@ -22,8 +22,7 @@ (All [a] (-> (Queue a) (Maybe a))) (do maybe;Monad<Maybe> [fingers queue] - (wrap (default (undefined) - (F;search (n.= (F;tag fingers)) fingers))))) + (wrap (maybe;assume (F;search (n.= (F;tag fingers)) fingers))))) (def: #export (size queue) (All [a] (-> (Queue a) Nat)) diff --git a/stdlib/source/lux/data/coll/queue.lux b/stdlib/source/lux/data/coll/queue.lux index e5622f178..db514cbaa 100644 --- a/stdlib/source/lux/data/coll/queue.lux +++ b/stdlib/source/lux/data/coll/queue.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control [eq #+ Eq] - functor) + ["F" functor]) (data (coll [list "L/" Monoid<List> Functor<List>])))) (type: #export (Queue a) @@ -72,7 +72,7 @@ (def: (= qx qy) (:: (list;Eq<List> Eq<a>) = (to-list qx) (to-list qy)))) -(struct: #export _ (Functor Queue) +(struct: #export _ (F;Functor Queue) (def: (map f fa) {#front (|> fa (get@ #front) (L/map f)) #rear (|> fa (get@ #rear) (L/map f))})) diff --git a/stdlib/source/lux/data/coll/seq.lux b/stdlib/source/lux/data/coll/seq.lux index e61845ac0..0e861e15a 100644 --- a/stdlib/source/lux/data/coll/seq.lux +++ b/stdlib/source/lux/data/coll/seq.lux @@ -1,13 +1,13 @@ (;module: lux - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] [monad #+ do Monad] [eq #+ Eq] fold ["p" parser]) (data (coll ["L" list "L/" Monoid<List> Fold<List>] - (tree ["F" finger])) + (tree ["f" finger])) [number] [maybe]) [macro] @@ -15,26 +15,26 @@ ["s" syntax #+ syntax: Syntax]))) (type: #export (Seq a) - (Maybe (F;Fingers Nat a))) + (Maybe (f;Fingers Nat a))) (def: default-size Nat +1) (def: (new value) - (All [a] (-> a (F;Fingers Nat a))) - {#F;monoid number;Add@Monoid<Nat> - #F;tree (#F;Leaf default-size value)}) + (All [a] (-> a (f;Fingers Nat a))) + {#f;monoid number;Add@Monoid<Nat> + #f;tree (#f;Leaf default-size value)}) (do-template [<name> <side>] [(def: #export (<name> seq) (All [a] (-> (Seq a) (Maybe a))) (do maybe;Monad<Maybe> [fingers seq] - (wrap (loop [node (get@ #F;tree fingers)] + (wrap (loop [node (get@ #f;tree fingers)] (case node - (#F;Leaf tag value) + (#f;Leaf tag value) value - (#F;Branch tag left right) + (#f;Branch tag left right) (recur <side>))))))] [first left] @@ -48,7 +48,7 @@ (#;Some (new prefix)) (#;Some fingers) - (#;Some (F;branch (new prefix) fingers)))) + (#;Some (f;branch (new prefix) fingers)))) (def: #export (append suffix subject) (All [a] (-> a (Seq a) (Seq a))) @@ -57,7 +57,7 @@ (#;Some (new suffix)) (#;Some fingers) - (#;Some (F;branch fingers (new suffix))))) + (#;Some (f;branch fingers (new suffix))))) (def: #export (concat left right) (All [a] (-> (Seq a) (Seq a) (Seq a))) @@ -69,13 +69,13 @@ right [(#;Some left') (#;Some right')] - (#;Some (F;branch left' right')))) + (#;Some (f;branch left' right')))) (def: #export (nth idx seq) (All [a] (-> Nat (Seq a) (Maybe a))) (do maybe;Monad<Maybe> [fingers seq] - (F;search (n.> idx) fingers))) + (f;search (n.> idx) fingers))) (def: #export (size seq) (All [a] (-> (Seq a) Nat)) @@ -84,8 +84,8 @@ +0 (#;Some fingers) - (case (get@ #F;tree fingers) - (^or (#F;Leaf tag value) (#F;Branch tag left right)) + (case (get@ #f;tree fingers) + (^or (#f;Leaf tag value) (#f;Branch tag left right)) tag))) (def: #export (to-list seq) @@ -95,12 +95,12 @@ (list) (#;Some fingers) - (loop [node (get@ #F;tree fingers)] + (loop [node (get@ #f;tree fingers)] (case node - (#F;Leaf tag value) + (#f;Leaf tag value) (list value) - (#F;Branch tag left right) + (#f;Branch tag left right) (L/append (recur left) (recur right)))))) (def: #export (from-list xs) @@ -114,32 +114,32 @@ (#;Cons x #;Nil) (wrap [default-size - (#F;Leaf default-size x)]) + (#f;Leaf default-size x)]) (#;Cons x xs') (do @ [[sub-size right] (recur xs') #let [branch-size (n.+ default-size sub-size)]] (wrap [branch-size - (#F;Branch branch-size - (#F;Leaf default-size x) + (#f;Branch branch-size + (#f;Leaf default-size x) right)])) ))] - (wrap {#F;monoid number;Add@Monoid<Nat> - #F;tree tree})))) + (wrap {#f;monoid number;Add@Monoid<Nat> + #f;tree tree})))) (def: #export (reverse seq) (All [a] (-> (Seq a) (Seq a))) (do maybe;Monad<Maybe> [fingers seq - #let [node' (loop [node (get@ #F;tree fingers)] + #let [node' (loop [node (get@ #f;tree fingers)] (case node - (#F;Leaf tag value) + (#f;Leaf tag value) node - (#F;Branch tag left right) - (#F;Branch tag (recur right) (recur left))))]] - (wrap (set@ #F;tree node' fingers)))) + (#f;Branch tag left right) + (#f;Branch tag (recur right) (recur left))))]] + (wrap (set@ #f;tree node' fingers)))) (def: #export (member? Eq<a> xs x) (All [a] (-> (Eq a) (Seq a) a Bool)) @@ -148,12 +148,12 @@ false (#;Some fingers) - (loop [xs (get@ #F;tree fingers)] + (loop [xs (get@ #f;tree fingers)] (case xs - (#F;Leaf tag reference) + (#f;Leaf tag reference) (:: Eq<a> = reference x) - (#F;Branch tag left right) + (#f;Branch tag left right) (or (recur left) (recur right)))))) @@ -165,12 +165,12 @@ <default> (#;Some fingers) - (loop [seq (get@ #F;tree fingers)] + (loop [seq (get@ #f;tree fingers)] (case seq - (#F;Leaf tag reference) + (#f;Leaf tag reference) (pred reference) - (#F;Branch tag left right) + (#f;Branch tag left right) (<op> (recur left) (recur right))))))] @@ -188,14 +188,14 @@ (-> (-> a Bool) (Seq a) (Maybe a))) (do maybe;Monad<Maybe> [fingers seq] - (loop [seq (get@ #F;tree fingers)] + (loop [seq (get@ #f;tree fingers)] (case seq - (#F;Leaf tag value) + (#f;Leaf tag value) (if (pred value) (#;Some value) #;None) - (#F;Branch tag left right) + (#f;Branch tag left right) (case (recur left) #;None @@ -212,12 +212,12 @@ (#;Some fingers) (loop [init init - node (get@ #F;tree fingers)] + node (get@ #f;tree fingers)] (case node - (#F;Leaf tag value) + (#f;Leaf tag value) (f value init) - (#F;Branch tag left right) + (#f;Branch tag left right) (recur (recur init left) right) ))))) @@ -229,20 +229,20 @@ (to-list xs) (to-list ys)))) -(struct: #export _ (Functor Seq) +(struct: #export _ (F;Functor Seq) (def: (map f ma) (do maybe;Monad<Maybe> [fingers ma] - (wrap {#F;monoid number;Add@Monoid<Nat> - #F;tree (loop [tree (get@ #F;tree fingers)] + (wrap {#f;monoid number;Add@Monoid<Nat> + #f;tree (loop [tree (get@ #f;tree fingers)] (case tree - (#F;Leaf tag value) - (#F;Leaf tag (f value)) + (#f;Leaf tag value) + (#f;Leaf tag (f value)) - (#F;Branch tag left right) - (#F;Branch tag (recur left) (recur right))))})))) + (#f;Branch tag left right) + (#f;Branch tag (recur left) (recur right))))})))) -(struct: #export _ (Applicative Seq) +(struct: #export _ (A;Applicative Seq) (def: functor Functor<Seq>) (def: wrap (|>. new #;Some)) @@ -250,15 +250,15 @@ (def: (apply ff fa) (do maybe;Monad<Maybe> [ff' ff] - (case (get@ #F;tree ff') - (#F;Leaf tag f) + (case (get@ #f;tree ff') + (#f;Leaf tag f) (:: Functor<Seq> map f fa) - (#F;Branch tag lfs rfs) + (#f;Branch tag lfs rfs) (do @ - [lefts (apply (#;Some (set@ #F;tree lfs ff')) fa) - rights (apply (#;Some (set@ #F;tree rfs ff')) fa)] - (wrap (F;branch lefts rights))))))) + [lefts (apply (#;Some (set@ #f;tree lfs ff')) fa) + rights (apply (#;Some (set@ #f;tree rfs ff')) fa)] + (wrap (f;branch lefts rights))))))) (struct: #export _ (Monad Seq) (def: applicative Applicative<Seq>) @@ -266,15 +266,15 @@ (def: (join ffa) (do maybe;Monad<Maybe> [ffa' ffa] - (case (get@ #F;tree ffa') - (#F;Leaf tag fa) + (case (get@ #f;tree ffa') + (#f;Leaf tag fa) fa - (#F;Branch tag left right) + (#f;Branch tag left right) (do @ - [left' (join (#;Some (set@ #F;tree left ffa'))) - right' (join (#;Some (set@ #F;tree right ffa')))] - (wrap (F;branch left' right'))))))) + [left' (join (#;Some (set@ #f;tree left ffa'))) + right' (join (#;Some (set@ #f;tree right ffa')))] + (wrap (f;branch left' right'))))))) (syntax: #export (seq [elems (p;some s;any)]) (wrap (list (` (;;from-list (list (~@ elems))))))) diff --git a/stdlib/source/lux/data/coll/set.lux b/stdlib/source/lux/data/coll/set.lux index 06953ef23..328524a06 100644 --- a/stdlib/source/lux/data/coll/set.lux +++ b/stdlib/source/lux/data/coll/set.lux @@ -1,9 +1,6 @@ (;module: lux - (lux (control functor - applicative - monad - [eq #+ Eq] + (lux (control [eq #+ Eq] [hash #*]) (data (coll [dict] [list "List/" Fold<List> Functor<List>])))) diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index 6b39178bc..48c91ea34 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 (default (list))))))) + (update@ [#node #rose;children] (|>. list;tail (maybe;default (list))))))) (#;Cons next side) (#;Some (|> zipper diff --git a/stdlib/source/lux/data/coll/vector.lux b/stdlib/source/lux/data/coll/vector.lux index 23d07068e..826de5c42 100644 --- a/stdlib/source/lux/data/coll/vector.lux +++ b/stdlib/source/lux/data/coll/vector.lux @@ -1,7 +1,7 @@ (;module: lux - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad] [eq #+ Eq] monoid @@ -295,31 +295,31 @@ (update@ #size n.dec) (set@ #tail (|> (array;new new-tail-size) (array;copy new-tail-size +0 old-tail +0))))) - (default (undefined) - (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)] - (loop [level init-level - root (: (Hierarchy ($ +0)) - (default (new-hierarchy []) - (pop-tail vec-size init-level (get@ #root vec))))] - (if (n.> branching-exponent level) - (case [(array;get +1 root) (array;get +0 root)] - [#;None (#;Some (#Hierarchy sub-node))] - (recur (level-down level) sub-node) - - [#;None (#;Some (#Base _))] - (undefined) - - _ - [level root]) - [level root]))))]] - (wrap (|> vec - (update@ #size n.dec) - (set@ #level level') - (set@ #root root') - (set@ #tail new-tail)))))) + (maybe;assume + (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)] + (loop [level init-level + root (: (Hierarchy ($ +0)) + (maybe;default (new-hierarchy []) + (pop-tail vec-size init-level (get@ #root vec))))] + (if (n.> branching-exponent level) + (case [(array;get +1 root) (array;get +0 root)] + [#;None (#;Some (#Hierarchy sub-node))] + (recur (level-down level) sub-node) + + [#;None (#;Some (#Base _))] + (undefined) + + _ + [level root]) + [level root]))))]] + (wrap (|> vec + (update@ #size n.dec) + (set@ #level level') + (set@ #root root') + (set@ #tail new-tail)))))) )) (def: #export (to-list vec) @@ -396,7 +396,7 @@ (def: (append xs ys) (List/fold add xs (to-list ys)))) -(struct: _ (Functor Node) +(struct: _ (F;Functor Node) (def: (map f xs) (case xs (#Base base) @@ -406,7 +406,7 @@ (#Hierarchy (Array/map (map f) hierarchy))) )) -(struct: #export _ (Functor Vector) +(struct: #export _ (F;Functor Vector) (def: (map f xs) {#level (get@ #level xs) #size (get@ #size xs) @@ -414,7 +414,7 @@ #tail (|> xs (get@ #tail) (Array/map f)) })) -(struct: #export _ (Applicative Vector) +(struct: #export _ (A;Applicative Vector) (def: functor Functor<Vector>) (def: (wrap x) @@ -439,8 +439,7 @@ ) (def: #export (reverse xs) - (All [a] - (-> (Vector a) (Vector a))) + (All [a] (-> (Vector a) (Vector a))) (let [(^open) Fold<Vector> (^open) Monoid<Vector>] (fold add unit xs))) diff --git a/stdlib/source/lux/data/env.lux b/stdlib/source/lux/data/env.lux index 7c29f5833..b6f96be68 100644 --- a/stdlib/source/lux/data/env.lux +++ b/stdlib/source/lux/data/env.lux @@ -1,13 +1,13 @@ (;module: lux - (lux (control functor + (lux (control ["F" functor] comonad))) (type: #export (Env e a) {#env e #value a}) -(struct: #export Functor<Env> (All [e] (Functor (Env e))) +(struct: #export Functor<Env> (All [e] (F;Functor (Env e))) (def: (map f fa) (update@ #value f fa))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 097525b1d..95d689059 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -2,9 +2,7 @@ For more information, please see: http://www.json.org/"} lux - (lux (control functor - applicative - [monad #+ do Monad] + (lux (control [monad #+ do Monad] [eq #+ Eq] codec ["p" parser "p/" Monad<Parser>]) @@ -12,7 +10,7 @@ [text "text/" Eq<Text> Monoid<Text>] (text ["l" lexer]) [number "frac/" Codec<Text,Frac> "nat/" Codec<Text,Nat>] - maybe + [maybe] ["R" result] [sum] [product] @@ -169,8 +167,8 @@ (and (n.= (vector;size xs) (vector;size ys)) (L/fold (function [idx prev] (and prev - (default false - (do Monad<Maybe> + (maybe;default false + (do maybe;Monad<Maybe> [x' (vector;nth idx xs) y' (vector;nth idx ys)] (wrap (= x' y')))))) diff --git a/stdlib/source/lux/data/identity.lux b/stdlib/source/lux/data/identity.lux index 4f025d4f7..d2335f121 100644 --- a/stdlib/source/lux/data/identity.lux +++ b/stdlib/source/lux/data/identity.lux @@ -1,7 +1,7 @@ (;module: lux - (lux/control (functor #as F #refer #all) - (applicative #as A #refer #all) + (lux/control ["F" functor] + ["A" applicative] (monad #as M #refer #all) (comonad #as CM #refer #all))) @@ -10,10 +10,10 @@ a) ## [Structures] -(struct: #export _ (Functor Identity) +(struct: #export _ (F;Functor Identity) (def: map id)) -(struct: #export _ (Applicative Identity) +(struct: #export _ (A;Applicative Identity) (def: functor Functor<Identity>) (def: wrap id) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 1891f0100..e344c6a0a 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -1,10 +1,10 @@ (;module: lux (lux [io] - (control functor - applicative + (control ["F" functor] + ["A" applicative] monad) - (concurrency ["A" atom]) + (concurrency ["a" atom]) [macro] (macro ["s" syntax #+ syntax:]) (type opaque))) @@ -14,15 +14,15 @@ (def: #hidden (freeze' generator) (All [a] (-> (-> [] a) (Lazy a))) - (let [cache (A;atom (: (Maybe ($ +0)) #;None))] + (let [cache (a;atom (: (Maybe ($ +0)) #;None))] (@opaque (function [_] - (case (io;run (A;get cache)) + (case (io;run (a;get cache)) (#;Some value) value _ (let [value (generator [])] - (exec (io;run (A;compare-and-swap _ (#;Some value) cache)) + (exec (io;run (a;compare-and-swap _ (#;Some value) cache)) value))))))) (def: #export (thaw l-value) @@ -34,11 +34,11 @@ [g!_ (macro;gensym "_")] (wrap (list (` (freeze' (function [(~ g!_)] (~ expr)))))))) -(struct: #export _ (Functor Lazy) +(struct: #export _ (F;Functor Lazy) (def: (map f fa) (freeze (f (thaw fa))))) -(struct: #export _ (Applicative Lazy) +(struct: #export _ (A;Applicative Lazy) (def: functor Functor<Lazy>) (def: (wrap a) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 9cf80d4a8..27d63f1fb 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -1,9 +1,9 @@ (;module: lux - (lux (control (monoid #as m #refer #all) - (functor #as F #refer #all) - (applicative #as A #refer #all) - ["M" monad #+ do Monad] + (lux (control ["m" monoid] + ["F" functor] + ["A" applicative] + [monad #+ do Monad] [eq #+ Eq]))) ## [Types] @@ -12,20 +12,20 @@ ## (#;Some a)) ## [Structures] -(struct: #export Monoid<Maybe> (All [a] (Monoid (Maybe a))) +(struct: #export Monoid<Maybe> (All [a] (m;Monoid (Maybe a))) (def: unit #;None) (def: (append xs ys) (case xs #;None ys (#;Some x) (#;Some x)))) -(struct: #export _ (Functor Maybe) +(struct: #export _ (F;Functor Maybe) (def: (map f ma) (case ma #;None #;None (#;Some a) (#;Some (f a))))) -(struct: #export _ (Applicative Maybe) +(struct: #export _ (A;Applicative Maybe) (def: functor Functor<Maybe>) (def: (wrap x) @@ -61,7 +61,7 @@ (struct: #export (MaybeT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a)))))) - (def: applicative (A;compA (get@ #M;applicative Monad<M>) Applicative<Maybe>)) + (def: applicative (A;compose (get@ #monad;applicative Monad<M>) Applicative<Maybe>)) (def: (join MmMma) (do Monad<M> [mMma MmMma] @@ -74,4 +74,28 @@ (def: #export (lift Monad<M>) (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) - (M;lift Monad<M> (:: Monad<Maybe> wrap))) + (monad;lift Monad<M> (:: Monad<Maybe> wrap))) + +(macro: #export (default tokens state) + {#;doc "## Allows you to provide a default value that will be used + ## if a (Maybe x) value turns out to be #;None. + (default 20 (#;Some 10)) => 10 + + (default 20 #;None) => 20"} + (case tokens + (^ (list else maybe)) + (let [g!temp (: Code [dummy-cursor (#;Symbol ["" ""])]) + code (` (case (~ maybe) + (#;Some (~ g!temp)) + (~ g!temp) + + #;None + (~ else)))] + (#;Right [state (list code)])) + + _ + (#;Left "Wrong syntax for default"))) + +(def: #export assume + (All [a] (-> (Maybe a) a)) + (|>. (default (undefined)))) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 82f8cadbb..b48aa5f7d 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -9,6 +9,7 @@ interval codec) (data ["R" result] + [maybe] [bit]))) ## [Structures] @@ -180,7 +181,7 @@ (def: (encode value) (loop [input value output ""] - (let [digit (assume (get-char <char-set> (n.% <base> input))) + (let [digit (maybe;assume (get-char <char-set> (n.% <base> input))) output' (_lux_proc ["text" "append"] [digit output]) input' (n./ <base> input)] (if (n.= +0 input') @@ -196,7 +197,7 @@ (loop [idx +1 output +0] (if (n.< input-size idx) - (let [digit (assume (get-char input idx))] + (let [digit (maybe;assume (get-char input idx))] (case (_lux_proc ["text" "index"] [<char-set> digit +0]) #;None (#R;Error (_lux_proc ["text" "append"] [<error> repr])) @@ -227,10 +228,10 @@ (loop [input (|> value (i./ <base>) (:: Number<Int> abs)) output (|> value (i.% <base>) (:: Number<Int> abs) int-to-nat (get-char <char-set>) - assume)] + maybe;assume)] (if (i.= 0 input) (_lux_proc ["text" "append"] [sign output]) - (let [digit (assume (get-char <char-set> (int-to-nat (i.% <base> input))))] + (let [digit (maybe;assume (get-char <char-set> (int-to-nat (i.% <base> input))))] (recur (i./ <base> input) (_lux_proc ["text" "append"] [digit output])))))))) @@ -247,7 +248,7 @@ (loop [idx (if (i.= -1 sign) +1 +0) output 0] (if (n.< input-size idx) - (let [digit (assume (get-char input idx))] + (let [digit (maybe;assume (get-char input idx))] (case (_lux_proc ["text" "index"] [<char-set> digit +0]) #;None (#R;Error <error>) @@ -266,7 +267,7 @@ (def: (de-prefix input) (-> Text Text) - (assume (_lux_proc ["text" "clip"] [input +1 (_lux_proc ["text" "size"] [input])]))) + (maybe;assume (_lux_proc ["text" "clip"] [input +1 (_lux_proc ["text" "size"] [input])]))) (do-template [<struct> <nat> <char-bit-size> <error>] [(struct: #export <struct> (Codec Text Deg) @@ -315,7 +316,7 @@ (_lux_proc ["text" "append"] ["." output]) (let [shifted (f.* <base> dec-left) digit (|> shifted (f.% <base>) frac-to-int int-to-nat - (get-char <char-set>) assume)] + (get-char <char-set>) maybe;assume)] (recur (f.% 1.0 shifted) (_lux_proc ["text" "append"] [output digit]))))))] (_lux_proc ["text" "append"] [whole-part decimal-part]))) @@ -323,8 +324,8 @@ (def: (decode repr) (case (_lux_proc ["text" "index"] [repr "." +0]) (#;Some split-index) - (let [whole-part (assume (_lux_proc ["text" "clip"] [repr +0 split-index])) - decimal-part (assume (_lux_proc ["text" "clip"] [repr (n.inc split-index) (_lux_proc ["text" "size"] [repr])]))] + (let [whole-part (maybe;assume (_lux_proc ["text" "clip"] [repr +0 split-index])) + decimal-part (maybe;assume (_lux_proc ["text" "clip"] [repr (n.inc split-index) (_lux_proc ["text" "size"] [repr])]))] (case [(:: <int> decode whole-part) (:: <int> decode decimal-part)] (^multi [(#;Some whole) (#;Some decimal)] @@ -368,8 +369,8 @@ (if (n.<= chunk-size num-digits) (list digits) (let [boundary (n.- chunk-size num-digits) - chunk (assume (_lux_proc ["text" "clip"] [digits boundary num-digits])) - remaining (assume (_lux_proc ["text" "clip"] [digits +0 boundary]))] + chunk (maybe;assume (_lux_proc ["text" "clip"] [digits boundary num-digits])) + remaining (maybe;assume (_lux_proc ["text" "clip"] [digits +0 boundary]))] (list& chunk (segment-digits chunk-size remaining))))))) (def: (bin-segment-to-hex input) @@ -497,11 +498,11 @@ (def: (encode value) (let [sign (:: Number<Frac> signum value) raw-bin (:: Binary@Codec<Text,Frac> encode value) - dot-idx (assume (_lux_proc ["text" "index"] [raw-bin "." +0])) - whole-part (assume (_lux_proc ["text" "clip"] [raw-bin - (if (f.= -1.0 sign) +1 +0) - dot-idx])) - decimal-part (assume (_lux_proc ["text" "clip"] [raw-bin (n.inc dot-idx) (_lux_proc ["text" "size"] [raw-bin])])) + dot-idx (maybe;assume (_lux_proc ["text" "index"] [raw-bin "." +0])) + whole-part (maybe;assume (_lux_proc ["text" "clip"] [raw-bin + (if (f.= -1.0 sign) +1 +0) + dot-idx])) + decimal-part (maybe;assume (_lux_proc ["text" "clip"] [raw-bin (n.inc dot-idx) (_lux_proc ["text" "size"] [raw-bin])])) hex-output (|> (<from> false decimal-part) ["."] (_lux_proc ["text" "append"]) @@ -520,8 +521,8 @@ 1.0)] (case (_lux_proc ["text" "index"] [repr "." +0]) (#;Some split-index) - (let [whole-part (assume (_lux_proc ["text" "clip"] [repr (if (f.= -1.0 sign) +1 +0) split-index])) - decimal-part (assume (_lux_proc ["text" "clip"] [repr (n.inc split-index) (_lux_proc ["text" "size"] [repr])])) + (let [whole-part (maybe;assume (_lux_proc ["text" "clip"] [repr (if (f.= -1.0 sign) +1 +0) split-index])) + decimal-part (maybe;assume (_lux_proc ["text" "clip"] [repr (n.inc split-index) (_lux_proc ["text" "size"] [repr])])) as-binary (|> (<to> decimal-part) ["."] (_lux_proc ["text" "append"]) @@ -602,7 +603,7 @@ (def: (digits-get idx digits) (-> Nat Digits Nat) - (default +0 (_lux_proc ["array" "get"] [digits idx]))) + (maybe;default +0 (_lux_proc ["array" "get"] [digits idx]))) (def: (digits-put idx digit digits) (-> Nat Nat Digits Digits) @@ -677,7 +678,7 @@ (loop [idx +0 output (make-digits [])] (if (n.< length idx) - (let [char (assume (get-char input idx))] + (let [char (maybe;assume (get-char input idx))] (case (_lux_proc ["text" "index"] ["0123456789" char +0]) #;None #;None @@ -749,7 +750,7 @@ (if (and dotted? (n.<= (n.inc bit;width) length)) (case (|> (_lux_proc ["text" "clip"] [input +1 length]) - assume + maybe;assume text-to-digits) (#;Some digits) (loop [digits digits diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index 3b8fb7f00..e1cb226a0 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -29,7 +29,7 @@ "The imaginary part can be omitted if it's 0." (complex real))} (wrap (list (` {#;;real (~ real) - #;;imaginary (~ (default (' 0.0) + #;;imaginary (~ (maybe;default (' 0.0) ?imaginary))})))) (def: #export i Complex (complex 0.0 1.0)) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 3352fd02d..83f987827 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -11,7 +11,8 @@ [text "Text/" Monoid<Text>] text/format ["R" result] - [product]) + [product] + [maybe]) [macro] (macro [code] ["s" syntax #+ syntax: Syntax]))) @@ -127,7 +128,7 @@ (def: part-encode (-> Nat Text) - (|>. n/encode (text;split +1) (default (undefined)) product;right)) + (|>. n/encode (text;split +1) maybe;assume product;right)) (def: part-decode (-> Text (R;Result Nat)) @@ -155,5 +156,5 @@ "The denominator can be omitted if it's 1." (ratio numerator))} (wrap (list (` (normalize {#;;numerator (~ numerator) - #;;denominator (~ (default (' +1) + #;;denominator (~ (maybe;default (' +1) ?denominator))}))))) diff --git a/stdlib/source/lux/data/result.lux b/stdlib/source/lux/data/result.lux index aa9de092b..df52522af 100644 --- a/stdlib/source/lux/data/result.lux +++ b/stdlib/source/lux/data/result.lux @@ -1,7 +1,7 @@ (;module: - [lux #- assume default] - (lux (control functor - applicative + lux + (lux (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad]))) ## [Types] @@ -10,13 +10,13 @@ (#Success a)) ## [Structures] -(struct: #export _ (Functor Result) +(struct: #export _ (F;Functor Result) (def: (map f ma) (case ma (#Error msg) (#Error msg) (#Success datum) (#Success (f datum))))) -(struct: #export _ (Applicative Result) +(struct: #export _ (A;Applicative Result) (def: functor Functor<Result>) (def: (wrap a) @@ -46,7 +46,7 @@ (struct: #export (ResultT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (Result a)))))) - (def: applicative (compA (get@ #M;applicative Monad<M>) Applicative<Result>)) + (def: applicative (A;compose (get@ #M;applicative Monad<M>) Applicative<Result>)) (def: (join MeMea) (do Monad<M> [eMea MeMea] diff --git a/stdlib/source/lux/data/store.lux b/stdlib/source/lux/data/store.lux index e60c3703c..ef92b68c4 100644 --- a/stdlib/source/lux/data/store.lux +++ b/stdlib/source/lux/data/store.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (control functor + (lux (control ["F" functor] comonad) (type auto))) @@ -13,7 +13,7 @@ {#cursor (get@ #cursor wa) #peek (function [s] (f (set@ #cursor s wa)))}) -(struct: #export Functor<Store> (All [s] (Functor (Store s))) +(struct: #export Functor<Store> (All [s] (F;Functor (Store s))) (def: (map f fa) (extend (function [store] (f (:: store peek (:: store cursor)))) @@ -39,5 +39,5 @@ (|> store (::: split) (peeks change))) (def: #export (experiment Functor<f> change store) - (All [f s a] (-> (Functor f) (-> s (f s)) (Store s a) (f a))) + (All [f s a] (-> (F;Functor f) (-> s (f s)) (Store s a) (f a))) (:: Functor<f> map (::: peek) (change (::: cursor)))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 2819e9c16..ec3d2f3c1 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -26,6 +26,7 @@ [(def: #export (<name> input) (-> Text Text) (_lux_proc ["text" <proc>] [input]))] + [lower-case "lower-case"] [upper-case "upper-case"] [trim "trim"] @@ -172,11 +173,11 @@ (def: #export (replace-once pattern value template) (-> Text Text Text Text) - (default template + (maybe;default template (do maybe;Monad<Maybe> - [[pre post] (split-with pattern template)] - (let [(^open) Monoid<Text>] - (wrap ($_ append pre value post)))))) + [[pre post] (split-with pattern template) + #let [(^open) Monoid<Text>]] + (wrap ($_ append pre value post))))) (def: #export (enclose [left right] content) {#;doc "Surrounds the given content text with left and right side additions."} diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index ae3c4859f..cb68fe93d 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -1,8 +1,6 @@ (;module: [lux #- not] - (lux (control functor - applicative - [monad #+ do Monad] + (lux (control [monad #+ do Monad] ["p" parser]) (data [text "text/" Monoid<Text>] [product] @@ -19,7 +17,7 @@ (def: (remaining offset tape) (-> Offset Text Text) - (|> tape (text;split offset) assume product;right)) + (|> tape (text;split offset) maybe;assume product;right)) (def: cannot-lex-error Text "Cannot lex from empty text.") @@ -121,7 +119,7 @@ (-> Nat Nat (Lexer Text)) (do p;Monad<Parser> [char any - #let [char' (assume (text;nth +0 char))] + #let [char' (maybe;assume (text;nth +0 char))] _ (p;assert ($_ text/append "Character is not within range: " (text;from-code bottom) "-" (text;from-code top)) (and (n.>= bottom char') (n.<= top char')))] diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index c42aa9ba3..6d430b756 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -8,6 +8,7 @@ [number "Int/" Codec<Text,Int>] [product] ["R" result] + [maybe] (coll [list "L/" Fold<List> Monad<List>])) [macro #- run] (macro [code] @@ -77,9 +78,9 @@ (def: re-range^ (l;Lexer Code) (do p;Monad<Parser> - [from (|> regex-char^ (:: @ map (|>. (text;nth +0) assume))) + [from (|> regex-char^ (:: @ map (|>. (text;nth +0) maybe;assume))) _ (l;this "-") - to (|> regex-char^ (:: @ map (|>. (text;nth +0) assume)))] + to (|> regex-char^ (:: @ map (|>. (text;nth +0) maybe;assume)))] (wrap (` (l;range (~ (code;nat from)) (~ (code;nat to))))))) (def: re-char^ @@ -487,7 +488,7 @@ [g!temp (macro;gensym "temp")] (wrap (list& (` (^multi (~ g!temp) [(l;run (~ g!temp) (regex (~ (code;text pattern)))) - (#R;Success (~ (default g!temp + (#R;Success (~ (maybe;default g!temp bindings)))])) body branches)))) diff --git a/stdlib/source/lux/data/trace.lux b/stdlib/source/lux/data/trace.lux index 137713fa7..7f6a376a9 100644 --- a/stdlib/source/lux/data/trace.lux +++ b/stdlib/source/lux/data/trace.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control ["m" monoid] - functor + ["F" functor] comonad) [macro])) @@ -9,7 +9,7 @@ {#monoid (m;Monoid t) #trace (-> t a)}) -(struct: #export Functor<Trace> (All [t] (Functor (Trace t))) +(struct: #export Functor<Trace> (All [t] (F;Functor (Trace t))) (def: (map f fa) (update@ #trace (. f) fa))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 731e4e482..ef4844d88 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -7,7 +7,7 @@ (data (coll [list "L/" Monad<List> Fold<List> Monoid<List>] [array #+ Array]) number - maybe + [maybe] [product] [text "Text/" Eq<Text> Monoid<Text>] text/format @@ -313,7 +313,7 @@ (code;symbol ["" name]) (#;Some [pname pbounds]) - (class->type' mode type-params in-array? (default (undefined) (list;head pbounds)))) + (class->type' mode type-params in-array? (maybe;assume (list;head pbounds)))) (#GenericClass name+params) (generic-class->type' mode type-params in-array? name+params @@ -357,7 +357,7 @@ (def: (get-import name imports) (-> Text ClassImports (Maybe Text)) - (:: Functor<Maybe> map product;right + (:: maybe;Functor<Maybe> map product;right (list;find (|>. product;left (Text/= name)) imports))) @@ -481,7 +481,7 @@ (format "java.lang." name) ## else - (default name (get-import name imports)))) + (maybe;default name (get-import name imports)))) (def: type-var-class Text "java.lang.Object") @@ -497,7 +497,7 @@ type-var-class (#;Some [pname pbounds]) - (simple-class$ params (default (undefined) (list;head pbounds)))) + (simple-class$ params (maybe;assume (list;head pbounds)))) (^or (#GenericWildcard #;None) (#GenericWildcard (#;Some [#LowerBound _]))) type-var-class @@ -787,7 +787,7 @@ (-> ClassImports (Syntax (List Annotation))) (do p;Monad<Parser> [anns?? (p;opt (annotations^' imports))] - (wrap (default (list) anns??)))) + (wrap (maybe;default (list) anns??)))) (def: (throws-decl'^ imports type-vars) (-> ClassImports (List TypeParam) (Syntax (List GenericType))) @@ -799,7 +799,7 @@ (-> ClassImports (List TypeParam) (Syntax (List GenericType))) (do p;Monad<Parser> [exs? (p;opt (throws-decl'^ imports type-vars))] - (wrap (default (list) exs?)))) + (wrap (maybe;default (list) exs?)))) (def: (method-decl^ imports type-vars) (-> ClassImports (List TypeParam) (Syntax [MemberDecl MethodDecl])) @@ -1022,8 +1022,8 @@ ?prim-mode (p;opt primitive-mode^) args (import-member-args^ imports total-vars) [io? try? maybe?] import-member-return-flags^] - (wrap (#ConstructorDecl [{#import-member-mode (default #AutoPrM ?prim-mode) - #import-member-alias (default "new" ?alias) + (wrap (#ConstructorDecl [{#import-member-mode (maybe;default #AutoPrM ?prim-mode) + #import-member-alias (maybe;default "new" ?alias) #import-member-kind #VirtualIMK #import-member-tvars tvars #import-member-args args @@ -1044,8 +1044,8 @@ args (import-member-args^ imports total-vars) [io? try? maybe?] import-member-return-flags^ return (generic-type^ imports total-vars)] - (wrap (#MethodDecl [{#import-member-mode (default #AutoPrM ?prim-mode) - #import-member-alias (default name ?alias) + (wrap (#MethodDecl [{#import-member-mode (maybe;default #AutoPrM ?prim-mode) + #import-member-alias (maybe;default name ?alias) #import-member-kind kind #import-member-tvars tvars #import-member-args args @@ -1062,7 +1062,7 @@ gtype (generic-type^ imports owner-vars) maybe? (s;this? (' #?)) setter? (s;this? (' #!))] - (wrap (#FieldAccessDecl {#import-field-mode (default #AutoPrM ?prim-mode) + (wrap (#FieldAccessDecl {#import-field-mode (maybe;default #AutoPrM ?prim-mode) #import-field-name name #import-field-static? static? #import-field-maybe? maybe? diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index 11b97f0a7..f7459251d 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -1,7 +1,7 @@ (;module: {#;doc "A method for abstracting I/O and effectful computations to make it safe while writing pure functional code."} lux - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad]) (data (coll [list])))) @@ -26,11 +26,11 @@ (#;Left "Wrong syntax for io"))) ## [Structures] -(struct: #export _ (Functor IO) +(struct: #export _ (F;Functor IO) (def: (map f ma) (io (f (ma (:! Void [])))))) -(struct: #export _ (Applicative IO) +(struct: #export _ (A;Applicative IO) (def: functor Functor<IO>) (def: (wrap x) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index a7a5d22cd..4a9b8e8f7 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -1,21 +1,21 @@ (;module: {#;doc "Functions for extracting information from the state of the compiler."} lux (lux (macro [code]) - (control functor - applicative + (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad]) (data (coll [list "L/" Monoid<List> Monad<List>]) [number] [text "T/" Monoid<Text> Eq<Text>] [product] [ident "Ident/" Codec<Text,Ident>] - maybe + [maybe] ["R" result]))) ## (type: (Lux a) ## (-> Compiler (R;Result [Compiler a]))) -(struct: #export _ (Functor Lux) +(struct: #export _ (F;Functor Lux) (def: (map f fa) (function [state] (case (fa state) @@ -25,7 +25,7 @@ (#R;Success [state' a]) (#R;Success [state' (f a)]))))) -(struct: #export _ (Applicative Lux) +(struct: #export _ (A;Applicative Lux) (def: functor Functor<Lux>) (def: (wrap x) @@ -222,8 +222,8 @@ [(def: #export (<name> anns) {#;doc (#;TextA ($_ T/append "Looks up the arguments of a " <desc> "."))} (-> Anns (List Text)) - (default (list) - (do Monad<Maybe> + (maybe;default (list) + (do maybe;Monad<Maybe> [_args (get-ann (ident-for <tag>) anns) args (try-mlist _args)] (M;map @ try-mtext args))))] @@ -235,7 +235,7 @@ (def: (find-macro' modules this-module module name) (-> (List [Text Module]) Text Text Text (Maybe Macro)) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [$module (get module modules) [def-type def-anns def-value] (: (Maybe Def) (|> (: Module $module) (get@ #;defs) (get name)))] (if (and (macro? def-anns) @@ -425,7 +425,7 @@ (function [state] (let [test (: (-> [Text [Type Top]] Bool) (|>. product;left (T/= name)))] - (case (do Monad<Maybe> + (case (do maybe;Monad<Maybe> [scope (list;find (function [env] (or (list;any? test (: (List [Text [Type Top]]) (get@ [#;locals #;mappings] env))) @@ -449,7 +449,7 @@ (-> Ident (Lux Def)) (function [state] (case (: (Maybe Def) - (do Monad<Maybe> + (do maybe;Monad<Maybe> [#let [[v-prefix v-name] name] (^slots [#;defs]) (get v-prefix (get@ #;modules state))] (get v-name defs))) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 58afcd1a3..0cf927f00 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -416,13 +416,13 @@ (#;Bound idx) (let [idx (adjusted-idx env idx)] (if (n.= +0 idx) - (|> (dict;get idx env) (default (undefined)) product;left (to-ast env)) + (|> (dict;get idx env) maybe;assume product;left (to-ast env)) (` (;$ (~ (code;nat (n.dec idx))))))) (#;Apply #;Void (#;Bound idx)) (let [idx (adjusted-idx env idx)] (if (n.= +0 idx) - (|> (dict;get idx env) (default (undefined)) product;left (to-ast env)) + (|> (dict;get idx env) maybe;assume product;left (to-ast env)) (undefined))) (^template [<tag>] diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 379be9f49..321a80492 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -1,8 +1,6 @@ (;module: {#;doc "Codecs for values in the JSON format."} lux - (lux (control functor - applicative - [monad #+ do Monad] + (lux (control [monad #+ do Monad] [eq #+ Eq] codec ["p" parser "p/" Monad<Parser>]) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 4a05041f6..96f1b658f 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -1,9 +1,7 @@ (;module: lux (lux [macro #+ Monad<Lux> with-gensyms] - (control functor - applicative - ["M" monad #+ do Monad] + (control ["M" monad #+ do Monad] [eq #+ Eq] ["p" parser]) (data [bool] @@ -12,6 +10,7 @@ [ident] (coll [list #* "" Functor<List> Fold<List> "List/" Monoid<List>]) [product] + [maybe] ["R" result])) (.. [code "Code/" Eq<Code>])) @@ -218,7 +217,7 @@ [constructor-args (constructor-args^ imports class-vars)] [methods (some (overriden-method-def^ imports))]) (let [def-code ($_ Text/append "anon-class:" - (spaced (list (super-class-decl$ (;default object-super-class super)) + (spaced (list (super-class-decl$ (maybe;default object-super-class super)) (with-brackets (spaced (map super-class-decl$ interfaces))) (with-brackets (spaced (map constructor-arg$ constructor-args))) (with-brackets (spaced (map (method-def$ id) methods))))))] diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 84d40fb03..33ca61b8b 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -4,7 +4,8 @@ ["p" parser]) (data (coll [list "L/" Functor<List>]) [ident "Ident/" Eq<Ident>] - [product]) + [product] + [maybe]) [macro] (macro ["s" syntax #+ syntax: Syntax])) [.. #*]) @@ -87,7 +88,7 @@ (def: (find-definition-args meta-data) (-> (List [Ident Code]) (List Text)) - (default (list) + (maybe;default (list) (case (list;find (|>. product;left (Ident/= ["lux" "func-args"])) meta-data) (^multi (#;Some [_ value]) [(p;run (list value) list-meta^) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index f9989be40..f054ec1e4 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -1,18 +1,19 @@ (;module: {#;doc "Pseudo-random number generation (PRNG) algorithms."} [lux #- list] - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad] hash) (data [bit] [text "Text/" Monoid<Text>] text/format [product] + [maybe] [number] (number ["r" ratio] ["c" complex]) (coll [list "List/" Fold<List>] - ["A" array] + ["a" array] ["D" dict] ["Q" queue] ["S" set] @@ -28,13 +29,13 @@ {#;doc "A producer of random values based on a PRNG."} (-> PRNG [PRNG a])) -(struct: #export _ (Functor Random) +(struct: #export _ (F;Functor Random) (def: (map f fa) (function [state] (let [[state' a] (fa state)] [state' (f a)])))) -(struct: #export _ (Applicative Random) +(struct: #export _ (A;Applicative Random) (def: functor Functor<Random>) (def: (wrap a) @@ -200,7 +201,7 @@ [values (list size value-gen)] (wrap (|> values <ctor>))))] - [array A;Array A;from-list] + [array a;Array a;from-list] [queue Q;Queue Q;from-list] [stack ST;Stack (List/fold ST;push ST;empty)] ) @@ -273,9 +274,7 @@ (def: (swap from to vec) (All [a] (-> Nat Nat (V;Vector a) (V;Vector a))) - (V;put to (default (undefined) - (V;nth from vec)) - vec)) + (V;put to (maybe;assume (V;nth from vec)) vec)) (def: #export (shuffle seed vector) {#;doc "Shuffle a vector randomly based on a seed value."} diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 5d95e2f6b..09165c0b7 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -3,13 +3,12 @@ (lux [macro #+ Monad<Lux> with-gensyms] (macro ["s" syntax #+ syntax: Syntax] [code]) - (control functor - applicative - ["M" monad #+ do Monad] + (control ["M" monad #+ do Monad] ["p" parser]) (concurrency [promise #+ Promise Monad<Promise>]) (data (coll [list "L/" Monad<List> Fold<List>]) [product] + [maybe] [text] text/format ["E" result]) @@ -112,7 +111,7 @@ (def: #hidden (repeat ?seed times random-test) (-> (Maybe Nat) Nat (R;Random Test) Test) - (repeat' (default (|> (io;run instant;now) instant;to-millis int-to-nat) + (repeat' (maybe;default (|> (io;run instant;now) instant;to-millis int-to-nat) ?seed) (case ?seed #;None times @@ -195,10 +194,10 @@ false))) (test "Can have defaults for Maybe values." - (and (is "yolo" (default "yolo" + (and (is "yolo" (maybe;default "yolo" #;None)) - (is "lol" (default "yolo" + (is "lol" (maybe;default "yolo" (#;Some "lol"))))) )) "Also works with random generation of values for property-based testing." diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 85c878211..4e74a3b73 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -7,6 +7,7 @@ ["p" parser] [monad #+ do]) (data ["R" result] + [maybe] [number "int/" Codec<Text,Int>] [text "text/" Monoid<Text>] (text ["l" lexer]) @@ -286,7 +287,7 @@ normal-months) month-days (|> months (v;nth (int-to-nat (i.dec utc-month))) - assume)] + maybe;assume)] _ (l;this "-") utc-day lex-section _ (p;assert "Invalid day." diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 5fb8bf4f1..c626e9ec4 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -11,6 +11,7 @@ (text ["l" lexer]) [number "int/" Codec<Text,Int>] ["R" result] + [maybe] (coll [list "L/" Fold<List> Functor<List>] ["v" vector "v/" Functor<Vector> Fold<Vector>])) (type opaque)) @@ -252,7 +253,7 @@ normal-months) month-days (|> months (v;nth (int-to-nat (i.dec utc-month))) - assume)] + maybe;assume)] _ (l;this "-") utc-day lex-section _ (p;assert "Invalid day." diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index 72d63483f..8fe0465ba 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -35,7 +35,7 @@ [#;ExQ]) (#;Bound idx) - (default (error! (Text/append "Unknown type var: " (Nat/encode idx))) + (maybe;default (error! (Text/append "Unknown type var: " (Nat/encode idx))) (list;nth idx env)) _ @@ -336,7 +336,7 @@ (quantified? _type) (#;Apply A F) - (default false + (maybe;default false (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 08c5aa784..9bb8a5657 100644 --- a/stdlib/source/lux/type/auto.lux +++ b/stdlib/source/lux/type/auto.lux @@ -9,7 +9,8 @@ (coll [list "List/" Monad<List> Fold<List>] [dict]) [bool] - [product]) + [product] + [maybe]) [macro #+ Monad<Lux>] (macro [code] ["s" syntax #+ syntax: Syntax]) @@ -156,8 +157,7 @@ (#;UnivQ _) (do Monad<Check> [[id var] tc;create-var] - (apply-function-type (default (undefined) - (type;apply (list var) func)) + (apply-function-type (maybe;assume (type;apply (list var) func)) arg)) (#;Function input output) @@ -174,8 +174,7 @@ (#;UnivQ _) (do Monad<Check> [[id var] tc;create-var - [ids final-output] (concrete-type (default (undefined) - (type;apply (list var) type)))] + [ids final-output] (concrete-type (maybe;assume (type;apply (list var) type)))] (wrap [(#;Cons id ids) final-output])) diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 7d1bd0462..11b584859 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -2,8 +2,8 @@ Very useful for writing advanced macros."} lux - (lux (control functor - applicative + (lux (control ["F" functor] + ["A" applicative] ["M" monad #+ do Monad]) (data [text "text/" Monoid<Text> Eq<Text>] [number "nat/" Codec<Text,Nat>] @@ -22,7 +22,7 @@ (type: #export Type-Vars (List [Nat (Maybe Type)])) -(struct: #export _ (Functor Check) +(struct: #export _ (F;Functor Check) (def: (map f fa) (function [context] (case (fa context) @@ -33,7 +33,7 @@ (#R;Success [context' (f output)]) )))) -(struct: #export _ (Applicative Check) +(struct: #export _ (A;Applicative Check) (def: functor Functor<Check>) (def: (wrap x) diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux index 961be9b03..786e7806a 100644 --- a/stdlib/source/lux/type/object.lux +++ b/stdlib/source/lux/type/object.lux @@ -5,7 +5,7 @@ (data [text] text/format [product] - maybe + [maybe] [ident #+ "Ident/" Eq<Ident>] (coll [list "L/" Functor<List> Fold<List> Monoid<List>] [set #+ Set])) @@ -106,7 +106,7 @@ (list;enumerate inputs)) g!destructuring (L/fold (function [_ g!bottom] (` [(~ g!_temp) (~ g!_temp) (~ g!bottom)])) (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]) - (default g!states (list;tail g!states)))] + (maybe;default g!states (list;tail g!states)))] (` (def: (~@ (csw;export export)) ((~ g!method) (~@ g!_args) (~ g!_object)) (All [(~@ g!parameters) (~ g!ext) (~@ g!states) (~@ g!type-vars)] (-> (~@ inputs) (~ g!self-object) (~ output))) diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index e76a1e009..f9bf5eec4 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -6,6 +6,7 @@ ["T" task] [frp]) (data ["R" result] + [maybe] (coll [array])) (type opaque) (world [blob #+ Blob]) @@ -50,7 +51,7 @@ (: (io;IO (R;Result InetAddress)) (case (array;size addresses) +0 (io;io (ex;throw Cannot-Resolve-Address address)) - +1 (wrap (assume (array;get +0 addresses))) + +1 (wrap (maybe;assume (array;get +0 addresses))) _ (io;io (ex;throw Multiple-Candidate-Addresses address)))))) (opaque: #export UDP {} diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 41b3bc555..546d7f14f 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -5,7 +5,8 @@ [io] [math] ["R" math/random] - (data [text "T/" Eq<Text>] + (data [maybe] + [text "T/" Eq<Text>] text/format) [macro] (macro ["s" syntax #+ syntax:]))) @@ -161,10 +162,10 @@ false))) (test "Can have defaults for Maybe values." - (and (is "yolo" (default "yolo" + (and (is "yolo" (maybe;default "yolo" #;None)) - (is "lol" (default "yolo" + (is "lol" (maybe;default "yolo" (#;Some "lol"))))) )) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux index b7403d8d5..ade1700b5 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -3,6 +3,7 @@ (lux [io] (control ["M" monad #+ do Monad]) (data [number] + [maybe] (coll [list "" Functor<List> "List/" Fold<List>]) text/format) (concurrency ["&" stm] @@ -25,9 +26,9 @@ _ (&;update (i.* 3) _var)] (&;read _var))) ?c1+changes' changes - #let [[c1 changes'] (default [-1 changes] ?c1+changes')] + #let [[c1 changes'] (maybe;default [-1 changes] ?c1+changes')] ?c2+changes' changes' - #let [[c2 changes'] (default [-1 changes] ?c2+changes')]] + #let [[c2 changes'] (maybe;default [-1 changes] ?c2+changes')]] ($_ seq (test "Can read STM vars." (i.= 0 output1)) diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux index b98c20c66..3f344a1be 100644 --- a/stdlib/test/test/lux/data/coll/array.lux +++ b/stdlib/test/test/lux/data/coll/array.lux @@ -5,7 +5,8 @@ [io] (data (coll ["&" array] [list]) - [number]) + [number] + [maybe]) ["R" math/random]) lux/test) @@ -51,8 +52,7 @@ idx (:: @ map (n.% size) R;nat) array (|> (R;array size R;nat) (R;filter (|>. &;to-list (list;any? n.odd?)))) - #let [value (default (undefined) - (&;get idx array))]] + #let [value (maybe;assume (&;get idx array))]] ($_ seq (test "Shouldn't be able to find a value in an unoccupied cell." (case (&;get idx (&;remove idx array)) diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux index b317cdfa8..defea0534 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -6,6 +6,7 @@ (data [text] text/format [number] + [maybe] (coll ["&" dict] [list "L/" Fold<List> Functor<List>])) ["r" math/random]) @@ -59,7 +60,7 @@ (test "Shouldn't be able to put~ an existing key." (or (n.= +0 size) - (let [first-key (|> dict &;keys list;head (default (undefined)))] + (let [first-key (|> dict &;keys list;head maybe;assume)] (case (&;get first-key (&;put~ first-key test-val dict)) (#;Some v) (not (n.= test-val v)) _ true)))) @@ -115,13 +116,11 @@ (test "Should be able to re-bind existing values to different keys." (or (n.= +0 size) - (let [first-key (|> dict &;keys list;head (default (undefined))) + (let [first-key (|> dict &;keys list;head maybe;assume) rebound (&;re-bind first-key non-key dict)] (and (n.= (&;size dict) (&;size rebound)) (&;contains? non-key rebound) (not (&;contains? first-key rebound)) - (n.= (default (undefined) - (&;get first-key dict)) - (default (undefined) - (&;get non-key rebound))))))) + (n.= (maybe;assume (&;get first-key dict)) + (maybe;assume (&;get non-key rebound))))))) )) diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux index 08bd547f4..087c9d831 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -7,7 +7,8 @@ [text "Text/" Monoid<Text>] [number] [bool] - [product]) + [product] + [maybe]) ["R" math/random]) lux/test) @@ -56,8 +57,7 @@ (&;any? (bool;complement n.even?) sample))) (test "Any element of the list can be considered its member." - (let [elem (default (undefined) - (&;nth idx sample))] + (let [elem (maybe;assume (&;nth idx sample))] (&;member? number;Eq<Nat> sample elem))) )) @@ -72,19 +72,15 @@ (^open "&/") &;Functor<List>]] ($_ seq (test "Appending the head and the tail should yield the original list." - (let [head (default (undefined) - (&;head sample)) - tail (default (undefined) - (&;tail sample))] + (let [head (maybe;assume (&;head sample)) + tail (maybe;assume (&;tail sample))] (= sample (#;Cons head tail)))) (test "Appending the inits and the last should yield the original list." (let [(^open) &;Monoid<List> - inits (default (undefined) - (&;inits sample)) - last (default (undefined) - (&;last sample))] + inits (maybe;assume (&;inits sample)) + last (maybe;assume (&;last sample))] (= sample (append inits (list last))))) diff --git a/stdlib/test/test/lux/data/coll/priority-queue.lux b/stdlib/test/test/lux/data/coll/priority-queue.lux index d2fdb9969..51b9aee5e 100644 --- a/stdlib/test/test/lux/data/coll/priority-queue.lux +++ b/stdlib/test/test/lux/data/coll/priority-queue.lux @@ -3,7 +3,8 @@ (lux [io] (control [monad #+ do Monad]) (data (coll ["&" priority-queue]) - [number]) + [number] + [maybe]) ["R" math/random]) lux/test) @@ -42,8 +43,8 @@ (or (n.= +0 (&;size sample)) (and (&;member? number;Eq<Nat> sample - (default (undefined) (&;peek sample))) + (maybe;assume (&;peek sample))) (not (&;member? number;Eq<Nat> (&;pop sample) - (default (undefined) (&;peek sample)))))))) + (maybe;assume (&;peek sample)))))))) )) diff --git a/stdlib/test/test/lux/data/coll/stack.lux b/stdlib/test/test/lux/data/coll/stack.lux index 60fb1a4bd..981d73197 100644 --- a/stdlib/test/test/lux/data/coll/stack.lux +++ b/stdlib/test/test/lux/data/coll/stack.lux @@ -4,7 +4,8 @@ (control [monad #+ do Monad]) (data (coll ["&" stack] [list "" Fold<List>]) - [number]) + [number] + [maybe]) ["R" math/random]) lux/test) @@ -37,6 +38,6 @@ (and (is sample (&;pop (&;push new-top sample))) (n.= (n.inc (&;size sample)) (&;size (&;push new-top sample))) - (|> (&;push new-top sample) &;peek (default (undefined)) + (|> (&;push new-top sample) &;peek maybe;assume (is new-top)))) )) diff --git a/stdlib/test/test/lux/data/coll/stream.lux b/stdlib/test/test/lux/data/coll/stream.lux index 0dfc03ed2..053228278 100644 --- a/stdlib/test/test/lux/data/coll/stream.lux +++ b/stdlib/test/test/lux/data/coll/stream.lux @@ -4,7 +4,8 @@ (control [monad #+ do Monad] comonad [cont]) - (data [text "Text/" Monoid<Text>] + (data [maybe] + [text "Text/" Monoid<Text>] text/format (coll [list] ["&" stream]) @@ -91,9 +92,9 @@ (test "Can cycle over the same elements as an infinite stream." (|> (&;cycle cycle-seed) - (default (undefined)) + maybe;assume (&;nth cycle-sample-idx) - (n.= (default (undefined) - (list;nth (n.% size cycle-sample-idx) - cycle-seed))))) + (n.= (|> cycle-seed + (list;nth (n.% size cycle-sample-idx)) + maybe;assume)))) )) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index 9154459b9..a65292cf0 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -8,7 +8,8 @@ [rose])) [text] text/format - [number]) + [number] + [maybe]) ["r" math/random]) lux/test) @@ -76,9 +77,9 @@ zipper (|> zipper &;down (&;insert-left pre-val) - (default (undefined)) + maybe;assume (&;insert-right post-val) - (default (undefined)) + maybe;assume &;up)] (and (|> zipper &;down &;value (is pre-val)) (|> zipper &;down &;right &;value (is mid-val)) diff --git a/stdlib/test/test/lux/data/coll/vector.lux b/stdlib/test/test/lux/data/coll/vector.lux index f197b8f10..2d7d00576 100644 --- a/stdlib/test/test/lux/data/coll/vector.lux +++ b/stdlib/test/test/lux/data/coll/vector.lux @@ -6,7 +6,8 @@ [list "List/" Fold<List> Functor<List>]) [text "Text/" Monoid<Text>] text/format - [number]) + [number] + [maybe]) ["R" math/random]) lux/test) @@ -35,13 +36,13 @@ (|> sample (&;put idx non-member) (&;nth idx) - (default (undefined)) + maybe;assume (is non-member))) (test "Can update elements of vectors." (|> sample (&;put idx non-member) (&;update idx n.inc) - (&;nth idx) (default (undefined)) + (&;nth idx) maybe;assume (n.= (n.inc non-member)))) (test "Can safely transform to/from lists." diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index 382659ab0..b43aee394 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -8,6 +8,7 @@ text/format [ident] ["R" result] + [maybe] (format ["&" xml]) (coll [dict] [list "L/" Functor<List>])) @@ -25,7 +26,7 @@ (r;Random Nat) (do r;Monad<Random> [idx (|> r;nat (:: @ map (n.% (text;size char-range))))] - (wrap (assume (text;nth idx char-range))))) + (wrap (maybe;assume (text;nth idx char-range))))) (def: (size^ bottom top) (-> Nat Nat (r;Random Nat)) diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux index 3e50f2035..8c149e3f4 100644 --- a/stdlib/test/test/lux/type.lux +++ b/stdlib/test/test/lux/type.lux @@ -6,7 +6,7 @@ (data [text "Text/" Monoid<Text>] text/format [number] - maybe + [maybe] (coll [list])) ["R" math/random] ["&" type]) @@ -51,8 +51,8 @@ (context: "Type application" (test "Can apply quantified types (universal and existential quantification)." - (and (default false - (do Monad<Maybe> + (and (maybe;default false + (do maybe;Monad<Maybe> [partial (&;apply (list Bool) Meta) full (&;apply (list Int) partial)] (wrap (:: &;Eq<Type> = full (#;Product Bool Int))))) |