diff options
Diffstat (limited to 'stdlib/source/lux/control')
35 files changed, 287 insertions, 297 deletions
diff --git a/stdlib/source/lux/control/apply.lux b/stdlib/source/lux/control/apply.lux index 39ea39991..5eb42b63d 100644 --- a/stdlib/source/lux/control/apply.lux +++ b/stdlib/source/lux/control/apply.lux @@ -7,29 +7,30 @@ (signature: #export (Apply f) {#.doc "Applicative functors."} (: (Functor f) - functor) + &functor) (: (All [a b] (-> (f (-> a b)) (f a) (f b))) apply)) -(structure: #export (compose Monad<F> Apply<F> Apply<G>) +(structure: #export (compose f-monad f-apply g-apply) {#.doc "Applicative functor composition."} (All [F G] (-> (Monad F) (Apply F) (Apply G) + ## TODO: Replace (All [a] (F (G a))) with (functor.Then F G) (Apply (All [a] (F (G a)))))) - (def: functor (functor.compose (get@ #functor Apply<F>) (get@ #functor Apply<G>))) + (def: &functor (functor.compose (get@ #&functor f-apply) (get@ #&functor g-apply))) (def: (apply fgf fgx) ## TODO: Switch from this version to the one below (in comments) ASAP. - (let [fgf' (:: Apply<F> apply - (:: Monad<F> wrap (:: Apply<G> apply)) + (let [fgf' (:: f-apply apply + (:: f-monad wrap (:: g-apply apply)) fgf)] - (:: Apply<F> apply fgf' fgx)) - ## (let [applyF (:: Apply<F> apply) - ## applyG (:: Apply<G> apply)] + (:: f-apply apply fgf' fgx)) + ## (let [applyF (:: f-apply apply) + ## applyG (:: g-apply apply)] ## ($_ applyF - ## (:: Monad<F> wrap applyG) + ## (:: f-monad wrap applyG) ## fgf ## fgx)) )) diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux index d2641fe38..b51f76d97 100644 --- a/stdlib/source/lux/control/codec.lux +++ b/stdlib/source/lux/control/codec.lux @@ -14,16 +14,16 @@ decode)) ## [Values] -(structure: #export (compose Codec<c,b> Codec<b,a>) +(structure: #export (compose cb-codec ba-codec) {#.doc "Codec composition."} (All [a b c] (-> (Codec c b) (Codec b a) (Codec c a))) (def: encode - (|>> (:: Codec<b,a> encode) - (:: Codec<c,b> encode))) + (|>> (:: ba-codec encode) + (:: cb-codec encode))) (def: (decode cy) - (do error.Monad<Error> - [by (:: Codec<c,b> decode cy)] - (:: Codec<b,a> decode by)))) + (do error.monad + [by (:: cb-codec decode cy)] + (:: ba-codec decode by)))) diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index 2d96364ad..853c43615 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -2,7 +2,8 @@ [lux #* [data [collection - ["." list ("list/." Fold<List>)]]]] + ["." list ("list/." Fold)] + ["." sequence]]]] [// ["F" functor]]) @@ -30,7 +31,7 @@ (macro: #export (be tokens state) {#.doc (doc "A co-monadic parallel to the 'do' macro." (let [square (function (_ n) (i/* n n))] - (be CoMonad<Stream> + (be sequence.comonad [inputs (iterate inc +2)] (square (head inputs)))))} (case tokens diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index 80fa1b40e..1a628b88a 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -5,15 +5,15 @@ r/+ r/- r/* r// r/% r/= r/< r/<= r/> r/>= f/+ f/- f/* f// f/% f/= f/< f/<= f/> f/>=) [control - ["p" parser ("parser/." Monad<Parser>)] + ["p" parser ("parser/." monad)] ["." monad]] [data ["." text format] - ["." maybe ("maybe/." Monad<Maybe>)] + ["." maybe ("maybe/." monad)] [collection - ["." list ("list/." Fold<List> Functor<List>)]]] - ["." macro (#+ with-gensyms Monad<Meta>) + ["." list ("list/." fold functor)]]] + ["." macro (#+ with-gensyms) ["." code] ["s" syntax (#+ syntax:)] [syntax @@ -56,7 +56,7 @@ (def: (singleton expander) (-> (Meta (List Code)) (Meta Code)) - (monad.do Monad<Meta> + (monad.do ..monad [expansion expander] (case expansion (#.Cons singleton #.Nil) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 9b20dcfde..3e288ca42 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -3,15 +3,15 @@ [control monad ["p" parser] ["ex" exception (#+ exception:)]] - ["." io (#- run) ("io/." Monad<IO>)] + ["." io ("io/." monad)] [data ["." product] ["e" error] [text format] [collection - ["." list ("list/." Monoid<List> Monad<List> Fold<List>)]]] - ["." macro (#+ with-gensyms Monad<Meta>) + ["." list ("list/." monoid monad fold)]]] + ["." macro (#+ with-gensyms monad) ["." code] ["s" syntax (#+ syntax: Syntax)] [syntax @@ -23,7 +23,7 @@ abstract]] [// ["." atom (#+ Atom atom)] - ["." promise (#+ Promise Resolver) ("promise/." Monad<Promise>)] + ["." promise (#+ Promise Resolver) ("promise/." monad)] ["." task (#+ Task)]]) (exception: #export poisoned) @@ -33,7 +33,6 @@ (ex.report ["Actor" actor-name] ["Message" message-name])) -## [Types] (with-expansions [<Message> (as-is (-> s (Actor s) (Task s))) <Obituary> (as-is [Text s (List <Message>)]) @@ -90,7 +89,7 @@ (promise.promise [])) process (loop [state init [|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))] - (do promise.Monad<Promise> + (do promise.monad [[head tail] |mailbox| ?state' (handle head state self)] (case ?state' @@ -120,7 +119,7 @@ (All [s] (-> (Message s) (Actor s) (IO Bit))) (if (alive? actor) (let [entry [message (promise.promise [])]] - (do Monad<IO> + (do io.monad [|mailbox|&resolve (atom.read (get@ #mailbox (:representation actor)))] (loop [[|mailbox| resolve] |mailbox|&resolve] (case (promise.poll |mailbox|) @@ -139,7 +138,6 @@ ) ) -## [Values] (def: (default-handle message state self) (All [s] (-> (Message s) s (Actor s) (Task s))) (message state self)) @@ -161,7 +159,6 @@ (task.throw poisoned [])) actor)) -## [Syntax] (do-template [<with> <resolve> <tag> <desc>] [(def: #export (<with> name) (-> Name cs.Annotations cs.Annotations) @@ -170,7 +167,7 @@ (def: #export (<resolve> name) (-> Name (Meta Name)) - (do Monad<Meta> + (do io.monad [[_ annotations _] (macro.find-def name)] (case (macro.get-tag-ann (name-of <tag>) annotations) (#.Some actor-name) @@ -186,7 +183,7 @@ (def: actor-decl^ (Syntax [Text (List Text)]) (p.either (s.form (p.and s.local-identifier (p.some s.local-identifier))) - (p.and s.local-identifier (:: p.Monad<Parser> wrap (list))))) + (p.and s.local-identifier (:: p.monad wrap (list))))) (do-template [<name> <desc>] [(def: #export <name> @@ -227,7 +224,7 @@ Nat ((stop cause state) - (:: promise.Monad<Promise> wrap + (:: promise.monad wrap (log! (if (ex.match? ..poisoned cause) (format "Counter was poisoned: " (%n state)) cause))))) @@ -236,7 +233,7 @@ (List a) ((handle message state self) - (do task.Monad<Task> + (do task.monad [#let [_ (log! "BEFORE")] output (message state self) #let [_ (log! "AFTER")]] @@ -268,7 +265,7 @@ (~ (code.local-identifier messageN)) (~ (code.local-identifier stateN)) (~ (code.local-identifier selfN))) - (do task.Monad<Task> + (do task.monad [] (~ bodyC)))))) #..end (~ (case ?stop @@ -279,7 +276,7 @@ (` (function ((~ g!_) (~ (code.local-identifier causeN)) (~ (code.local-identifier stateN))) - (do promise.Monad<Promise> + (do promise.monad [] (~ bodyC))))))})) (` (def: (~+ (csw.export export)) ((~ g!new) (~ g!init)) @@ -309,7 +306,7 @@ (def: reference^ (s.Syntax [Name (List Text)]) (p.either (s.form (p.and s.identifier (p.some s.local-identifier))) - (p.and s.identifier (:: p.Monad<Parser> wrap (list))))) + (p.and s.identifier (:: p.monad wrap (list))))) (syntax: #export (message: {export csr.export} @@ -367,12 +364,12 @@ (let [[(~ g!task) (~ g!resolve)] (: [(task.Task (~ g!outputT)) (task.Resolver (~ g!outputT))] (task.task []))] - (io.run (do io.Monad<IO> + (io.run (do io.monad [(~ g!sent?) (..send (function ((~ g!_) (~ g!state) (~ g!self)) - (do promise.Monad<Promise> + (do promise.monad [(~ g!return) (: (Task [((~ g!type) (~+ g!actor-refs)) (~ g!outputT)]) - (do task.Monad<Task> + (do task.monad [] (~ body)))] (case (~ g!return) diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index b1692b6e3..61152d7b6 100644 --- a/stdlib/source/lux/control/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux @@ -46,7 +46,7 @@ "The retries will be done with the new values of the atom, as they show up.")} (All [a] (-> (-> a a) (Atom a) (IO a))) (loop [_ []] - (do io.Monad<IO> + (do io.monad [old (read atom) #let [new (f old)] swapped? (compare-and-swap old new atom)] diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux index 18b385a65..84def78d1 100644 --- a/stdlib/source/lux/control/concurrency/frp.lux +++ b/stdlib/source/lux/control/concurrency/frp.lux @@ -8,14 +8,14 @@ [equivalence (#+ Equivalence)]] ["." io (#+ IO)] [data - [maybe ("maybe/." Functor<Maybe>)] + [maybe ("maybe/." functor)] [collection - [list ("list/." Monoid<List>)]]] + [list ("list/." monoid)]]] [type (#+ :share) abstract]] [// ["." atom (#+ Atom)] - ["." promise (#+ Promise) ("promise/." Functor<Promise>)]]) + ["." promise (#+ Promise) ("promise/." functor)]]) (type: #export (Channel a) {#.doc "An asynchronous channel to distribute values."} @@ -35,7 +35,7 @@ (structure (def: close (loop [_ []] - (do io.Monad<IO> + (do io.monad [current (atom.read source) stopped? (current #.None)] (if stopped? @@ -52,7 +52,7 @@ (def: (feed value) (loop [_ []] - (do io.Monad<IO> + (do io.monad [current (atom.read source) #let [[next resolve-next] (:share [a] {(promise.Resolver (Maybe [a (Channel a)])) @@ -82,7 +82,7 @@ (All [a] (-> (-> a (IO Any)) (Channel a) (IO Any))) (io.io (exec (: (Promise Any) (loop [channel channel] - (do promise.Monad<Promise> + (do promise.monad [cons channel] (case cons (#.Some [head tail]) @@ -93,18 +93,18 @@ (wrap []))))) []))) -(structure: #export _ (Functor Channel) +(structure: #export functor (Functor Channel) (def: (map f) (promise/map (maybe/map (function (_ [head tail]) [(f head) (map f tail)]))))) -(structure: #export _ (Apply Channel) - (def: functor Functor<Channel>) +(structure: #export apply (Apply Channel) + (def: &functor ..functor) (def: (apply ff fa) - (do promise.Monad<Promise> + (do promise.monad [cons-f ff cons-a fa] (case [cons-f cons-a] @@ -114,8 +114,8 @@ _ (wrap #.None))))) -(structure: #export _ (Monad Channel) - (def: functor Functor<Channel>) +(structure: #export monad (Monad Channel) + (def: &functor ..functor) (def: (wrap a) (promise.resolved (#.Some [a (promise.resolved #.None)]))) @@ -128,7 +128,7 @@ (def: #export (filter pass? channel) (All [a] (-> (Predicate a) (Channel a) (Channel a))) - (do promise.Monad<Promise> + (do promise.monad [cons channel] (case cons (#.Some [head tail]) @@ -151,7 +151,7 @@ (All [a b] (-> (-> b a (Promise a)) a (Channel b) (Promise a))) - (do promise.Monad<Promise> + (do promise.monad [cons channel] (case cons #.None @@ -167,7 +167,7 @@ (All [a b] (-> (-> b a (Promise a)) a (Channel b) (Channel a))) - (do promise.Monad<Promise> + (do promise.monad [cons channel] (case cons #.None @@ -182,7 +182,7 @@ (All [a] (-> Nat (IO a) (Channel a))) (let [[output source] (channel [])] (exec (io.run (loop [_ []] - (do io.Monad<IO> + (do io.monad [value action _ (:: source feed value)] (promise.await recur (promise.wait milli-seconds))))) @@ -194,7 +194,7 @@ (def: #export (iterate f init) (All [a] (-> (-> a (Promise (Maybe a))) a (Channel a))) - (do promise.Monad<Promise> + (do promise.monad [?next (f init)] (case ?next (#.Some next) @@ -205,7 +205,7 @@ (def: (distinct' equivalence previous channel) (All [a] (-> (Equivalence a) a (Channel a) (Channel a))) - (do promise.Monad<Promise> + (do promise.monad [cons channel] (case cons (#.Some [head tail]) @@ -218,7 +218,7 @@ (def: #export (distinct equivalence channel) (All [a] (-> (Equivalence a) (Channel a) (Channel a))) - (do promise.Monad<Promise> + (do promise.monad [cons channel] (case cons (#.Some [head tail]) @@ -230,7 +230,7 @@ (def: #export (consume channel) {#.doc "Reads the entirety of a channel's content and returns it as a list."} (All [a] (-> (Channel a) (Promise (List a)))) - (do promise.Monad<Promise> + (do promise.monad [cons channel] (case cons (#.Some [head tail]) @@ -247,6 +247,6 @@ (promise.resolved #.None) (#.Cons head tail) - (promise.resolved (#.Some [head (do promise.Monad<Promise> + (promise.resolved (#.Some [head (do promise.monad [_ (promise.wait milli-seconds)] (sequential milli-seconds tail))])))) diff --git a/stdlib/source/lux/control/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux index a67734747..d1d2ac245 100644 --- a/stdlib/source/lux/control/concurrency/process.lux +++ b/stdlib/source/lux/control/concurrency/process.lux @@ -87,7 +87,7 @@ (def: #export run! (IO Any) (loop [_ []] - (do io.Monad<IO> + (do io.monad [processes (atom.read runner)] (case processes ## And... we're done! diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index 33a04190b..244951139 100644 --- a/stdlib/source/lux/control/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux @@ -25,7 +25,7 @@ {#.doc "Sets an promise's value if it has not been done yet."} (All [a] (-> (Promise a) (Resolver a))) (function (resolve value) - (do io.Monad<IO> + (do io.monad [(^@ old [_value _observers]) (atom.read promise)] (case _value (#.Some _) @@ -82,14 +82,14 @@ (#.Some _) #1)) -(structure: #export _ (Functor Promise) +(structure: #export functor (Functor Promise) (def: (map f fa) (let [[fb resolve] (..promise [])] (exec (io.run (await (|>> f resolve) fa)) fb)))) -(structure: #export _ (Apply Promise) - (def: functor Functor<Promise>) +(structure: #export apply (Apply Promise) + (def: &functor ..functor) (def: (apply ff fa) (let [[fb resolve] (..promise [])] @@ -98,8 +98,8 @@ ff)) fb)))) -(structure: #export _ (Monad Promise) - (def: functor Functor<Promise>) +(structure: #export monad (Monad Promise) + (def: &functor ..functor) (def: wrap ..resolved) @@ -113,7 +113,7 @@ (def: #export (and left right) {#.doc "Sequencing combinator."} (All [a b] (-> (Promise a) (Promise b) (Promise [a b]))) - (do Monad<Promise> + (do ..monad [a left b right] (wrap [a b]))) @@ -148,7 +148,7 @@ "Returns a Promise that will eventually host its result.")} (All [a] (-> Nat (IO a) (Promise a))) (let [[!out resolve] (..promise [])] - (exec (|> (do io.Monad<IO> + (exec (|> (do io.monad [value computation] (resolve value)) (process.schedule millis-delay) diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux index 46762ecf3..ddc73b300 100644 --- a/stdlib/source/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/lux/control/concurrency/semaphore.lux @@ -29,7 +29,7 @@ (io.run (loop [signal (: (Promise Any) (promise.promise #.None))] - (do io.Monad<IO> + (do io.monad [state (atom.read semaphore) #let [[ready? state'] (: [Bit State] (case (get@ #open-positions state) @@ -50,7 +50,7 @@ (let [semaphore (:representation semaphore)] (promise.future (loop [_ []] - (do io.Monad<IO> + (do io.monad [state (atom.read semaphore) #let [[?signal state'] (: [(Maybe (Promise Any)) State] (case (get@ #waiting-list state) @@ -91,7 +91,7 @@ (def: #export (synchronize mutex procedure) (All [a] (-> Mutex (IO (Promise a)) (Promise a))) - (do promise.Monad<Promise> + (do promise.monad [_ (acquire mutex) output (io.run procedure) _ (release mutex)] @@ -120,15 +120,15 @@ (-> Nat Semaphore (Promise Any)) (loop [step 0] (if (n/< times step) - (do promise.Monad<Promise> + (do promise.monad [_ (signal turnstile)] (recur (inc step))) - (:: promise.Monad<Promise> wrap [])))) + (:: promise.monad wrap [])))) (do-template [<phase> <update> <goal> <turnstile>] [(def: (<phase> (^:representation barrier)) (-> Barrier (Promise Any)) - (do promise.Monad<Promise> + (do promise.monad [#let [limit (refinement.un-refine (get@ #limit barrier)) goal <goal> count (io.run (atom.update <update> (get@ #count barrier)))] @@ -143,7 +143,7 @@ (def: #export (block barrier) (-> Barrier (Promise Any)) - (do promise.Monad<Promise> + (do promise.monad [_ (start barrier)] (end barrier))) ) diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 34122abd4..5bb537025 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -15,7 +15,7 @@ [// ["." atom (#+ Atom atom)] ["." promise (#+ Promise Resolver)] - ["." frp ("frp/." Functor<Channel>)]]) + ["." frp ("frp/." functor)]]) (type: #export (Observer a) (-> a (IO Any))) @@ -39,11 +39,11 @@ (All [a] (-> (Var a) (IO a))) (|> var atom.read - (:: io.Functor<IO> map product.left))) + (:: io.functor map product.left))) (def: (write! new-value (^:representation var)) (All [a] (-> a (Var a) (IO Any))) - (do io.Monad<IO> + (do io.monad [(^@ old [_value _observers]) (atom.read var) succeeded? (atom.compare-and-swap old [new-value _observers] var)] (if succeeded? @@ -55,7 +55,7 @@ (def: #export (follow target) {#.doc "Creates a channel that will receive all changes to the value of the given var."} (All [a] (-> (Var a) (IO (frp.Channel a)))) - (do io.Monad<IO> + (do io.monad [#let [[channel source] (frp.channel []) target (:representation target)] _ (atom.update (function (_ [value observers]) @@ -82,8 +82,8 @@ (list.find (function (_ [_var _original _current]) (is? (:coerce (Var Any) var) (:coerce (Var Any) _var)))) - (:: maybe.Monad<Maybe> map (function (_ [_var _original _current]) - _current)) + (:: maybe.monad map (function (_ [_var _original _current]) + _current)) (:assume) )) @@ -137,8 +137,8 @@ (let [[tx' a] (fa tx)] [tx' (f a)])))) -(structure: #export _ (Apply STM) - (def: functor Functor<STM>) +(structure: #export apply (Apply STM) + (def: &functor ..functor) (def: (apply ff fa) (function (_ tx) @@ -146,8 +146,8 @@ [tx'' a] (fa tx')] [tx'' (f a)])))) -(structure: #export _ (Monad STM) - (def: functor Functor<STM>) +(structure: #export monad (Monad STM) + (def: &functor ..functor) (def: (wrap a) (function (_ tx) [tx a])) @@ -160,7 +160,7 @@ (def: #export (update f var) {#.doc "Will update a Var's value, and return a tuple with the old and the new values."} (All [a] (-> (-> a a) (Var a) (STM [a a]))) - (do Monad<STM> + (do ..monad [a (read var) #let [a' (f a)] _ (write a' var)] @@ -198,12 +198,12 @@ (def: (issue-commit commit) (All [a] (-> (Commit a) (IO Any))) (let [entry [commit (promise.promise [])]] - (do io.Monad<IO> + (do io.monad [|commits|&resolve (atom.read pending-commits)] (loop [[|commits| resolve] |commits|&resolve] (case (promise.poll |commits|) #.None - (do io.Monad<IO> + (do io.monad [resolved? (resolve entry)] (if resolved? (atom.write (product.right entry) pending-commits) @@ -217,14 +217,14 @@ (let [[stm-proc output resolve] commit [finished-tx value] (stm-proc fresh-tx)] (if (can-commit? finished-tx) - (do io.Monad<IO> + (do io.monad [_ (monad.map @ commit-var! finished-tx)] (resolve value)) (issue-commit commit)))) (def: init-processor! (IO Any) - (do io.Monad<IO> + (do io.monad [flag (atom.read commit-processor-flag)] (if flag (wrap []) @@ -247,7 +247,7 @@ "For this reason, it's important to note that transactions must be free from side-effects, such as I/O.")} (All [a] (-> (STM a) (Promise a))) (let [[output resolver] (promise.promise [])] - (exec (io.run (do io.Monad<IO> + (exec (io.run (do io.monad [_ init-processor!] (issue-commit [stm-proc output resolver]))) output))) diff --git a/stdlib/source/lux/control/concurrency/task.lux b/stdlib/source/lux/control/concurrency/task.lux index a5bf17819..1f16da8ca 100644 --- a/stdlib/source/lux/control/concurrency/task.lux +++ b/stdlib/source/lux/control/concurrency/task.lux @@ -29,16 +29,15 @@ (def: #export (throw exception message) (All [e a] (-> (Exception e) e (Task a))) - (:: promise.Monad<Promise> wrap - (ex.throw exception message))) + (:: promise.monad wrap (ex.throw exception message))) (def: #export (try computation) (All [a] (-> (Task a) (Task (Error a)))) - (:: promise.Functor<Promise> map (|>> #error.Success) computation)) + (:: promise.functor map (|>> #error.Success) computation)) -(structure: #export _ (Functor Task) +(structure: #export functor (Functor Task) (def: (map f fa) - (:: promise.Functor<Promise> map + (:: promise.functor map (function (_ fa') (case fa' (#error.Failure error) @@ -48,25 +47,25 @@ (#error.Success (f a)))) fa))) -(structure: #export _ (Apply Task) - (def: functor Functor<Task>) +(structure: #export apply (Apply Task) + (def: &functor ..functor) (def: (apply ff fa) - (do promise.Monad<Promise> + (do promise.monad [ff' ff fa' fa] - (wrap (do error.Monad<Error> + (wrap (do error.monad [f ff' a fa'] (wrap (f a))))))) -(structure: #export _ (Monad Task) - (def: functor Functor<Task>) +(structure: #export monad (Monad Task) + (def: &functor ..functor) (def: wrap return) (def: (join mma) - (do promise.Monad<Promise> + (do promise.monad [mma' mma] (case mma' (#error.Failure error) @@ -81,4 +80,4 @@ (def: #export (from-promise promise) (All [a] (-> (Promise a) (Task a))) - (:: promise.Functor<Promise> map (|>> #error.Success) promise)) + (:: promise.functor map (|>> #error.Success) promise)) diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux index beaab50fb..66233773a 100644 --- a/stdlib/source/lux/control/continuation.lux +++ b/stdlib/source/lux/control/continuation.lux @@ -23,12 +23,12 @@ (All [a] (-> (Cont a a) a)) (cont id)) -(structure: #export Functor<Cont> (All [o] (Functor (All [i] (Cont i o)))) +(structure: #export functor (All [o] (Functor (All [i] (Cont i o)))) (def: (map f fv) (function (_ k) (fv (compose k f))))) -(structure: #export Apply<Cont> (All [o] (Apply (All [i] (Cont i o)))) - (def: functor Functor<Cont>) +(structure: #export apply (All [o] (Apply (All [i] (Cont i o)))) + (def: &functor ..functor) (def: (apply ff fv) (function (_ k) @@ -36,8 +36,8 @@ (function (_ v)) fv (function (_ f)) ff)))) -(structure: #export Monad<Cont> (All [o] (Monad (All [i] (Cont i o)))) - (def: functor Functor<Cont>) +(structure: #export monad (All [o] (Monad (All [i] (Cont i o)))) + (def: &functor ..functor) (def: (wrap value) (function (_ k) (k value))) @@ -69,7 +69,7 @@ i] z))) (call/cc (function (_ k) - (do Monad<Cont> + (do ..monad [#let [nexus (function (nexus val) (k [nexus val]))] _ (k [nexus init])] diff --git a/stdlib/source/lux/control/enum.lux b/stdlib/source/lux/control/enum.lux index b5b69faf1..9f2845b01 100644 --- a/stdlib/source/lux/control/enum.lux +++ b/stdlib/source/lux/control/enum.lux @@ -3,14 +3,12 @@ [control ["." order]]]) -## [Signatures] (signature: #export (Enum e) {#.doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."} - (: (order.Order e) order) + (: (order.Order e) &order) (: (-> e e) succ) (: (-> e e) pred)) -## [Functions] (def: (range' <= succ from to) (All [a] (-> (-> a a Bit) (-> a a) a a (List a))) (if (<= to from) diff --git a/stdlib/source/lux/control/equivalence.lux b/stdlib/source/lux/control/equivalence.lux index 1b1cc45d3..57db7a925 100644 --- a/stdlib/source/lux/control/equivalence.lux +++ b/stdlib/source/lux/control/equivalence.lux @@ -35,8 +35,8 @@ (def: (= left right) (sub (rec sub) left right)))) -(structure: #export _ (Contravariant Equivalence) - (def: (map-1 f Equivalence<b>) +(structure: #export contravariant (Contravariant Equivalence) + (def: (map-1 f equivalence) (structure (def: (= reference sample) - (:: Equivalence<b> = (f reference) (f sample)))))) + (:: equivalence = (f reference) (f sample)))))) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index c5fa9632c..bac945de2 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -7,9 +7,9 @@ ["//" error (#+ Error)] ["." maybe] ["." product] - ["." text ("text/." Monoid<Text>)] + ["." text ("text/." monoid)] [collection - ["." list ("list/." Functor<List> Fold<List>)]]] + ["." list ("list/." functor fold)]]] ["." macro ["." code] ["s" syntax (#+ syntax: Syntax)] diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux index 415d57c93..1ade0a45b 100644 --- a/stdlib/source/lux/control/functor.lux +++ b/stdlib/source/lux/control/functor.lux @@ -9,21 +9,21 @@ (type: #export (Fix f) (f (Fix f))) -(type: #export (<&> f g) +(type: #export (And f g) (All [a] (& (f a) (g a)))) -(type: #export (<|> f g) +(type: #export (Or f g) (All [a] (| (f a) (g a)))) -(type: #export (<$> f g) +(type: #export (Then f g) (All [a] (f (g a)))) -(structure: #export (compose Functor<F> Functor<G>) +(def: #export (compose f-functor g-functor) {#.doc "Functor composition."} - (All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a)))))) - - (def: (map f fga) - (:: Functor<F> map (:: Functor<G> map f) fga))) + (All [F G] (-> (Functor F) (Functor G) (Functor (..Then F G)))) + (structure + (def: (map f fga) + (:: f-functor map (:: g-functor map f) fga)))) (signature: #export (Contravariant f) (: (All [a b] diff --git a/stdlib/source/lux/control/hash.lux b/stdlib/source/lux/control/hash.lux index 4e50c3658..d2dee3bcb 100644 --- a/stdlib/source/lux/control/hash.lux +++ b/stdlib/source/lux/control/hash.lux @@ -1,12 +1,13 @@ (.module: lux - [// [equivalence (#+ Equivalence)]]) + [// + [equivalence (#+ Equivalence)]]) ## [Signatures] (signature: #export (Hash a) {#.doc (doc "A way to produce hash-codes for a type's instances." "A necessity when working with some data-structures, such as dictionaries or sets.")} (: (Equivalence a) - eq) + &equivalence) (: (-> a Nat) hash)) diff --git a/stdlib/source/lux/control/identity.lux b/stdlib/source/lux/control/identity.lux index 094ede9a6..ff79bedca 100644 --- a/stdlib/source/lux/control/identity.lux +++ b/stdlib/source/lux/control/identity.lux @@ -12,7 +12,7 @@ code - (structure: #export (Equivalence<ID> Equivalence<code>) + (structure: #export (equivalence Equivalence<code>) (All [code entity storage] (-> (Equivalence code) (Equivalence (ID code entity storage)))) diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux index 5e94aea90..940b85a21 100644 --- a/stdlib/source/lux/control/interval.lux +++ b/stdlib/source/lux/control/interval.lux @@ -9,7 +9,7 @@ (signature: #export (Interval a) {#.doc "A representation of top and bottom boundaries for an ordered type."} (: (Enum a) - enum) + &enum) (: a bottom) @@ -17,15 +17,15 @@ (: a top)) -(def: #export (between Enum<a> bottom top) +(def: #export (between enum bottom top) (All [a] (-> (Enum a) a a (Interval a))) - (structure (def: enum Enum<a>) + (structure (def: &enum enum) (def: bottom bottom) (def: top top))) -(def: #export (singleton Enum<a> elem) +(def: #export (singleton enum elem) (All [a] (-> (Enum a) a (Interval a))) - (structure (def: enum Enum<a>) + (structure (def: &enum enum) (def: bottom elem) (def: top elem))) @@ -72,20 +72,20 @@ (def: #export (union left right) (All [a] (-> (Interval a) (Interval a) (Interval a))) - (structure (def: enum (get@ #enum right)) - (def: bottom (order.min (:: right order) (:: left bottom) (:: right bottom))) - (def: top (order.max (:: right order) (:: left top) (:: right top))))) + (structure (def: &enum (get@ #&enum right)) + (def: bottom (order.min (:: right &order) (:: left bottom) (:: right bottom))) + (def: top (order.max (:: right &order) (:: left top) (:: right top))))) (def: #export (intersection left right) (All [a] (-> (Interval a) (Interval a) (Interval a))) - (structure (def: enum (get@ #enum right)) - (def: bottom (order.max (:: right order) (:: left bottom) (:: right bottom))) - (def: top (order.min (:: right order) (:: left top) (:: right top))))) + (structure (def: &enum (get@ #&enum right)) + (def: bottom (order.max (:: right &order) (:: left bottom) (:: right bottom))) + (def: top (order.min (:: right &order) (:: left top) (:: right top))))) (def: #export (complement interval) (All [a] (-> (Interval a) (Interval a))) (let [(^open ".") interval] - (structure (def: enum (get@ #enum interval)) + (structure (def: &enum (get@ #&enum interval)) (def: bottom (succ top)) (def: top (pred bottom))))) @@ -134,7 +134,7 @@ [after? >] ) -(structure: #export Equivalence<Interval> (All [a] (Equivalence (Interval a))) +(structure: #export equivalence (All [a] (Equivalence (Interval a))) (def: (= reference sample) (let [(^open ".") reference] (and (= bottom (:: sample bottom)) @@ -164,7 +164,7 @@ (def: #export (overlaps? reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) (let [(^open ".") reference] - (and (not (:: Equivalence<Interval> = reference sample)) + (and (not (:: ..equivalence = reference sample)) (cond (singleton? sample) #0 diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index 6e0992444..67f1fb047 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -3,7 +3,6 @@ [// ["." functor (#+ Functor)]]) -## [Utils] (def: (list/fold f init xs) (All [a b] (-> (-> b a a) a (List b) a)) @@ -41,10 +40,9 @@ _ #.Nil)) -## [Signatures] (signature: #export (Monad m) (: (Functor m) - functor) + &functor) (: (All [a] (-> a (m a))) wrap) @@ -52,12 +50,11 @@ (-> (m (m a)) (m a))) join)) -## [Syntax] (def: _cursor Cursor ["" 0 0]) (macro: #export (do tokens state) {#.doc (doc "Macro for easy concatenation of monadic operations." - (do Monad<Maybe> + (do monad [y (f1 x) z (f2 z)] (wrap (f3 z))))} @@ -80,7 +77,7 @@ body (reverse (as-pairs bindings)))] (#.Right [state (#.Cons (` ({(~' @) - ({{#..functor {#functor.map (~ g!map)} + ({{#..&functor {#functor.map (~ g!map)} #..wrap (~' wrap) #..join (~ g!join)} (~ body')} @@ -92,7 +89,6 @@ _ (#.Left "Wrong syntax for 'do'"))) -## [Functions] (def: #export (seq monad) {#.doc "Run all the monadic values in the list and produce a list of the base values."} (All [M a] @@ -162,11 +158,11 @@ [init' (f x init)] (fold monad f init' xs')))) -(def: #export (lift Monad<M> f) +(def: #export (lift monad f) {#.doc "Lift a normal function into the space of monads."} (All [M a b] (-> (Monad M) (-> a b) (-> (M a) (M b)))) (function (_ ma) - (do Monad<M> + (do monad [a ma] (wrap (f a))))) diff --git a/stdlib/source/lux/control/monad/free.lux b/stdlib/source/lux/control/monad/free.lux index b30de7b1f..214261450 100644 --- a/stdlib/source/lux/control/monad/free.lux +++ b/stdlib/source/lux/control/monad/free.lux @@ -10,7 +10,7 @@ (#Pure a) (#Effect (F (Free F a)))) -(structure: #export (Functor<Free> dsl) +(structure: #export (functor dsl) (All [F] (-> (Functor F) (Functor (Free F)))) (def: (map f ea) @@ -21,10 +21,10 @@ (#Effect value) (#Effect (:: dsl map (map f) value))))) -(structure: #export (Apply<Free> dsl) +(structure: #export (apply dsl) (All [F] (-> (Functor F) (Apply (Free F)))) - (def: functor (Functor<Free> dsl)) + (def: &functor (..functor dsl)) (def: (apply ef ea) (case [ef ea] @@ -33,7 +33,7 @@ [(#Pure f) (#Effect fa)] (#Effect (:: dsl map - (:: (Functor<Free> dsl) map f) + (:: (..functor dsl) map f) fa)) [(#Effect ff) _] @@ -42,10 +42,10 @@ ff)) ))) -(structure: #export (Monad<Free> dsl) +(structure: #export (monad dsl) (All [F] (-> (Functor F) (Monad (Free F)))) - (def: functor (Functor<Free> dsl)) + (def: &functor (..functor dsl)) (def: (wrap a) (#Pure a)) @@ -62,6 +62,6 @@ (#Effect fefa) (#Effect (:: dsl map - (:: (Monad<Free> dsl) join) + (:: (monad dsl) join) fefa)) ))) diff --git a/stdlib/source/lux/control/monad/indexed.lux b/stdlib/source/lux/control/monad/indexed.lux index ef2acb904..bd18ab72c 100644 --- a/stdlib/source/lux/control/monad/indexed.lux +++ b/stdlib/source/lux/control/monad/indexed.lux @@ -5,7 +5,7 @@ ["p" parser]] [data [collection - ["." list ("list/." Functor<List> Fold<List>)]]] + ["." list ("list/." functor fold)]]] ["." macro ["s" syntax (#+ Syntax syntax:)]]]) diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux index 4375f4e7c..a56f512cb 100644 --- a/stdlib/source/lux/control/order.lux +++ b/stdlib/source/lux/control/order.lux @@ -6,12 +6,11 @@ [// ["." equivalence (#+ Equivalence)]]) -## [Signatures] (`` (signature: #export (Order a) {#.doc "A signature for types that possess some sense of ordering among their elements."} (: (Equivalence a) - eq) + &equivalence) (~~ (do-template [<name>] [(: (-> a a Bit) <name>)] @@ -20,20 +19,23 @@ )) )) -## [Values] -(def: #export (order eq <) +(def: #export (order equivalence <) (All [a] (-> (Equivalence a) (-> a a Bit) (Order a))) (let [> (flip <)] - (structure (def: eq eq) + (structure (def: &equivalence equivalence) + (def: < <) + (def: (<= test subject) (or (< test subject) - (:: eq = test subject))) + (:: equivalence = test subject))) + (def: > >) + (def: (>= test subject) (or (> test subject) - (:: eq = test subject)))))) + (:: equivalence = test subject)))))) (do-template [<name> <op>] [(def: #export (<name> order x y) @@ -45,14 +47,14 @@ [max >] ) -(`` (structure: #export _ (Contravariant Order) - (def: (map-1 f Order<b>) +(`` (structure: #export contravariant (Contravariant Order) + (def: (map-1 f order) (structure - (def: eq (:: equivalence.Contravariant<Equivalence> map-1 f (:: Order<b> eq))) + (def: &equivalence (:: equivalence.contravariant map-1 f (:: order &equivalence))) (~~ (do-template [<name>] [(def: (<name> reference sample) - (:: Order<b> <name> (f reference) (f sample)))] + (:: order <name> (f reference) (f sample)))] [<] [<=] [>] [>=] )))))) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 4b4ef0d34..4ea39a006 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -3,11 +3,11 @@ [control [functor (#+ Functor)] [apply (#+ Apply)] - [monad (#+ do Monad)] + [monad (#+ Monad do)] [codec (#+ Codec)]] [data [collection - ["." list ("list/." Functor<List> Monoid<List>)]] + ["." list ("list/." functor monoid)]] ["." product] ["." error (#+ Error)]]]) @@ -15,8 +15,7 @@ {#.doc "A generic parser."} (-> s (Error [s a]))) -## [Structures] -(structure: #export Functor<Parser> (All [s] (Functor (Parser s))) +(structure: #export functor (All [s] (Functor (Parser s))) (def: (map f ma) (function (_ input) (case (ma input) @@ -26,8 +25,8 @@ (#error.Success [input' a]) (#error.Success [input' (f a)]))))) -(structure: #export Apply<Parser> (All [s] (Apply (Parser s))) - (def: functor Functor<Parser>) +(structure: #export apply (All [s] (Apply (Parser s))) + (def: &functor ..functor) (def: (apply ff fa) (function (_ input) @@ -43,8 +42,8 @@ (#error.Failure msg) (#error.Failure msg))))) -(structure: #export Monad<Parser> (All [s] (Monad (Parser s))) - (def: functor Functor<Parser>) +(structure: #export monad (All [s] (Monad (Parser s))) + (def: &functor ..functor) (def: (wrap x) (function (_ input) @@ -59,7 +58,6 @@ (#error.Success [input' ma]) (ma input'))))) -## [Parsers] (def: #export (assert message test) {#.doc "Fails with the given message if the test is #0."} (All [s] (-> Text Bit (Parser s Any))) @@ -96,7 +94,7 @@ (#error.Success [input' x]) (run input' - (do Monad<Parser> + (do ..monad [xs (some p)] (wrap (list& x xs))) )))) @@ -105,7 +103,7 @@ {#.doc "1-or-more combinator."} (All [s a] (-> (Parser s a) (Parser s (List a)))) - (do Monad<Parser> + (do ..monad [x p xs (some p)] (wrap (list& x xs)))) @@ -114,7 +112,7 @@ {#.doc "Sequencing combinator."} (All [s a b] (-> (Parser s a) (Parser s b) (Parser s [a b]))) - (do Monad<Parser> + (do ..monad [x1 p1 x2 p2] (wrap [x1 x2]))) @@ -130,7 +128,7 @@ (#error.Failure _) (run tokens - (do Monad<Parser> + (do ..monad [x2 p2] (wrap (1 x2)))) ))) @@ -152,16 +150,16 @@ {#.doc "Parse exactly N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (if (n/> 0 n) - (do Monad<Parser> + (do ..monad [x p xs (exactly (dec n) p)] (wrap (#.Cons x xs))) - (:: Monad<Parser> wrap (list)))) + (:: ..monad wrap (list)))) (def: #export (at-least n p) {#.doc "Parse at least N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) - (do Monad<Parser> + (do ..monad [min (exactly n p) extra (some p)] (wrap (list/compose min extra)))) @@ -177,24 +175,24 @@ (#error.Success [input' x]) (run input' - (do Monad<Parser> + (do ..monad [xs (at-most (dec n) p)] (wrap (#.Cons x xs)))) )) - (:: Monad<Parser> wrap (list)))) + (:: ..monad wrap (list)))) (def: #export (between from to p) {#.doc "Parse between N and M times."} (All [s a] (-> Nat Nat (Parser s a) (Parser s (List a)))) - (do Monad<Parser> + (do ..monad [min-xs (exactly from p) max-xs (at-most (n/- from to) p)] - (wrap (:: list.Monad<List> join (list min-xs max-xs))))) + (wrap (:: list.monad join (list min-xs max-xs))))) (def: #export (sep-by sep p) {#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) - (do Monad<Parser> + (do ..monad [?x (maybe p)] (case ?x #.None @@ -255,20 +253,20 @@ (def: #export (after param subject) (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) - (do Monad<Parser> + (do ..monad [_ param] subject)) (def: #export (before param subject) (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) - (do Monad<Parser> + (do ..monad [output subject _ param] (wrap output))) (def: #export (filter test parser) (All [s a] (-> (-> a Bit) (Parser s a) (Parser s a))) - (do Monad<Parser> + (do ..monad [output parser _ (assert "Constraint failed." (test output))] (wrap output))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index a5f9eca95..ec1e787e2 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -6,7 +6,7 @@ [data ["e" error] [collection - ["." list ("list/." Fold<List> Monad<List>)]]] + ["." list ("list/." fold monad)]]] [macro (#+ with-gensyms) ["s" syntax (#+ syntax: Syntax)] ["." code]]]) @@ -54,7 +54,7 @@ [(new> -1)])))} (with-gensyms [g!temp] (wrap (list (` (let [(~ g!temp) (~ prev)] - (cond (~+ (do list.Monad<List> + (cond (~+ (do list.monad [[test then] branches] (list (` (|> (~ g!temp) (~+ test))) (` (|> (~ g!temp) (~+ then)))))) @@ -90,14 +90,14 @@ {#.doc (doc "Monadic pipes." "Each steps in the monadic computation is a pipe and must be given inside a tuple." (|> +5 - (do> Monad<Identity> + (do> monad [(i/* +3)] [(i/+ +4)] [inc])))} (with-gensyms [g!temp] (case (list.reverse steps) (^ (list& last-step prev-steps)) - (let [step-bindings (do list.Monad<List> + (let [step-bindings (do list.monad [step (list.reverse prev-steps)] (list g!temp (` (|> (~ g!temp) (~+ step)))))] (wrap (list (` ((~! do) (~ monad) diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux index 1d19b5594..d8ce527cc 100644 --- a/stdlib/source/lux/control/reader.lux +++ b/stdlib/source/lux/control/reader.lux @@ -1,8 +1,8 @@ (.module: [lux #* [control - ["F" functor] - ["A" apply] + [functor (#+ Functor)] + [apply (#+ Apply)] ["." monad (#+ do Monad)]]]) ## [Types] @@ -11,26 +11,26 @@ (-> r a)) ## [Structures] -(structure: #export Functor<Reader> - (All [r] (F.Functor (Reader r))) +(structure: #export functor + (All [r] (Functor (Reader r))) (def: (map f fa) (function (_ env) (f (fa env))))) -(structure: #export Apply<Reader> - (All [r] (A.Apply (Reader r))) +(structure: #export apply + (All [r] (Apply (Reader r))) - (def: functor Functor<Reader>) + (def: &functor ..functor) (def: (apply ff fa) (function (_ env) ((ff env) (fa env))))) -(structure: #export Monad<Reader> +(structure: #export monad (All [r] (Monad (Reader r))) - (def: functor Functor<Reader>) + (def: &functor ..functor) (def: (wrap x) (function (_ env) x)) @@ -54,21 +54,21 @@ (All [r a] (-> r (Reader r a) a)) (proc env)) -(structure: #export (ReaderT Monad<M>) +(structure: #export (ReaderT monad) {#.doc "Monad transformer for Reader."} (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) - (def: functor (F.compose Functor<Reader> (get@ #monad.functor Monad<M>))) + (def: &functor (F.compose ..functor (get@ #monad.&functor monad))) - (def: wrap (|>> (:: Monad<M> wrap) (:: Monad<Reader> wrap))) + (def: wrap (|>> (:: monad wrap) (:: ..monad wrap))) (def: (join eMeMa) (function (_ env) - (do Monad<M> + (do monad [eMa (run env eMeMa)] (run env eMa))))) (def: #export lift {#.doc "Lift monadic values to the Reader wrapper."} (All [M e a] (-> (M a) (Reader e (M a)))) - (:: Monad<Reader> wrap)) + (:: ..monad wrap)) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index e014777dd..126344514 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -10,7 +10,7 @@ ["." text format] [collection - [list ("list/." Fold<List>)]]]]) + [list ("list/." fold)]]]]) (type: (Cleaner r m) (-> r (m (Error Any)))) @@ -66,7 +66,7 @@ cleaners) (#error.Success value)]))) -(structure: #export (Functor<Region> Functor<m>) +(structure: #export (functor Functor<m>) (All [m] (-> (Functor m) (All [r] (Functor (Region r m))))) @@ -84,13 +84,13 @@ (#error.Failure error))]) (fa region+cleaners)))))) -(structure: #export (Apply<Region> Monad<m>) +(structure: #export (apply Monad<m>) (All [m] (-> (Monad m) (All [r] (Apply (Region r m))))) - (def: functor - (Functor<Region> (get@ #monad.functor Monad<m>))) + (def: &functor + (..functor (get@ #monad.functor Monad<m>))) (def: (apply ff fa) (function (_ [region cleaners]) @@ -105,13 +105,13 @@ [_ (#error.Failure error)]) (wrap [cleaners (#error.Failure error)])))))) -(structure: #export (Monad<Region> Monad<m>) +(structure: #export (monad Monad<m>) (All [m] (-> (Monad m) (All [r] (Monad (Region r m))))) - (def: functor - (Functor<Region> (get@ #monad.functor Monad<m>))) + (def: &functor + (..functor (get@ #monad.&functor Monad<m>))) (def: (wrap value) (function (_ [region cleaners]) diff --git a/stdlib/source/lux/control/remember.lux b/stdlib/source/lux/control/remember.lux index a355a705b..8085ad176 100644 --- a/stdlib/source/lux/control/remember.lux +++ b/stdlib/source/lux/control/remember.lux @@ -2,7 +2,7 @@ [lux #* [control [monad (#+ do)] - ["p" parser ("p/." Functor<Parser>)] + ["p" parser ("p/." functor)] ["ex" exception (#+ exception:)]] [data ["." error] @@ -10,7 +10,7 @@ format]] [time ["." instant] - ["." date (#+ Date) ("date/." Order<Date> Codec<Text,Date>)]] + ["." date (#+ Date) ("date/." order codec)]] ["." macro ["." code] ["s" syntax (#+ Syntax syntax:)]] @@ -30,9 +30,9 @@ ($_ p.either (p/map (|>> instant.from-millis instant.date) s.int) - (do p.Monad<Parser> + (do p.monad [raw s.text] - (case (:: date.Codec<Text,Date> decode raw) + (case (:: date.codec decode raw) (#error.Success date) (wrap date) @@ -54,13 +54,13 @@ (do-template [<name> <message>] [(syntax: #export (<name> {deadline ..deadline} {message s.text} {focus (p.maybe s.any)}) (wrap (list (` (..remember (~ (code.text (date/encode deadline))) - (~ (code.text (format <message> " " message))) - (~+ (case focus - (#.Some focus) - (list focus) + (~ (code.text (format <message> " " message))) + (~+ (case focus + (#.Some focus) + (list focus) - #.None - (list))))))))] + #.None + (list))))))))] [to-do "TODO"] [fix-me "FIXME"] diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 847dbf714..f757ced19 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -7,7 +7,7 @@ [text format] [collection - [list ("list/." Functor<List>)]]] + [list ("list/." functor)]]] [type abstract] ["." macro diff --git a/stdlib/source/lux/control/security/integrity.lux b/stdlib/source/lux/control/security/integrity.lux index b78351b38..81dee0c16 100644 --- a/stdlib/source/lux/control/security/integrity.lux +++ b/stdlib/source/lux/control/security/integrity.lux @@ -32,18 +32,18 @@ (All [a] (-> (Dirty a) a)) (|>> :representation)) - (structure: #export _ (Functor Dirty) + (structure: #export functor (Functor Dirty) (def: (map f fa) (|> fa :representation f :abstraction))) - (structure: #export _ (Apply Dirty) - (def: functor Functor<Dirty>) + (structure: #export apply (Apply Dirty) + (def: &functor ..functor) (def: (apply ff fa) (:abstraction ((:representation ff) (:representation fa))))) - (structure: #export _ (Monad Dirty) - (def: functor Functor<Dirty>) + (structure: #export monad (Monad Dirty) + (def: &functor ..functor) (def: wrap (|>> :abstraction)) diff --git a/stdlib/source/lux/control/security/privacy.lux b/stdlib/source/lux/control/security/privacy.lux index e24d49acb..51d530673 100644 --- a/stdlib/source/lux/control/security/privacy.lux +++ b/stdlib/source/lux/control/security/privacy.lux @@ -74,24 +74,24 @@ (-> Type Type) (type (All [label] (constructor (All [value] (Private value label)))))) - (structure: #export Functor<Private> + (structure: #export functor (:~ (privatize Functor)) (def: (map f fa) (|> fa :representation f :abstraction))) - (structure: #export Apply<Private> + (structure: #export apply (:~ (privatize Apply)) - (def: functor Functor<Private>) + (def: &functor ..functor) (def: (apply ff fa) (:abstraction ((:representation ff) (:representation fa))))) - (structure: #export Monad<Private> + (structure: #export monad (:~ (privatize Monad)) - (def: functor Functor<Private>) + (def: &functor ..functor) (def: wrap (|>> :abstraction)) diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux index 94330ff96..c0db18a43 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -1,28 +1,26 @@ (.module: [lux #* [control - ["F" functor] - ["A" apply] - [monad (#+ do Monad)]]]) + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)]]]) -## [Types] (type: #export (State s a) {#.doc "Stateful computations."} (-> s [s a])) -## [Structures] -(structure: #export Functor<State> - (All [s] (F.Functor (State s))) +(structure: #export functor + (All [s] (Functor (State s))) (def: (map f ma) (function (_ state) (let [[state' a] (ma state)] [state' (f a)])))) -(structure: #export Apply<State> - (All [s] (A.Apply (State s))) +(structure: #export apply + (All [s] (Apply (State s))) - (def: functor Functor<State>) + (def: &functor ..functor) (def: (apply ff fa) (function (_ state) @@ -30,10 +28,10 @@ [state'' a] (fa state')] [state'' (f a)])))) -(structure: #export Monad<State> +(structure: #export monad (All [s] (Monad (State s))) - (def: functor Functor<State>) + (def: &functor ..functor) (def: (wrap a) (function (_ state) @@ -44,7 +42,6 @@ (let [[state' ma] (mma state)] (ma state'))))) -## [Values] (def: #export get {#.doc "Read the current state."} (All [s] (State s s)) @@ -81,22 +78,22 @@ (All [s a] (-> s (State s a) [s a])) (action state)) -(structure: (Functor<State'> Functor<M>) - (All [M s] (-> (F.Functor M) (F.Functor (All [a] (-> s (M [s a])))))) +(structure: (with-state//functor functor) + (All [M s] (-> (Functor M) (Functor (All [a] (-> s (M [s a])))))) (def: (map f sfa) (function (_ state) - (:: Functor<M> map (function (_ [s a]) [s (f a)]) + (:: functor map (function (_ [s a]) [s (f a)]) (sfa state))))) -(structure: (Apply<State'> Monad<M>) - (All [M s] (-> (Monad M) (A.Apply (All [a] (-> s (M [s a])))))) +(structure: (with-state//apply monad) + (All [M s] (-> (Monad M) (Apply (All [a] (-> s (M [s a])))))) - (def: functor (Functor<State'> (:: Monad<M> functor))) + (def: &functor (with-state//functor (:: monad &functor))) (def: (apply sFf sFa) (function (_ state) - (do Monad<M> + (do monad [[state f] (sFf state) [state a] (sFa state)] (wrap [state (f a)]))))) @@ -110,33 +107,33 @@ (All [M s a] (-> s (State' M s a) (M [s a]))) (action state)) -(structure: #export (Monad<State'> Monad<M>) +(structure: #export (with-state monad) {#.doc "A monad transformer to create composite stateful computations."} (All [M s] (-> (Monad M) (Monad (State' M s)))) - (def: functor (Functor<State'> (:: Monad<M> functor))) + (def: &functor (with-state//functor (:: monad &functor))) (def: (wrap a) (function (_ state) - (:: Monad<M> wrap [state a]))) + (:: monad wrap [state a]))) (def: (join sMsMa) (function (_ state) - (do Monad<M> + (do monad [[state' sMa] (sMsMa state)] (sMa state'))))) -(def: #export (lift Monad<M> ma) +(def: #export (lift monad ma) {#.doc "Lift monadic values to the State' wrapper."} (All [M s a] (-> (Monad M) (M a) (State' M s a))) (function (_ state) - (do Monad<M> + (do monad [a ma] (wrap [state a])))) (def: #export (while condition body) (All [s] (-> (State s Bit) (State s Any) (State s Any))) - (do Monad<State> + (do ..monad [execute? condition] (if execute? (do @ @@ -146,6 +143,6 @@ (def: #export (do-while condition body) (All [s] (-> (State s Bit) (State s Any) (State s Any))) - (do Monad<State> + (do ..monad [_ body] (while condition body))) diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux index 9aad8aca0..708f385a2 100644 --- a/stdlib/source/lux/control/thread.lux +++ b/stdlib/source/lux/control/thread.lux @@ -47,7 +47,7 @@ a)) (thread [])) -(structure: #export Functor<Thread> +(structure: #export functor (All [!] (Functor (Thread !))) (def: (map f) @@ -55,19 +55,19 @@ (function (_ !) (f (fa !)))))) -(structure: #export Apply<Thread> +(structure: #export apply (All [!] (Apply (Thread !))) - (def: functor Functor<Thread>) + (def: &functor ..functor) (def: (apply ff fa) (function (_ !) ((ff !) (fa !))))) -(structure: #export Monad<Thread> +(structure: #export monad (All [!] (Monad (Thread !))) - (def: functor Functor<Thread>) + (def: &functor ..functor) (def: (wrap value) (function (_ !) @@ -79,7 +79,7 @@ (def: #export (update f box) (All [a] (-> (-> a a) (All [!] (-> (Box ! a) (Thread ! a))))) - (do Monad<Thread> + (do ..monad [old (read box) _ (write (f old) box)] (wrap old))) diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux index 4007cb6cb..152bc9e71 100644 --- a/stdlib/source/lux/control/writer.lux +++ b/stdlib/source/lux/control/writer.lux @@ -2,39 +2,39 @@ [lux #* [control monoid - ["F" functor] - ["A" apply] - ["." monad (#+ do Monad)]]]) + [functor (#+ Functor)] + [apply (#+ Apply)] + ["." monad (#+ Monad do)]]]) (type: #export (Writer l a) {#.doc "Represents a value with an associated 'log' value to record arbitrary information."} {#log l #value a}) -(structure: #export Functor<Writer> +(structure: #export functor (All [l] - (F.Functor (Writer l))) + (Functor (Writer l))) (def: (map f fa) (let [[log datum] fa] [log (f datum)]))) -(structure: #export (Apply<Writer> mon) +(structure: #export (apply mon) (All [l] - (-> (Monoid l) (A.Apply (Writer l)))) + (-> (Monoid l) (Apply (Writer l)))) - (def: functor Functor<Writer>) + (def: &functor ..functor) (def: (apply ff fa) (let [[log1 f] ff [log2 a] fa] [(:: mon compose log1 log2) (f a)]))) -(structure: #export (Monad<Writer> mon) +(structure: #export (monad mon) (All [l] (-> (Monoid l) (Monad (Writer l)))) - (def: functor Functor<Writer>) + (def: &functor ..functor) (def: (wrap x) [(:: mon identity) x]) @@ -48,17 +48,17 @@ (All [l] (-> l (Writer l Any))) [l []]) -(structure: #export (WriterT Monoid<l> Monad<M>) +(structure: #export (with-writer Monoid<l> monad) (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a)))))) - (def: functor (F.compose (get@ #monad.functor Monad<M>) Functor<Writer>)) + (def: &functor (F.compose (get@ #monad.&functor monad) ..functor)) (def: wrap - (let [monad (Monad<Writer> Monoid<l>)] - (|>> (:: monad wrap) (:: Monad<M> wrap)))) + (let [monad (..monad Monoid<l>)] + (|>> (:: monad wrap) (:: monad wrap)))) (def: (join MlMla) - (do Monad<M> + (do monad [## TODO: Remove once new-luxc is the standard compiler. [l1 Mla] (: (($ 1) (Writer ($ 0) (($ 1) (Writer ($ 0) ($ 2))))) MlMla) @@ -66,9 +66,9 @@ [l2 a] Mla] (wrap [(:: Monoid<l> compose l1 l2) a])))) -(def: #export (lift Monoid<l> Monad<M>) +(def: #export (lift Monoid<l> monad) (All [l M a] (-> (Monoid l) (Monad M) (-> (M a) (M (Writer l a))))) (function (_ ma) - (do Monad<M> + (do monad [a ma] (wrap [(:: Monoid<l> identity) a])))) |