From 09ace8e56f5a2015e6ce2a6396e89063816e0318 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 9 Dec 2018 19:40:17 -0400 Subject: - Some refactoring. - Eliminated "choice:" macro. --- lux-mode/lux-mode.el | 2 +- stdlib/source/lux/concurrency/session.lux | 167 +++++++++++++----------------- 2 files changed, 73 insertions(+), 96 deletions(-) diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 1f2805a30..45fbb75ec 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -295,7 +295,7 @@ Called by `imenu--generic-function'." function-application ;;;;;;;;;;;;;;;;;;;;;;;; "\\.module:" - "def:" "type:" "program:" "context:" "choice:" + "def:" "type:" "program:" "context:" "macro:" "syntax:" "with-expansions" "exception:" diff --git a/stdlib/source/lux/concurrency/session.lux b/stdlib/source/lux/concurrency/session.lux index 9214860ca..d4f1d6591 100644 --- a/stdlib/source/lux/concurrency/session.lux +++ b/stdlib/source/lux/concurrency/session.lux @@ -19,25 +19,38 @@ [// ["." promise (#+ Promise)]]) -(type: #export (Read value next) - {#.doc (doc "A reading step.")} - (Promise [value next])) +(def: counterpart-doc + (-> Name Code) + (|>> %name (format "The session/type counterpart to ") code.text)) -(type: #export (Write value next) - {#.doc (doc "A writing step.")} - (-> value (Promise next))) +## Session +(type: #export Session + {#.doc (doc "A pair of types, for 'me' and 'you'." + "They describe each side in a session protocol.")} + [Type Type]) -(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)))) +(def: #export ($session [mine yours]) + {#.doc (doc "Create an actual type from a session.")} + (-> Session Type) + (type [mine yours])) -(type: #export (Join left right) - {#.doc (doc "A joining step, which communicates which path was taken.")} - (Promise (| left right))) +(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.")} []) @@ -47,6 +60,24 @@ [End End] [[] []]) +(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))) + (template: (!write ) (function (_ value) (exec (io.run (promise.resolve [value ] channel)) @@ -70,6 +101,32 @@ [(!write yours mine) channel]))) +(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] @@ -116,51 +173,6 @@ (exec (io.run (promise.resolve (#.Right myR) channel)) (promise.promise (#.Some (go yourR))))))])) -(do-template [ ] - [(def: #export ( session) - {#.doc (doc )} - (All [mine yours] (-> [mine yours] )) - (let [[mine yours] session] - ))] - - [my mine - "'My' side of the session."] - [your yours - "'Your' side of the 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: counterpart-doc - (-> Name Code) - (|>> %name (format "The session/type counterpart to ") code.text)) - -(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] - ) - -(def: #export $end - {#.doc (doc (counterpart-doc (name-of ..end)))} - Session - [End End]) - -(def: #export >> - {#.doc (doc (counterpart-doc (name-of ..end)))} - $end) - (do-template [ <+> <-> ] [(def: #export ( [myL yourL] [myR yourR]) {#.doc (doc (counterpart-doc (name-of )))} @@ -174,38 +186,3 @@ [$join /\ Join Fork ..join] [$fork \/ Fork Join ..fork] ) - -(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 (doc (counterpart-doc (name-of )))} - (-> Session Type) - ) - - (def: #export )] - - [$my +<< mine ..my] - [$your -<< yours ..your] - ) - -(syntax: #export (choice: {export reader.export} - {name s.local-identifier} - {tags (s.tuple (p.many s.local-tag))}) - {#.doc (doc "Defines tags to be used for fork/join branching in sessions.")} - (do @ - [g!vars (monad.map @ macro.gensym - (list.repeat (list.size tags) "var")) - #let [cases (list/map (function (_ [tag g!var]) - (` ((~ (code.local-tag tag)) (~ g!var)))) - (list.zip2 tags g!vars))]] - (wrap (list (` (type: (~+ (writer.export export)) ((~ (code.local-identifier name)) - (~+ g!vars)) - (~+ cases))))))) -- cgit v1.2.3