From 41a67eec16a69aeab52609ddd2facc7a433039e5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 15 Dec 2018 09:19:35 -0400 Subject: Removed sessions for the moment. They will be revisited in future work. --- stdlib/source/lux/concurrency/session.lux | 228 ------------------------------ 1 file changed, 228 deletions(-) delete mode 100644 stdlib/source/lux/concurrency/session.lux (limited to 'stdlib/source') 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)]]] - ["." 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 [ ] - [(def: #export ( [mine yours]) - {#.doc (code.text (format "'" "' side of the session."))} - (-> Session Type) - ) - - (def: #export )] - - [$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 - [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 - [value channel] - (wrap [value yours]))))]))) - -(do-template [ ] - [(def: #export ( value [mine yours]) - {#.doc (doc (counterpart-doc (name-of )))} - (-> Type Session Session) - [(type ( value mine)) (type ( value yours))]) - - (def: #export - {#.doc (doc )} - )] - - [$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 - [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 - [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 [ <+> <-> ] - [(def: #export ( [myL yourL] [myR yourR]) - {#.doc (doc (counterpart-doc (name-of )))} - (-> Session Session Session) - [(type (<+> myL myR)) (type (<-> yourL yourR))]) - - (def: #export - {#.doc (doc (counterpart-doc (name-of )))} - )] - - [$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))))) -- cgit v1.2.3