aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2018-12-09 19:40:17 -0400
committerEduardo Julian2018-12-09 19:40:17 -0400
commit09ace8e56f5a2015e6ce2a6396e89063816e0318 (patch)
tree87c1b95dbe4b3a04e6346a258d746f287b017549 /stdlib
parentb47835644a16f43155b44333c0218293bcaf20a6 (diff)
- Some refactoring.
- Eliminated "choice:" macro.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/concurrency/session.lux167
1 files changed, 72 insertions, 95 deletions
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)))))))