aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/concurrency/session.lux228
-rw-r--r--stdlib/test/test/lux/concurrency/session.lux139
2 files changed, 0 insertions, 367 deletions
diff --git a/stdlib/source/lux/concurrency/session.lux b/stdlib/source/lux/concurrency/session.lux
deleted file mode 100644
index ac9f984d9..000000000
--- a/stdlib/source/lux/concurrency/session.lux
+++ /dev/null
@@ -1,228 +0,0 @@
-(.module:
- [lux #*
- [control
- ["." monad (#+ do)]
- ["p" parser]]
- [data
- ["." lazy (#+ Lazy)]
- [text
- format]
- [collection
- ["." list ("list/." Functor<List>)]]]
- ["." io]
- ["." type (#+ :share)]
- ["." macro
- ["." code]
- ["s" syntax (#+ syntax:)
- [common
- ["." reader]
- ["." writer]]]]]
- [//
- ["." promise (#+ Promise)]])
-
-(def: counterpart-doc
- (-> Name Code)
- (|>> %name (format "The session/type counterpart to ") code.text))
-
-## 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: #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> <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.")}
- [])
-
-(def: #export end
- {#.doc (doc "The last step in a session.")}
- (Lazy [End End])
- (lazy.freeze [[] []]))
-
-(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)))
-
-(def: #export (receive session)
- {#.doc (doc "A Read step for 'me', and a Write step for 'you'.")}
- (All [value mine yours]
- (-> (Lazy [mine yours])
- (Lazy [(Read value mine) (Write value yours)])))
- (lazy.freeze (let [channel (promise.promise #.None)]
- [(function (_ _)
- (let [[mine yours] (lazy.thaw session)]
- (do promise.Monad<Promise>
- [value channel]
- (wrap [value mine]))))
- (function (_ value)
- (let [[mine yours] (lazy.thaw session)]
- (exec (io.run (promise.resolve value channel))
- (promise.promise (#.Some yours)))))])))
-
-(def: #export (send session)
- {#.doc (doc "A Write step for 'me', and a Read step for 'you'.")}
- (All [value mine yours]
- (-> (Lazy [mine yours])
- (Lazy [(Write value mine) (Read value yours)])))
- (lazy.freeze (let [channel (promise.promise #.None)]
- [(function (_ value)
- (let [[mine yours] (lazy.thaw session)]
- (exec (io.run (promise.resolve value channel))
- (promise.promise (#.Some mine)))))
- (function (_ _)
- (let [[mine yours] (lazy.thaw session)]
- (do promise.Monad<Promise>
- [value channel]
- (wrap [value yours]))))])))
-
-(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]
- (-> (Lazy [myL yourL]) (Lazy [myR yourR])
- (Lazy [(Fork myL myR) (Join yourL yourR)])))
- (lazy.freeze (let [channel (: (Promise Bit)
- (promise.promise #.None))]
- [(function (_ signal)
- (let [[myL yourL] (lazy.thaw left)
- [myR yourR] (lazy.thaw right)]
- (case signal
- (#.Left go)
- (exec (io.run (promise.resolve #0 channel))
- (promise.promise (#.Some (go myL))))
-
- (#.Right go)
- (exec (io.run (promise.resolve #1 channel))
- (promise.promise (#.Some (go myR)))))))
- (function (_ _)
- (let [[myL yourL] (lazy.thaw left)
- [myR yourR] (lazy.thaw right)]
- (do promise.Monad<Promise>
- [choice channel]
- (wrap (case choice
- #0 (#.Left yourL)
- #1 (#.Right yourR))))))])))
-
-(def: #export (join left right)
- {#.doc (doc "A Join step for 'me', and a Fork step for 'you'.")}
- (All [myL yourL myR yourR]
- (-> (Lazy [myL yourL]) (Lazy [myR yourR])
- (Lazy [(Join myL myR) (Fork yourL yourR)])))
- (lazy.freeze (let [channel (: (Promise Bit)
- (promise.promise #.None))]
- [(function (_ _)
- (let [[myL yourL] (lazy.thaw left)
- [myR yourR] (lazy.thaw right)]
- (do promise.Monad<Promise>
- [choice channel]
- (wrap (case choice
- #0 (#.Left myL)
- #1 (#.Right myR))))))
- (function (_ signal)
- (let [[myL yourL] (lazy.thaw left)
- [myR yourR] (lazy.thaw right)]
- (case signal
- (#.Left go)
- (exec (io.run (promise.resolve #0 channel))
- (promise.promise (#.Some (go yourL))))
-
- (#.Right go)
- (exec (io.run (promise.resolve #1 channel))
- (promise.promise (#.Some (go yourR)))))))])))
-
-(do-template [<name> <alias> <+> <-> <counterpart>]
- [(def: #export (<name> [myL yourL] [myR yourR])
- {#.doc (doc (counterpart-doc (name-of <counterpart>)))}
- (-> Session Session Session)
- [(type (<+> myL myR)) (type (<-> yourL yourR))])
-
- (def: #export <alias>
- {#.doc (doc (counterpart-doc (name-of <counterpart>)))}
- <name>)]
-
- [$join /\ Join Fork ..join]
- [$fork \/ Fork Join ..fork]
- )
-
-(def: #export ($rec scope)
- (-> (-> Session Session)
- Session)
- (case (type (All $recur [$_]
- (:~ ($session (scope [(#.Apply $_ $recur)
- (#.Apply $_ $recur)])))))
- (^multi (#.UnivQ _env $scope)
- [(type.flatten-tuple $scope)
- (^ (list mine yours))])
- [(#.Apply Any (#.UnivQ _env mine))
- (#.Apply Any (#.UnivQ _env yours))]
-
- _
- (undefined)))
-
-(def: #export (rec scope)
- (All [session]
- (-> (-> (Lazy session)
- (Lazy session))
- (Lazy session)))
- (lazy.freeze (lazy.thaw (scope (rec scope)))))
diff --git a/stdlib/test/test/lux/concurrency/session.lux b/stdlib/test/test/lux/concurrency/session.lux
deleted file mode 100644
index ed538372c..000000000
--- a/stdlib/test/test/lux/concurrency/session.lux
+++ /dev/null
@@ -1,139 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do)]]
- [data
- ["." lazy (#+ Lazy)]]
- ["." io (#+ IO)]
- [concurrency
- ["." promise]
- ["$" session (#+ Session << >> ?? !! +<< -<< \/ /\ $rec)]]
- [data
- [text
- format]]
- [math
- ["r" random]]]
- lux/test)
-
-(def: $transfer (<| << (!! Int) >>))
-
-(def: transfer
- (IO (:~ $transfer))
- (io.io (lazy.thaw (<| $.send $.end))))
-
-(context: "Transfer."
- (do @
- [#let [[$me $you] (io.run ..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: $endless
- (<< ($rec (function (_ $recur)
- (<| (!! Int) $recur)))))
-
-(def: endless
- (IO (:~ $endless))
- (io.io (lazy.thaw ($.rec (function (_ recur)
- (<| $.send recur))))))
-
-(context: "Endless."
- (do @
- [#let [[$me $you] (io.run ..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: $calculation
- Session
- ($rec
- (function (_ $recur)
- ($_ \/
- (<| (!! Int) (!! Int) (?? Int) $recur)
- (<| (!! Int) (?? Int) $recur)
- >>))))
-
-(def: calculation
- (IO (:~ (<< $calculation)))
- (io.io (lazy.thaw ($.rec
- (function (_ recur)
- ($_ $.fork
- (<| $.send $.send $.receive recur)
- (<| $.send $.receive recur)
- $.end))))))
-
-(def: negate (i/* -1))
-
-(context: "Complex session."
- (do @
- [#let [[$me $you] (io.run calculation)]
- param r.int
- subject r.int
- #let [expectation (i/+ param subject)]]
- ($_ seq
- (wrap (do promise.Monad<Promise>
- [## Add
- $me ($me (#.Left id))
- $me ($me param)
- $me ($me subject)
- [output $me] ($me [])
- ## Negate
- $me ($me (#.Right id))
- $me ($me (#.Left id))
- $me ($me output)
- [-output $me] ($me [])
- ## Quit
- $me ($me (#.Right id))
- $me ($me (#.Right id))]
- (assert "Client [Add & Negate & Quit]"
- (and (i/= expectation output)
- (i/= (..negate expectation) -output)))))
- (wrap (loop [$add|<negate|quit> $you]
- (do promise.Monad<Promise>
- [add|<negate|quit> ($add|<negate|quit> [])]
- (case add|<negate|quit>
- (#.Left $add)
- (do @
- [[param-input $add] ($add [])
- [subject-input $add] ($add [])
- $recur ($add (i/+ param-input subject-input))]
- (recur $recur))
-
- (#.Right $negate|quit)
- (do @
- [negate|quit ($negate|quit [])]
- (case negate|quit
- (#.Left $negate)
- (do @
- [[subject $negate] ($negate [])
- $recur ($negate (..negate subject))]
- (recur $recur))
-
- (#.Right $quit)
- (assert "Server [Quit]"
- true)))))))
- )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 08:46:06 +0000