diff options
Diffstat (limited to 'stdlib/source')
-rw-r--r-- | stdlib/source/lux/concurrency/session.lux | 228 |
1 files changed, 0 insertions, 228 deletions
diff --git a/stdlib/source/lux/concurrency/session.lux b/stdlib/source/lux/concurrency/session.lux deleted file mode 100644 index ac9f984d9..000000000 --- a/stdlib/source/lux/concurrency/session.lux +++ /dev/null @@ -1,228 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do)] - ["p" parser]] - [data - ["." lazy (#+ Lazy)] - [text - format] - [collection - ["." list ("list/." Functor<List>)]]] - ["." io] - ["." type (#+ :share)] - ["." macro - ["." code] - ["s" syntax (#+ syntax:) - [common - ["." reader] - ["." writer]]]]] - [// - ["." promise (#+ Promise)]]) - -(def: counterpart-doc - (-> Name Code) - (|>> %name (format "The session/type counterpart to ") code.text)) - -## Session -(type: #export Session - {#.doc (doc "A pair of types, for 'me' and 'you'." - "They describe each side in a session protocol.")} - [Type Type]) - -(def: #export ($session [mine yours]) - {#.doc (doc "Create an actual type from a session.")} - (-> Session Type) - (type [mine yours])) - -(def: #export << - {#.doc (doc "Create an actual type from a session.")} - $session) - -(do-template [<name> <alias> <side> <doc>] - [(def: #export (<name> [mine yours]) - {#.doc (code.text (format "'" <doc> "' side of the session."))} - (-> Session Type) - <side>) - - (def: #export <alias> <name>)] - - [$my +<< mine "My"] - [$your -<< yours "Your"] - ) - -## End -(type: #export End - {#.doc (doc "Represents the end of a protocol.")} - []) - -(def: #export end - {#.doc (doc "The last step in a session.")} - (Lazy [End End]) - (lazy.freeze [[] []])) - -(def: #export $end - {#.doc (doc (counterpart-doc (name-of ..end)))} - Session - [End End]) - -(def: #export >> - {#.doc (doc (counterpart-doc (name-of ..end)))} - $end) - -## Read (Receive) / Write (Send) -(type: #export (Read value next) - {#.doc (doc "A reading step.")} - (-> [] (Promise [value next]))) - -(type: #export (Write value next) - {#.doc (doc "A writing step.")} - (-> value (Promise next))) - -(def: #export (receive session) - {#.doc (doc "A Read step for 'me', and a Write step for 'you'.")} - (All [value mine yours] - (-> (Lazy [mine yours]) - (Lazy [(Read value mine) (Write value yours)]))) - (lazy.freeze (let [channel (promise.promise #.None)] - [(function (_ _) - (let [[mine yours] (lazy.thaw session)] - (do promise.Monad<Promise> - [value channel] - (wrap [value mine])))) - (function (_ value) - (let [[mine yours] (lazy.thaw session)] - (exec (io.run (promise.resolve value channel)) - (promise.promise (#.Some yours)))))]))) - -(def: #export (send session) - {#.doc (doc "A Write step for 'me', and a Read step for 'you'.")} - (All [value mine yours] - (-> (Lazy [mine yours]) - (Lazy [(Write value mine) (Read value yours)]))) - (lazy.freeze (let [channel (promise.promise #.None)] - [(function (_ value) - (let [[mine yours] (lazy.thaw session)] - (exec (io.run (promise.resolve value channel)) - (promise.promise (#.Some mine))))) - (function (_ _) - (let [[mine yours] (lazy.thaw session)] - (do promise.Monad<Promise> - [value channel] - (wrap [value yours]))))]))) - -(do-template [<name> <alias> <me> <you> <counterpart>] - [(def: #export (<name> value [mine yours]) - {#.doc (doc (counterpart-doc (name-of <counterpart>)))} - (-> Type Session Session) - [(type (<me> value mine)) (type (<you> value yours))]) - - (def: #export <alias> - {#.doc (doc <doc>)} - <name>)] - - [$receive ?? Read Write ..receive] - [$send !! Write Read ..send] - ) - -## Fork / Join -(type: #export (Fork left right) - {#.doc (doc "A forking step, that allows choosing which path to take.")} - (All [next] - (-> (| (-> left next) - (-> right next)) - (Promise next)))) - -(type: #export (Join left right) - {#.doc (doc "A joining step, which communicates which path was taken.")} - (-> [] (Promise (| left right)))) - -(def: #export (fork left right) - {#.doc (doc "A Fork step for 'me', and a Join step for 'you'.")} - (All [myL yourL myR yourR] - (-> (Lazy [myL yourL]) (Lazy [myR yourR]) - (Lazy [(Fork myL myR) (Join yourL yourR)]))) - (lazy.freeze (let [channel (: (Promise Bit) - (promise.promise #.None))] - [(function (_ signal) - (let [[myL yourL] (lazy.thaw left) - [myR yourR] (lazy.thaw right)] - (case signal - (#.Left go) - (exec (io.run (promise.resolve #0 channel)) - (promise.promise (#.Some (go myL)))) - - (#.Right go) - (exec (io.run (promise.resolve #1 channel)) - (promise.promise (#.Some (go myR))))))) - (function (_ _) - (let [[myL yourL] (lazy.thaw left) - [myR yourR] (lazy.thaw right)] - (do promise.Monad<Promise> - [choice channel] - (wrap (case choice - #0 (#.Left yourL) - #1 (#.Right yourR))))))]))) - -(def: #export (join left right) - {#.doc (doc "A Join step for 'me', and a Fork step for 'you'.")} - (All [myL yourL myR yourR] - (-> (Lazy [myL yourL]) (Lazy [myR yourR]) - (Lazy [(Join myL myR) (Fork yourL yourR)]))) - (lazy.freeze (let [channel (: (Promise Bit) - (promise.promise #.None))] - [(function (_ _) - (let [[myL yourL] (lazy.thaw left) - [myR yourR] (lazy.thaw right)] - (do promise.Monad<Promise> - [choice channel] - (wrap (case choice - #0 (#.Left myL) - #1 (#.Right myR)))))) - (function (_ signal) - (let [[myL yourL] (lazy.thaw left) - [myR yourR] (lazy.thaw right)] - (case signal - (#.Left go) - (exec (io.run (promise.resolve #0 channel)) - (promise.promise (#.Some (go yourL)))) - - (#.Right go) - (exec (io.run (promise.resolve #1 channel)) - (promise.promise (#.Some (go yourR)))))))]))) - -(do-template [<name> <alias> <+> <-> <counterpart>] - [(def: #export (<name> [myL yourL] [myR yourR]) - {#.doc (doc (counterpart-doc (name-of <counterpart>)))} - (-> Session Session Session) - [(type (<+> myL myR)) (type (<-> yourL yourR))]) - - (def: #export <alias> - {#.doc (doc (counterpart-doc (name-of <counterpart>)))} - <name>)] - - [$join /\ Join Fork ..join] - [$fork \/ Fork Join ..fork] - ) - -(def: #export ($rec scope) - (-> (-> Session Session) - Session) - (case (type (All $recur [$_] - (:~ ($session (scope [(#.Apply $_ $recur) - (#.Apply $_ $recur)]))))) - (^multi (#.UnivQ _env $scope) - [(type.flatten-tuple $scope) - (^ (list mine yours))]) - [(#.Apply Any (#.UnivQ _env mine)) - (#.Apply Any (#.UnivQ _env yours))] - - _ - (undefined))) - -(def: #export (rec scope) - (All [session] - (-> (-> (Lazy session) - (Lazy session)) - (Lazy session))) - (lazy.freeze (lazy.thaw (scope (rec scope))))) |