diff options
| -rw-r--r-- | lux-mode/lux-mode.el | 2 | ||||
| -rw-r--r-- | 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 [<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.")} []) @@ -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 <read> <write>) (function (_ value) (exec (io.run (promise.resolve [value <read>] channel)) @@ -70,6 +101,32 @@ [(!write yours mine) channel]))) +(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] @@ -116,51 +173,6 @@ (exec (io.run (promise.resolve (#.Right myR) channel)) (promise.promise (#.Some (go yourR))))))])) -(do-template [<name> <side> <doc>] - [(def: #export (<name> session) - {#.doc (doc <doc>)} - (All [mine yours] (-> [mine yours] <side>)) - (let [[mine yours] session] - <side>))] - - [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 [<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] - ) - -(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 [<name> <alias> <+> <-> <counterpart>] [(def: #export (<name> [myL yourL] [myR yourR]) {#.doc (doc (counterpart-doc (name-of <counterpart>)))} @@ -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 [<name> <alias> <side> <counterpart>] - [(def: #export (<name> [mine yours]) - {#.doc (doc (counterpart-doc (name-of <counterpart>)))} - (-> Session Type) - <side>) - - (def: #export <alias> <name>)] - - [$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))))))) |