Working session recursion.

1 files changed, 94 insertions, 44 deletions

diff --git a/stdlib/test/test/lux/concurrency/session.lux b/stdlib/test/test/lux/concurrency/session.lux
index ad0343d15..ea27bf4b9 100644
--- a/stdlib/test/test/lux/concurrency/session.lux
+++ b/stdlib/test/test/lux/concurrency/session.lux
@@ -2,9 +2,12 @@
   [lux #*
    [control
     [monad (#+ do)]]
+   [data
+    ["." lazy (#+ Lazy)]]
+   ["." io (#+ IO)]
    [concurrency
     ["." promise]
-    ["$" session (#+ Session choice: << >> ?? !! +<< -<< \/ /\)]]
+    ["$" session (#+ Session << >> ?? !! +<< -<< \/ /\ $rec)]]
    [data
     [text
      format]]
@@ -12,67 +15,114 @@
     ["r" random]]]
   lux/test)
 
-(choice: Calculation [#Add #Negate])
+(def: $transfer (<| << (!! Int) >>))
 
-(def: $add (<| (!! Int) (!! Int) (?? Int) >>))
-(def: $negate (<| (!! Int) (?? Int) >>))
+(def: transfer
+  (Lazy (:~ $transfer))
+  (<| $.send $.end))
 
-(def: (add-session _)
-  (-> [] (:~ (<< $add)))
-  (<| $.send $.send $.receive $.end))
+(context: "Transfer."
+  (do @
+    [#let [[$me $you] (lazy.thaw ..transfer)]
+     expectation r.int]
+    ($_ seq
+        (wrap (do promise.Monad<Promise>
+                [$me ($me expectation)]
+                (assert "Client [Transfer]"
+                        true)))
+        (wrap (do promise.Monad<Promise>
+                [[actual $end] ($you [])]
+                (assert "Server [Transfer]"
+                        (i/= expectation actual))))
+        )))
 
-(def: (negate-session _)
-  (-> [] (:~ (<< $negate)))
-  (<| $.send $.receive $.end))
+(def: $endless
+  (<< ($rec (function (_ $recur)
+              (<| (!! Int) $recur)))))
 
-(def: $calculation
-  Session
-  ($_ \/
-      $add
-      $negate))
+(def: endless
+  (Lazy (:~ $endless))
+  ($.rec (function (_ recur)
+           (<| $.send recur))))
 
-(def: (calculation-session _)
-  (-> [] (:~ (<< $calculation)))
-  ($_ $.fork
-      (add-session [])
-      (negate-session [])))
+(context: "Endless."
+  (do @
+    [#let [[$me $you] (lazy.thaw ..endless)]
+     expectation0 r.int
+     expectation1 r.int
+     expectation2 r.int]
+    ($_ seq
+        (wrap (do promise.Monad<Promise>
+                [$me ($me expectation0)
+                 $me ($me expectation1)
+                 $me ($me expectation2)]
+                (assert "Client [Endless]"
+                        true)))
+        (wrap (do promise.Monad<Promise>
+                [[actual0 $you] ($you [])
+                 [actual1 $you] ($you [])
+                 [actual2 $you] ($you [])]
+                (assert "Server [Endless]"
+                        (and (i/= expectation0 actual0)
+                             (i/= expectation1 actual1)
+                             (i/= expectation2 actual2)))))
+        )))
 
-(def: (__my-calculation _)
-  (-> [] (:~ (+<< $calculation)))
-  ($.my (calculation-session [])))
+(def: $calculation
+  Session
+  ($rec
+   (function (_ $recur)
+     ($_ \/
+         (<| (!! Int) (!! Int) (?? Int) $recur)
+         (<| (!! Int) (?? Int) $recur)
+         >>))))
 
-(def: (__your-calculation _)
-  (-> [] (:~ (-<< $calculation)))
-  ($.your (calculation-session [])))
+(def: calculation
+  (Lazy (:~ (<< $calculation)))
+  ($.rec
+   (function (_ recur)
+     ($_ $.fork
+         (<| $.send $.send $.receive recur)
+         (<| $.send $.receive recur)
+         $.end))))
 
-(context: "Sessions."
+(context: "Complex session."
   (do @
-    [#let [[$me $you] (calculation-session [])]
+    [#let [[$me $you] (lazy.thaw calculation)]
      param r.int
-     subject r.int]
+     subject r.int
+     #let [expectation (i/+ param subject)]]
     ($_ seq
         (wrap (do promise.Monad<Promise>
-                [$me ($me (#Add id))
+                [$me ($me (#.Left id))
                  $me ($me param)
                  $me ($me subject)
-                 [output $end] $me]
+                 [output $end] ($me [])]
                 (assert "Client [#Add]"
-                        (i/= (i/+ param subject) output))))
+                        (i/= expectation output))))
         (wrap (do promise.Monad<Promise>
-                [choice $you]
-                (case choice
-                  (#Add $you)
+                [add|<negate|quit> ($you [])]
+                (case add|<negate|quit>
+                  (#.Left $add)
                   (do @
-                    [[param-input $you] $you
-                     [subject-input $you] $you
-                     $end ($you (i/+ param-input subject-input))]
+                    [[param-input $add] ($add [])
+                     [subject-input $add] ($add [])
+                     $recur ($add (i/+ param-input subject-input))]
                     (assert "Server [#Add]"
                             true))
-                  
-                  (#Negate $you)
+
+                  (#.Right $negate|quit)
                   (do @
-                    [[subject $you] $you
-                     $end ($you (i/* -1 subject))]
-                    (assert "Server [#Negate]"
-                            true)))))
+                    [negate|quit ($negate|quit [])]
+                    (case negate|quit
+                      (#.Left $negate)
+                      (do @
+                        [[subject $negate] ($negate [])
+                         $recur ($negate (i/* -1 subject))]
+                        (assert "Server [#Negate]"
+                                true))
+
+                      (#.Right $quit)
+                      (assert "Server [#Quit]"
+                              true))))))
         )))