diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/documentation/lux/control/concurrency/actor.lux | 56 | ||||
-rw-r--r-- | stdlib/source/documentation/lux/type/implicit.lux | 6 | ||||
-rw-r--r-- | stdlib/source/library/lux/control/concurrency/actor.lux | 454 | ||||
-rw-r--r-- | stdlib/source/library/lux/type/implicit.lux | 10 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/concurrency/actor.lux | 76 | ||||
-rw-r--r-- | stdlib/source/test/lux/type/implicit.lux | 4 |
6 files changed, 191 insertions, 415 deletions
diff --git a/stdlib/source/documentation/lux/control/concurrency/actor.lux b/stdlib/source/documentation/lux/control/concurrency/actor.lux index fb84a5b1f..1ad895a87 100644 --- a/stdlib/source/documentation/lux/control/concurrency/actor.lux +++ b/stdlib/source/documentation/lux/control/concurrency/actor.lux @@ -19,8 +19,8 @@ (documentation: (/.Obituary state) "Details on the death of an actor.") -(documentation: (/.Behavior input state) - "An actor's behavior when mail is received and when a fatal error occurs.") +(documentation: (/.Behavior state) + "An actor's behavior when mail is received.") (documentation: /.spawn! "Given a behavior and initial state, spawns an actor and returns it.") @@ -44,55 +44,6 @@ (format "Kills the actor by sending mail that will kill it upon processing," \n "but allows the actor to handle previous mail.")) -(with_expansions [<examples> (these (actor: .public (stack a) - (List a) - - ((on_mail mail state self) - (do (try.with async.monad) - [.let [_ (debug.log! "BEFORE")] - output (mail state self) - .let [_ (debug.log! "AFTER")]] - (in output))) - - (def: .public push - (message (_ [value a] state self) - (List a) - (let [state' {.#Item value state}] - (async.resolved {try.#Success [state' state']}))))) - - (actor: .public counter - Nat - - (def: .public count! - (message .public (_ [increment Nat] state self) - Any - (let [state' (n.+ increment state)] - (async.resolved {try.#Success [state' state']})))) - - (def: .public read! - (message (_ state self) - Nat - (async.resolved {try.#Success [state state]})))))] - (documentation: /.actor: - (format "Defines a named actor, with its behavior and internal state." - \n "Messages for the actor must be defined after the on_mail handler.") - [<examples>]) - - (documentation: /.actor - (format "Defines an anonymous actor, with its behavior and internal state." - \n "Messages for the actor must be defined after the on_mail handler.") - [(actor [Nat - 123] - ((on_mail message state self) - (message (++ state) self)))]) - - (documentation: /.message - (format "A message can access the actor's state through the state parameter." - \n "A message can also access the actor itself through the self parameter." - \n "A message's output must be an async containing a 2-tuple with the updated state and a return value." - \n "A message may succeed or fail (in case of failure, the actor dies).") - [<examples>])) - (documentation: /.Stop "A signal to stop an actor from observing a channel.") @@ -116,9 +67,6 @@ ..tell! ..default ..poison! - ..actor: - ..actor - ..message ..Stop ..observe! ($.default /.poisoned) diff --git a/stdlib/source/documentation/lux/type/implicit.lux b/stdlib/source/documentation/lux/type/implicit.lux index be1b19999..6a54a0dae 100644 --- a/stdlib/source/documentation/lux/type/implicit.lux +++ b/stdlib/source/documentation/lux/type/implicit.lux @@ -43,9 +43,9 @@ (n.= (at n.addition composite left right) (a/an composite left right)))]) -(documentation: /.implicit: +(documentation: /.implicitly "Establish local definitions for implementations that will be prioritized over foreign definitions." - [(implicit: [n.multiplication]) + [(implicitly n.multiplication) (n.= (at n.multiplication composite left right) (a/an composite left right))]) @@ -56,5 +56,5 @@ "" [..a/an ..with - ..implicit:] + ..implicitly] [])) diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 544c672d9..4c1c608ea 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -21,6 +21,7 @@ ["[0]" list (.open: "[1]#[0]" monoid monad)]]] ["[0]" macro (.only with_symbols) ["[0]" code] + ["[0]" local] [syntax (.only syntax) ["|[0]|" input] ["|[0]|" export]]] @@ -38,172 +39,165 @@ (exception: .public poisoned) (exception: .public dead) -(with_expansions - [<Mail> (these (-> s (Actor s) (Async (Try s)))) - <Obituary> (these [Text s (List <Mail>)]) - <Mailbox> (these (Rec Mailbox - [(Async [<Mail> Mailbox]) - (Resolver [<Mail> Mailbox])]))] - - (def: (pending [read write]) - (All (_ a) - (-> (Rec Mailbox - [(Async [a Mailbox]) - (Resolver [a Mailbox])]) - (IO (List a)))) - (do [! io.monad] - [current (async.value read)] - (case current - {.#Some [head tail]} - (at ! each (|>> {.#Item head}) - (pending tail)) - - {.#None} - (in {.#End})))) - - (primitive: .public (Actor s) - (Record - [#obituary [(Async <Obituary>) - (Resolver <Obituary>)] - #mailbox (Atom <Mailbox>)]) - - (type: .public (Mail s) - <Mail>) - - (type: .public (Obituary s) - <Obituary>) - - (type: .public (Behavior o s) - (Record - [#on_init (-> o s) - #on_mail (-> (Mail s) s (Actor s) (Async (Try s)))])) - - (def: .public (spawn! behavior init) - (All (_ o s) (-> (Behavior o s) o (IO (Actor s)))) - (io (let [[on_init on_mail] behavior - self (sharing [o s] - (Behavior o s) - behavior - - (Actor s) - (abstraction [#obituary (async.async []) - #mailbox (atom (async.async []))])) - process (loop (again [state (on_init init) - [|mailbox| _] (io.run! (atom.read! (the #mailbox (representation self))))]) - (do [! async.monad] - [[head tail] |mailbox| - ?state' (on_mail head state self)] - (case ?state' - {try.#Failure error} - (let [[_ resolve] (the #obituary (representation self))] - (exec (io.run! - (do io.monad - [pending (..pending tail)] - (resolve [error state {.#Item head pending}]))) - (in []))) - - {try.#Success state'} - (again state' tail))))] - self))) - - (def: .public (alive? actor) - (All (_ s) (-> (Actor s) (IO Bit))) - (let [[obituary _] (the #obituary (representation actor))] - (|> obituary - async.value - (at io.functor each - (|>> (pipe.case - {.#None} - bit.yes - - _ - bit.no)))))) - - (def: .public (obituary' actor) - (All (_ s) (-> (Actor s) (IO (Maybe (Obituary s))))) - (let [[obituary _] (the #obituary (representation actor))] - (async.value obituary))) - - (def: .public obituary - (All (_ s) (-> (Actor s) (Async (Obituary s)))) - (|>> representation - (the #obituary) - product.left)) - - (def: .public (mail! mail actor) - (All (_ s) (-> (Mail s) (Actor s) (IO (Try Any)))) - (do [! io.monad] - [alive? (..alive? actor)] - (if alive? - (let [entry [mail (async.async [])]] - (do ! - [|mailbox|&resolve (atom.read! (the #mailbox (representation actor)))] - (loop (again [[|mailbox| resolve] |mailbox|&resolve]) - (do ! - [|mailbox| (async.value |mailbox|)] - (case |mailbox| - {.#None} - (do ! - [resolved? (resolve entry)] - (if resolved? - (do ! - [_ (atom.write! (product.right entry) (the #mailbox (representation actor)))] - (in {try.#Success []})) - (again |mailbox|&resolve))) - - {.#Some [_ |mailbox|']} - (again |mailbox|')))))) - (in (exception.except ..dead []))))) - - (type: .public (Message s o) - (-> s (Actor s) (Async (Try [s o])))) - - (def: (mail message) - (All (_ s o) (-> (Message s o) [(Async (Try o)) (Mail s)])) - (let [[async resolve] (sharing [s o] - (Message s o) - message - - [(Async (Try o)) - (Resolver (Try o))] - (async.async []))] - [async - (function (_ state self) - (do [! async.monad] - [outcome (message state self)] - (case outcome - {try.#Success [state' return]} - (exec - (io.run! (resolve {try.#Success return})) - (async.resolved {try.#Success state'})) +(local.let [<Mail> (template (_ Actor s) + [(-> s (Actor s) (Async (Try s)))]) + <Obituary> (template (_ Actor s) + [[Text s (List (<Mail> Actor s))]]) + <Mailbox> (template (_ Actor s) + [(Rec Mailbox + [(Async [(<Mail> Actor s) Mailbox]) + (Resolver [(<Mail> Actor s) Mailbox])])])] + (these (def: (pending [read write]) + (All (_ a) + (-> (Rec Mailbox + [(Async [a Mailbox]) + (Resolver [a Mailbox])]) + (IO (List a)))) + (do [! io.monad] + [current (async.value read)] + (case current + {.#Some [head tail]} + (at ! each (|>> {.#Item head}) + (pending tail)) - {try.#Failure error} - (exec - (io.run! (resolve {try.#Failure error})) - (async.resolved {try.#Failure error})))))])) - - (def: .public (tell! message actor) - (All (_ s o) (-> (Message s o) (Actor s) (Async (Try o)))) - (let [[async mail] (..mail message)] - (do async.monad - [outcome (async.future (..mail! mail actor))] - (case outcome - {try.#Success} - async - - {try.#Failure error} - (in {try.#Failure error}))))) - ) - ) - -(def: (default_on_mail mail state self) - (All (_ s) (-> (Mail s) s (Actor s) (Async (Try s)))) - (mail state self)) + {.#None} + (in {.#End})))) + + (primitive: .public (Actor s) + (Record + [#obituary [(Async (<Obituary> Actor s)) + (Resolver (<Obituary> Actor s))] + #mailbox (Atom (<Mailbox> Actor s))]) + + (type: .public (Mail s) + (<Mail> Actor s)) + + (type: .public (Obituary s) + (<Obituary> Actor s)) + + (type: .public (Behavior s) + (-> (Mail s) s (Actor s) (Async (Try s)))) + + (def: .public (spawn! behavior init) + (All (_ s) (-> (Behavior s) s (IO (Actor s)))) + (io (let [self (sharing [s] + (Behavior s) + behavior + + (Actor s) + (abstraction [#obituary (async.async []) + #mailbox (atom (async.async []))])) + process (loop (again [state init + [|mailbox| _] (io.run! (atom.read! (the #mailbox (representation self))))]) + (do [! async.monad] + [[head tail] |mailbox| + ?state' (behavior head state self)] + (case ?state' + {try.#Failure error} + (let [[_ resolve] (the #obituary (representation self))] + (exec (io.run! + (do io.monad + [pending (..pending tail)] + (resolve [error state {.#Item head pending}]))) + (in []))) + + {try.#Success state'} + (again state' tail))))] + self))) + + (def: .public (alive? actor) + (All (_ s) (-> (Actor s) (IO Bit))) + (let [[obituary _] (the #obituary (representation actor))] + (|> obituary + async.value + (at io.functor each + (|>> (pipe.case + {.#None} + bit.yes + + _ + bit.no)))))) + + (def: .public (obituary' actor) + (All (_ s) (-> (Actor s) (IO (Maybe (Obituary s))))) + (let [[obituary _] (the #obituary (representation actor))] + (async.value obituary))) + + (def: .public obituary + (All (_ s) (-> (Actor s) (Async (Obituary s)))) + (|>> representation + (the #obituary) + product.left)) + + (def: .public (mail! mail actor) + (All (_ s) (-> (Mail s) (Actor s) (IO (Try Any)))) + (do [! io.monad] + [alive? (..alive? actor)] + (if alive? + (let [entry [mail (async.async [])]] + (do ! + [|mailbox|&resolve (atom.read! (the #mailbox (representation actor)))] + (loop (again [[|mailbox| resolve] |mailbox|&resolve]) + (do ! + [|mailbox| (async.value |mailbox|)] + (case |mailbox| + {.#None} + (do ! + [resolved? (resolve entry)] + (if resolved? + (do ! + [_ (atom.write! (product.right entry) (the #mailbox (representation actor)))] + (in {try.#Success []})) + (again |mailbox|&resolve))) + + {.#Some [_ |mailbox|']} + (again |mailbox|')))))) + (in (exception.except ..dead []))))) + + (type: .public (Message s o) + (-> s (Actor s) (Async (Try [s o])))) + + (def: (mail message) + (All (_ s o) (-> (Message s o) [(Async (Try o)) (Mail s)])) + (let [[async resolve] (sharing [s o] + (Message s o) + message + + [(Async (Try o)) + (Resolver (Try o))] + (async.async []))] + [async + (function (_ state self) + (do [! async.monad] + [outcome (message state self)] + (case outcome + {try.#Success [state' return]} + (exec + (io.run! (resolve {try.#Success return})) + (async.resolved {try.#Success state'})) + + {try.#Failure error} + (exec + (io.run! (resolve {try.#Failure error})) + (async.resolved {try.#Failure error})))))])) + + (def: .public (tell! message actor) + (All (_ s o) (-> (Message s o) (Actor s) (Async (Try o)))) + (let [[async mail] (..mail message)] + (do async.monad + [outcome (async.future (..mail! mail actor))] + (case outcome + {try.#Success} + async + + {try.#Failure error} + (in {try.#Failure error}))))) + ))) (def: .public default - (All (_ s) (Behavior s s)) - [#on_init function.identity - #on_mail ..default_on_mail]) + Behavior + (function (_ mail state self) + (mail state self))) (def: .public (poison! actor) (All (_ s) (-> (Actor s) (IO (Try Any)))) @@ -211,140 +205,6 @@ (async.resolved (exception.except ..poisoned []))) actor)) -(def: actor_decl^ - (Parser [Text (List Text)]) - (<>.either (<code>.form (<>.and <code>.local (<>.some <code>.local))) - (<>.and <code>.local (at <>.monad in (list))))) - -(type: On_MailC - [[Text Text Text] Code]) - -(type: BehaviorC - [(Maybe On_MailC) (List Code)]) - -(def: argument - (Parser Text) - <code>.local) - -(def: on_mail^ - (Parser (Maybe On_MailC)) - (<>.maybe (<code>.form (<>.and (<code>.form (<>.after (<code>.this (' on_mail)) - (all <>.and ..argument ..argument ..argument))) - <code>.any)))) - -(def: behavior^ - (Parser BehaviorC) - (all <>.and - ..on_mail^ - (<>.some <code>.any))) - -(def: (on_mail g!_ ?on_mail) - (-> Code (Maybe On_MailC) Code) - (case ?on_mail - {.#None} - (` (~! ..default_on_mail)) - - {.#Some [[mailN stateN selfN] bodyC]} - (` (function ((~ g!_) - (~ (code.local mailN)) - (~ (code.local stateN)) - (~ (code.local selfN))) - (~ bodyC))))) - -(def: actorP - (Parser [Code [Text (List Text)] Code BehaviorC]) - (|export|.parser - (all <>.and - ..actor_decl^ - <code>.any - behavior^))) - -(def: .public actor: - (syntax (_ [[export_policy [name vars] state_type [?on_mail messages]] ..actorP]) - (with_symbols [g!_] - (do meta.monad - [g!type (macro.symbol (format name "_primitive_type")) - .let [g!actor (code.local name) - g!vars (list#each code.local vars)]] - (in (list (` ((~! primitive:) (~ export_policy) ((~ g!type) (~+ g!vars)) - (~ state_type) - - (def: (~ export_policy) (~ g!actor) - (All ((~ g!_) (~+ g!vars)) - (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) - [..#on_init (|>> ((~! primitive.abstraction) (~ g!type))) - ..#on_mail (~ (..on_mail g!_ ?on_mail))]) - - (~+ messages))))))))) - -(def: .public actor - (syntax (_ [[state_type init] (<code>.tuple (<>.and <code>.any <code>.any)) - ?on_mail on_mail^]) - (with_symbols [g!_] - (in (list (` (is ((~! io.IO) (..Actor (~ state_type))) - (..spawn! (is (..Behavior (~ state_type) (~ state_type)) - [..#on_init (|>>) - ..#on_mail (~ (..on_mail g!_ ?on_mail))]) - (is (~ state_type) - (~ init)))))))))) - -(type: Signature - (Record - [#vars (List Text) - #name Text - #inputs (List |input|.Input) - #state Text - #self Text])) - -(def: signature^ - (Parser Signature) - (<code>.form (all <>.and - (<>.else (list) (<code>.tuple (<>.some <code>.local))) - <code>.local - |input|.parser - <code>.local - <code>.local))) - -(def: reference^ - (Parser [Symbol (List Text)]) - (<>.either (<code>.form (<>.and <code>.symbol (<>.some <code>.local))) - (<>.and <code>.symbol (at <>.monad in (list))))) - -(def: messageP - (Parser [Signature Code Code]) - (all <>.and - ..signature^ - <code>.any - <code>.any)) - -(def: .public message - (syntax (_ [[signature output_type body] ..messageP]) - (with_symbols [g!_ g!return] - (do meta.monad - [actor_scope primitive.current - .let [g!type (code.local (the primitive.#name actor_scope)) - g!message (code.local (the #name signature)) - g!actor_vars (the primitive.#type_vars actor_scope) - g!all_vars (|> signature (the #vars) (list#each code.local) (list#composite g!actor_vars)) - g!inputsC (|> signature (the #inputs) (list#each product.left)) - g!inputsT (|> signature (the #inputs) (list#each product.right)) - g!state (|> signature (the #state) code.local) - g!self (|> signature (the #self) code.local)]] - (in (list (` (is (All ((~ g!_) (~+ g!all_vars)) - (-> (~+ g!inputsT) - (..Message (~ (the primitive.#abstraction actor_scope)) - (~ output_type)))) - (function ((~ g!message) (~+ g!inputsC)) - (function ((~ g!_) (~ g!state) (~ g!self)) - (let [(~ g!state) (as (~ (the primitive.#representation actor_scope)) - (~ g!state))] - (|> (~ body) - (is ((~! async.Async) ((~! try.Try) [(~ (the primitive.#representation actor_scope)) - (~ output_type)]))) - (as ((~! async.Async) ((~! try.Try) [(~ (the primitive.#abstraction actor_scope)) - (~ output_type)]))))))))) - )))))) - (type: .public Stop (IO Any)) diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index b497be5d5..b00cb8081 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -379,12 +379,8 @@ (list.repeated amount) (monad.all meta.monad))) -(def: implicits - (Parser (List Code)) - (<code>.tuple (<>.many <code>.any))) - (def: .public with - (syntax (_ [implementations ..implicits + (syntax (_ [implementations (<code>.tuple (<>.many <code>.any)) body <code>.any]) (do meta.monad [g!implicit+ (implicit_bindings (list.size implementations))] @@ -394,8 +390,8 @@ list#conjoint))] (~ body)))))))) -(def: .public implicit: - (syntax (_ [implementations ..implicits]) +(def: .public implicitly + (syntax (_ [implementations (<>.many <code>.any)]) (do meta.monad [g!implicit+ (implicit_bindings (list.size implementations))] (in (|> (list.zipped_2 g!implicit+ implementations) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index d99ce25b8..d883e6c0f 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -19,7 +19,7 @@ [number ["n" nat]]]]] [\\library - ["[0]" / (.only actor: message) + ["[0]" / (.only) [// ["[0]" atom (.only Atom)] ["[0]" async (.only Async Resolver) (.open: "[1]#[0]" monad)] @@ -27,18 +27,16 @@ (exception: got_wrecked) -(actor: counter - Nat +(def: counter + (/.Behavior Nat) + (function (_ message state self) + (message state self))) - ((on_mail message state self) - (message state self)) - - (def: count! - (message (_ [increment Nat] state self) - Nat - (let [state' (n.+ increment state)] - (async#in {try.#Success [state' state']})))) - ) +(def: (count! increment) + (-> Nat (/.Message Nat Nat)) + (function (_ state self) + (let [state' (n.+ increment state)] + (async#in {try.#Success [state' state']})))) (def: (mailed? outcome) (-> (Try Any) Bit) @@ -87,19 +85,18 @@ (async.async []))] (in (do async.monad [_ (async.future (do io.monad - [actor (/.spawn! (is (/.Behavior Any Any) - [/.#on_init (|>>) - /.#on_mail (function (_ message state self) - (do [! async.monad] - [outcome (message state self)] - (case outcome - {try.#Failure cause} - (do ! - [_ (async.future (write cause))] - (in outcome)) - - {try.#Success _} - (in outcome))))]) + [actor (/.spawn! (is (/.Behavior Any) + (function (_ message state self) + (do [! async.monad] + [outcome (message state self)] + (case outcome + {try.#Failure cause} + (do ! + [_ (async.future (write cause))] + (in outcome)) + + {try.#Success _} + (in outcome))))) [])] (/.poison! actor))) _ (async.delay 100) @@ -165,38 +162,13 @@ (in (and (n.= 1 output_1) (n.= 2 output_2) (n.= 3 output_3))))] - (_.coverage' [/.Message /.message /.actor: /.tell!] + (_.coverage' [/.Message /.tell!] (case result {try.#Success outcome} outcome {try.#Failure error} false)))) - - (in (do async.monad - [verdict (async.future - (do io.monad - [anonymous (/.actor [Nat - initial_state] - ((on_mail message state self) - (message (++ state) self))) - sent/++? (/.mail! ++! anonymous) - sent/--? (/.mail! --! anonymous) - poisoned? (/.poison! anonymous) - obituary (/.obituary' anonymous)] - (in (and (..mailed? sent/++?) - (..mailed? sent/--?) - (..mailed? poisoned?) - (case obituary - (pattern {.#Some [error final_state (list poison_pill)]}) - (and (exception.match? /.poisoned error) - (n.= (++ (++ initial_state)) - final_state)) - - _ - false)))))] - (_.coverage' [/.actor] - verdict))) (do ! [num_events (at ! each (|>> (n.% 10) ++) random.nat) @@ -208,7 +180,7 @@ (in (do async.monad [agent (async.future (do [! io.monad] - [agent (/.actor [Nat 0]) + [agent (/.spawn! /.default 0) _ (/.observe! (function (_ event stop) (function (_ events_seen self) (async.future diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 590842360..4e69f9f10 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -19,7 +19,7 @@ [\\library ["[0]" /]]) -(/.implicit: [n.multiplication]) +(/.implicitly n.multiplication) (def: .public test Test @@ -58,7 +58,7 @@ (/.with [n.addition] (n.= (at n.addition composite left right) (/.a/an composite left right)))) - (_.coverage [/.implicit:] + (_.coverage [/.implicitly] (n.= (at n.multiplication composite left right) (/.a/an composite left right))) )))) |