- Some refactoring.

- Eliminated "choice:" macro.

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)))))))