From 70534ffd9c346ac23f9d5574b9c7820dccebc350 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 19 Sep 2017 21:52:42 -0400 Subject: - Some refactoring. - Moved "assume" and "default" to lux/data/maybe. --- stdlib/source/lux.lux | 8 +- stdlib/source/lux/cli.lux | 8 +- stdlib/source/lux/concurrency/frp.lux | 8 +- stdlib/source/lux/concurrency/promise.lux | 8 +- stdlib/source/lux/concurrency/stm.lux | 8 +- stdlib/source/lux/concurrency/task.lux | 8 +- stdlib/source/lux/control/applicative.lux | 6 +- stdlib/source/lux/control/concatenative.lux | 4 +- stdlib/source/lux/control/cont.lux | 8 +- stdlib/source/lux/control/exception.lux | 3 +- stdlib/source/lux/control/functor.lux | 2 +- stdlib/source/lux/control/parser.lux | 10 +- stdlib/source/lux/control/reader.lux | 10 +- stdlib/source/lux/control/state.lux | 12 +-- stdlib/source/lux/control/writer.lux | 10 +- stdlib/source/lux/data/coll/array.lux | 6 +- stdlib/source/lux/data/coll/list.lux | 10 +- stdlib/source/lux/data/coll/ordered/dict.lux | 12 +-- stdlib/source/lux/data/coll/priority-queue.lux | 3 +- stdlib/source/lux/data/coll/queue.lux | 4 +- stdlib/source/lux/data/coll/seq.lux | 122 +++++++++++------------ stdlib/source/lux/data/coll/set.lux | 5 +- stdlib/source/lux/data/coll/tree/zipper.lux | 2 +- stdlib/source/lux/data/coll/vector.lux | 63 ++++++------ stdlib/source/lux/data/env.lux | 4 +- stdlib/source/lux/data/format/json.lux | 10 +- stdlib/source/lux/data/identity.lux | 8 +- stdlib/source/lux/data/lazy.lux | 16 +-- stdlib/source/lux/data/maybe.lux | 42 ++++++-- stdlib/source/lux/data/number.lux | 43 ++++---- stdlib/source/lux/data/number/complex.lux | 2 +- stdlib/source/lux/data/number/ratio.lux | 7 +- stdlib/source/lux/data/result.lux | 12 +-- stdlib/source/lux/data/store.lux | 6 +- stdlib/source/lux/data/text.lux | 9 +- stdlib/source/lux/data/text/lexer.lux | 8 +- stdlib/source/lux/data/text/regex.lux | 7 +- stdlib/source/lux/data/trace.lux | 4 +- stdlib/source/lux/host.jvm.lux | 24 ++--- stdlib/source/lux/io.lux | 8 +- stdlib/source/lux/macro.lux | 20 ++-- stdlib/source/lux/macro/poly.lux | 4 +- stdlib/source/lux/macro/poly/json.lux | 4 +- stdlib/source/lux/macro/syntax.lux | 7 +- stdlib/source/lux/macro/syntax/common/reader.lux | 5 +- stdlib/source/lux/math/random.lux | 17 ++-- stdlib/source/lux/test.lux | 11 +- stdlib/source/lux/time/date.lux | 3 +- stdlib/source/lux/time/instant.lux | 3 +- stdlib/source/lux/type.lux | 4 +- stdlib/source/lux/type/auto.lux | 9 +- stdlib/source/lux/type/check.lux | 8 +- stdlib/source/lux/type/object.lux | 4 +- stdlib/source/lux/world/net/udp.jvm.lux | 3 +- 54 files changed, 331 insertions(+), 321 deletions(-) (limited to 'stdlib/source') 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 Monad]) [text "T/" Monoid] @@ -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 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) (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 @@ -96,7 +96,7 @@ fa) fb)))) -(struct: #export _ (Applicative Promise) +(struct: #export _ (A;Applicative Promise) (def: functor Functor) (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 Fold] @@ -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) (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 map (|>. #R;Success) computation)) -(struct: #export _ (Functor Task) +(struct: #export _ (F;Functor Task) (def: (map f fa) (:: P;Functor map (function [fa'] @@ -41,7 +41,7 @@ (#R;Success (f a)))) fa))) -(struct: #export _ (Applicative Task) +(struct: #export _ (A;Applicative Task) (def: functor Functor) (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 Applicative) +(struct: #export (compose Applicative Applicative) {#;doc "Applicative functor composition."} (All [F G] (-> (Applicative F) (Applicative G) (Applicative (All [a] (F (G a)))))) - (def: functor (F;compF (get@ #functor Applicative) - (get@ #functor Applicative))) + (def: functor (F;compose (get@ #functor Applicative) + (get@ #functor Applicative))) (def: wrap (|>. (:: Applicative wrap) (:: Applicative 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 (All [o] (Functor (All [i] (Cont i o)))) +(struct: #export Functor (All [o] (F;Functor (All [i] (Cont i o)))) (def: (map f fv) (function [k] (fv (. k f))))) -(struct: #export Applicative (All [o] (Applicative (All [i] (Cont i o)))) +(struct: #export Applicative (All [o] (A;Applicative (All [i] (Cont i o)))) (def: functor Functor) (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]) [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 Functor) +(struct: #export (compose Functor Functor) {#;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 Monoid]) @@ -13,7 +13,7 @@ (-> s (R;Result [s a]))) ## [Structures] -(struct: #export Functor (All [s] (Functor (Parser s))) +(struct: #export Functor (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 (All [s] (Applicative (Parser s))) +(struct: #export Applicative (All [s] (A;Applicative (Parser s))) (def: functor Functor) (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 (All [r] (Functor (Reader r))) +(struct: #export Functor (All [r] (F;Functor (Reader r))) (def: (map f fa) (function [env] (f (fa env))))) -(struct: #export Applicative (All [r] (Applicative (Reader r))) +(struct: #export Applicative (All [r] (A;Applicative (Reader r))) (def: functor Functor) (def: (wrap x) @@ -50,7 +50,7 @@ (struct: #export (ReaderT Monad) {#;doc "Monad transformer for Reader."} (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) - (def: applicative (compA Applicative (get@ #monad;applicative Monad))) + (def: applicative (A;compose Applicative (get@ #monad;applicative Monad))) (def: (join eMeMa) (function [env] (do Monad 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 (All [s] (Functor (State s))) +(struct: #export Functor (All [s] (F;Functor (State s))) (def: (map f ma) (function [state] (let [[state' a] (ma state)] [state' (f a)])))) -(struct: #export Applicative (All [s] (Applicative (State s))) +(struct: #export Applicative (All [s] (A;Applicative (State s))) (def: functor Functor) (def: (wrap a) @@ -75,14 +75,14 @@ (action state)) (struct: (Functor Functor) - (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 map (function [[s a]] [s (f a)]) (sfa state))))) (struct: (Applicative Monad) - (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 (:: Monad 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 (All [l] - (Functor (Writer l))) + (F;Functor (Writer l))) (def: (map f fa) (let [[log datum] fa] [log (f datum)]))) (struct: #export (Applicative mon) (All [l] - (-> (Monoid l) (Applicative (Writer l)))) + (-> (Monoid l) (A;Applicative (Writer l)))) (def: functor Functor) (def: (wrap x) @@ -43,7 +43,7 @@ (struct: #export (WriterT Monoid Monad) (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a)))))) - (def: applicative (A;compA (get@ #monad;applicative Monad) (Applicative Monoid))) + (def: applicative (A;compose (get@ #monad;applicative Monad) (Applicative Monoid))) (def: (join MlMla) (do Monad [[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]) @@ -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) -(struct: #export _ (Functor List) +(struct: #export _ (F;Functor List) (def: (map f ma) (case ma #;Nil #;Nil @@ -268,7 +268,7 @@ (open Functor) -(struct: #export _ (Applicative List) +(struct: #export _ (A;Applicative List) (def: functor Functor) (def: (wrap a) @@ -478,7 +478,7 @@ (struct: #export (ListT Monad) (All [M] (-> (Monad M) (Monad (All [a] (M (List a)))))) - (def: applicative (compA (get@ #M;applicative Monad) Applicative)) + (def: applicative (A;compose (get@ #M;applicative Monad) Applicative)) (def: (join MlMla) (do Monad [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 Monoid Fold]) ["p" product] - ["M" maybe #+ Functor]) + [maybe]) [macro] (macro [code] ["s" syntax #+ syntax: Syntax]))) @@ -258,7 +258,7 @@ outcome (recur side-root)] (if (is side-root outcome) ?root - (#;Some ( (default (undefined) outcome) + (#;Some ( (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 map redden (get@ #right right))))) + (:: maybe;Functor 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 map redden (get@ #left left)) + (:: maybe;Functor 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 + (do maybe;Monad [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 + (do maybe;Monad [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 [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 Functor])))) (type: #export (Queue a) @@ -72,7 +72,7 @@ (def: (= qx qy) (:: (list;Eq Eq) = (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 Fold] - (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 - #F;tree (#F;Leaf default-size value)}) + (All [a] (-> a (f;Fingers Nat a))) + {#f;monoid number;Add@Monoid + #f;tree (#f;Leaf default-size value)}) (do-template [ ] [(def: #export ( seq) (All [a] (-> (Seq a) (Maybe a))) (do maybe;Monad [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 ))))))] [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 [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 - #F;tree tree})))) + (wrap {#f;monoid number;Add@Monoid + #f;tree tree})))) (def: #export (reverse seq) (All [a] (-> (Seq a) (Seq a))) (do maybe;Monad [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 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 = reference x) - (#F;Branch tag left right) + (#f;Branch tag left right) (or (recur left) (recur right)))))) @@ -165,12 +165,12 @@ (#;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) ( (recur left) (recur right))))))] @@ -188,14 +188,14 @@ (-> (-> a Bool) (Seq a) (Maybe a))) (do maybe;Monad [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 [fingers ma] - (wrap {#F;monoid number;Add@Monoid - #F;tree (loop [tree (get@ #F;tree fingers)] + (wrap {#f;monoid number;Add@Monoid + #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) (def: wrap (|>. new #;Some)) @@ -250,15 +250,15 @@ (def: (apply ff fa) (do maybe;Monad [ff' ff] - (case (get@ #F;tree ff') - (#F;Leaf tag f) + (case (get@ #f;tree ff') + (#f;Leaf tag f) (:: Functor 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) @@ -266,15 +266,15 @@ (def: (join ffa) (do maybe;Monad [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 Functor])))) 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 - [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 + [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) (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 (^open) Monoid] (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 (All [e] (Functor (Env e))) +(struct: #export Functor (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]) @@ -12,7 +10,7 @@ [text "text/" Eq Monoid] (text ["l" lexer]) [number "frac/" Codec "nat/" Codec] - 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;default false + (do maybe;Monad [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) (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) (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 (All [a] (Monoid (Maybe a))) +(struct: #export Monoid (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) (def: (wrap x) @@ -61,7 +61,7 @@ (struct: #export (MaybeT Monad) (All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a)))))) - (def: applicative (A;compA (get@ #M;applicative Monad) Applicative)) + (def: applicative (A;compose (get@ #monad;applicative Monad) Applicative)) (def: (join MmMma) (do Monad [mMma MmMma] @@ -74,4 +74,28 @@ (def: #export (lift Monad) (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) - (M;lift Monad (:: Monad wrap))) + (monad;lift Monad (:: Monad 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 (n.% input))) + (let [digit (maybe;assume (get-char (n.% input))) output' (_lux_proc ["text" "append"] [digit output]) input' (n./ 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"] [ digit +0]) #;None (#R;Error (_lux_proc ["text" "append"] [ repr])) @@ -227,10 +228,10 @@ (loop [input (|> value (i./ ) (:: Number abs)) output (|> value (i.% ) (:: Number abs) int-to-nat (get-char ) - assume)] + maybe;assume)] (if (i.= 0 input) (_lux_proc ["text" "append"] [sign output]) - (let [digit (assume (get-char (int-to-nat (i.% input))))] + (let [digit (maybe;assume (get-char (int-to-nat (i.% input))))] (recur (i./ 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"] [ digit +0]) #;None (#R;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: #export (Codec Text Deg) @@ -315,7 +316,7 @@ (_lux_proc ["text" "append"] ["." output]) (let [shifted (f.* dec-left) digit (|> shifted (f.% ) frac-to-int int-to-nat - (get-char ) assume)] + (get-char ) 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 [(:: decode whole-part) (:: 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 signum value) raw-bin (:: Binary@Codec 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 (|> ( 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 (|> ( 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/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) (def: (wrap a) @@ -46,7 +46,7 @@ (struct: #export (ResultT Monad) (All [M] (-> (Monad M) (Monad (All [a] (M (Result a)))))) - (def: applicative (compA (get@ #M;applicative Monad) Applicative)) + (def: applicative (A;compose (get@ #M;applicative Monad) Applicative)) (def: (join MeMea) (do Monad [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 (All [s] (Functor (Store s))) +(struct: #export Functor (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 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 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 ( input) (-> Text Text) (_lux_proc ["text" ] [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 - [[pre post] (split-with pattern template)] - (let [(^open) Monoid] - (wrap ($_ append pre value post)))))) + [[pre post] (split-with pattern template) + #let [(^open) Monoid]] + (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] [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 [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] [product] ["R" result] + [maybe] (coll [list "L/" Fold Monad])) [macro #- run] (macro [code] @@ -77,9 +78,9 @@ (def: re-range^ (l;Lexer Code) (do p;Monad - [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 (All [t] (Functor (Trace t))) +(struct: #export Functor (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 Fold Monoid] [array #+ Array]) number - maybe + [maybe] [product] [text "Text/" Eq Monoid] 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 map product;right + (:: maybe;Functor 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 [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 [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) (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 Monad]) [number] [text "T/" Monoid Eq] [product] [ident "Ident/" Codec] - 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) (def: (wrap x) @@ -222,8 +222,8 @@ [(def: #export ( anns) {#;doc (#;TextA ($_ T/append "Looks up the arguments of a " "."))} (-> Anns (List Text)) - (default (list) - (do Monad + (maybe;default (list) + (do maybe;Monad [_args (get-ann (ident-for ) 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 + (do maybe;Monad [$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 + (case (do maybe;Monad [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 + (do maybe;Monad [#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 [] 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]) 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 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 Fold "List/" Monoid]) [product] + [maybe] ["R" result])) (.. [code "Code/" Eq])) @@ -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]) [ident "Ident/" Eq] - [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/format [product] + [maybe] [number] (number ["r" ratio] ["c" complex]) (coll [list "List/" Fold] - ["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) (def: (wrap a) @@ -200,7 +201,7 @@ [values (list size value-gen)] (wrap (|> values ))))] - [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 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]) (data (coll [list "L/" Monad Fold]) [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 "text/" Monoid] (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] ["R" result] + [maybe] (coll [list "L/" Fold Functor] ["v" vector "v/" Functor Fold])) (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 [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 Fold] [dict]) [bool] - [product]) + [product] + [maybe]) [macro #+ Monad] (macro [code] ["s" syntax #+ syntax: Syntax]) @@ -156,8 +157,7 @@ (#;UnivQ _) (do Monad [[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 [[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 Eq] [number "nat/" Codec] @@ -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) (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] (coll [list "L/" Functor Fold Monoid] [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 {} -- cgit v1.2.3