diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/concurrency/actor.lux | 50 |
1 files changed, 25 insertions, 25 deletions
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 14e382e1c..42b8908f9 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -9,7 +9,7 @@ [product] [number "Nat/" Codec<Text,Nat>]) [macro #+ with-gensyms] - (macro [ast] + (macro [code] ["s" syntax #+ syntax: Syntax] (syntax [common])) [type]) @@ -128,7 +128,7 @@ (wrap (#;Right new-server)))) )))) #end (function [_ server] (exec (io;run (poison server)) - (:: Monad<Promise> wrap [])))})))] + (:: Monad<Promise> wrap [])))})))] (update@ #obituary (: (-> (P;Promise [(Maybe Text) (Actor ($ +0) ($ +1)) (List ($ +1))]) (P;Promise [(Maybe Text) ($ +0) (List ($ +1))])) (function [process] @@ -142,9 +142,9 @@ (type: Method {#name Text #vars (List Text) - #args (List [Text AST]) - #return AST - #body AST}) + #args (List [Text Code]) + #return Code + #body Code}) (def: method^ (Syntax Method) @@ -164,20 +164,20 @@ #body body})))) (def: stop^ - (Syntax AST) + (Syntax Code) (s;form (do s;Monad<Syntax> [_ (s;this! (' stop:))] s;any))) (def: actor-decl^ - (Syntax [(List Text) Text (List [Text AST])]) + (Syntax [(List Text) Text (List [Text Code])]) (s;seq (s;default (list) (s;tuple (s;some s;local-symbol))) (s;either (s;form (s;seq s;local-symbol (s;many common;typed-arg))) (s;seq s;local-symbol (:: s;Monad<Syntax> wrap (list)))))) (def: (actor-def-decl [_vars _name _args] return-type) - (-> [(List Text) Text (List [Text AST])] AST (List AST)) - (let [decl (` ((~ (ast;symbol ["" (format _name "//new")])) (~@ (List/map (|>. product;left [""] ast;symbol) _args)))) + (-> [(List Text) Text (List [Text Code])] Code (List Code)) + (let [decl (` ((~ (code;symbol ["" (format _name "//new")])) (~@ (List/map (|>. product;left [""] code;symbol) _args)))) base-type (` (-> (~@ (List/map product;right _args)) (~ return-type))) type (case _vars @@ -185,7 +185,7 @@ base-type _ - (` (All [(~@ (List/map (|>. [""] ast;symbol) _vars))] + (` (All [(~@ (List/map (|>. [""] code;symbol) _vars))] (~ base-type))))] (list decl type))) @@ -213,20 +213,20 @@ (wrap (#;Left "Cannot add negative numbers!")))) ))} (with-gensyms [g!message g!error g!return g!error g!output] - (let [g!state-name (ast;symbol ["" (format _name "//STATE")]) - g!protocol-name (ast;symbol ["" (format _name "//PROTOCOL")]) - g!self (ast;symbol ["" "*self*"]) - g!state (ast;symbol ["" "*state*"]) - g!cause (ast;symbol ["" "*cause*"]) + (let [g!state-name (code;symbol ["" (format _name "//STATE")]) + g!protocol-name (code;symbol ["" (format _name "//PROTOCOL")]) + g!self (code;symbol ["" "*self*"]) + g!state (code;symbol ["" "*state*"]) + g!cause (code;symbol ["" "*cause*"]) g!stop-body (default (` (:: P;Monad<Promise> (~' wrap) [])) ?stop) protocol (List/map (function [(^slots [#name #vars #args #return #body])] - (` ((~ (ast;tag ["" name])) [(~@ (List/map product;right args))] (P;Promise (~ return))))) + (` ((~ (code;tag ["" name])) [(~@ (List/map product;right args))] (P;Promise (~ return))))) methods) - protocol-pm (List/map (: (-> Method [AST AST]) + protocol-pm (List/map (: (-> Method [Code Code]) (function [(^slots [#name #vars #args #return #body])] - (let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] ast;symbol))) + (let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] code;symbol))) body-func (` (: (-> (~ g!state-name) (~@ (List/map product;right args)) (P;Promise (Error [(~ g!state-name) (~ return)]))) - (function (~ (ast;symbol ["" _name])) [(~ g!state) (~@ (List/map (|>. product;left [""] ast;symbol) args))] + (function (~ (code;symbol ["" _name])) [(~ g!state) (~@ (List/map (|>. product;left [""] code;symbol) args))] (do P;Monad<Promise> [] (~ body)))))] @@ -249,7 +249,7 @@ (list pattern clause)) protocol-pm)) (List/join (List/map (function [[method [pattern clause]]] - (list (` ((~ (ast;tag ["" (get@ #name method)])) (~ pattern))) + (list (` ((~ (code;tag ["" (get@ #name method)])) (~ pattern))) clause)) (list;zip2 methods protocol-pm))))) )) @@ -257,17 +257,17 @@ (do P;Monad<Promise> [] (~ g!stop-body)))}) - g!actor-name (ast;symbol ["" _name]) - g!methods (List/map (: (-> Method AST) + g!actor-name (code;symbol ["" _name]) + g!methods (List/map (: (-> Method Code) (function [(^slots [#name #vars #args #return #body])] - (let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] ast;symbol))) + (let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] code;symbol))) type (` (-> (~@ (List/map product;right args)) (~ g!actor-name) (P;Promise (~ return))))] - (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~@ arg-names) (~ g!self)) + (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (code;symbol ["" name])) (~@ arg-names) (~ g!self)) (~ type) (let [(~ g!output) (P;promise (~ return))] - (exec (send ((~ (ast;tag ["" name])) [[(~@ arg-names)] (~ g!output)]) (~ g!self)) + (exec (send ((~ (code;tag ["" name])) [[(~@ arg-names)] (~ g!output)]) (~ g!self)) (~ g!output)))))))) methods)] (wrap (list& (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!state-name) (~ state-type))) |