Migrated source code from Simantics SVN

[simantics/platform.git] / bundles / org.simantics.simulation.sequences / scl / Simantics / Sequences.scl

diff --git a/bundles/org.simantics.simulation.sequences/scl/Simantics/Sequences.scl b/bundles/org.simantics.simulation.sequences/scl/Simantics/Sequences.scl
new file mode 100644 (file)
index 0000000..3960b96
--- /dev/null
+++ b/bundles/org.simantics.simulation.sequences/scl/Simantics/Sequences.scl
@@ -0,0 +1,106 @@
+\r
+/// Actions ///////////////////////////////////////////////////////////////////\r
+\r
+effect Action \r
+    "sequenceAction"\r
+    "org.simantics.simulation.sequences.action.ActionContext"\r
+\r
+importJava "org.simantics.simulation.sequences.action.ActionContext" where\r
+    data ActionContext\r
+    \r
+    @JavaName stop\r
+    stopActionContext :: ActionContext -> <Proc> ()\r
+\r
+    """Gives the current simulation time."""\r
+    time :: <Action> Double\r
+    @JavaName get\r
+    getVar_  :: String -> Binding a -> <Action> a\r
+    @JavaName set\r
+    setVar_  :: String -> a -> Binding a -> <Action> ()\r
+    \r
+    scheduleNow :: (() -> <Action,Proc> a) -> <Action> ()\r
+    scheduleNextStep :: (() -> <Action,Proc> a) -> <Action> ()\r
+    scheduleAt :: Double -> (() -> <Action,Proc> a) -> <Action> ()\r
+    @JavaName stop\r
+    stop_ :: <Action> ()\r
+\r
+"""Returns the current value of a variable"""\r
+getVar :: Serializable a => String -> <Action> a\r
+getVar variableName = getVar_ variableName binding\r
+\r
+"""Sets the value of a variable"""\r
+setVar :: Serializable a => String -> a -> <Action> ()\r
+setVar variableName value = setVar_ variableName value binding\r
+\r
+/// Sequences /////////////////////////////////////////////////////////////////\r
+\r
+"""\r
+`Sequence a` is a plan of some operations that may happen during the simulation and may take some\r
+(simulation) time. A sequence is initiated at a specific time and it may either finish at a specific\r
+time or operate forever. If it completes, it retuns a value of type `a`.\r
+"""\r
+data Sequence a = Sequence ( (a -> <Action,Proc> ()) -> <Action,Proc> () )\r
+\r
+@private\r
+@inline\r
+execSequence (Sequence f) cont = f cont\r
+\r
+instance Functor Sequence where\r
+    @inline\r
+    fmap f seq = Sequence (\cont -> execSequence seq (cont . f))\r
+\r
+instance Monad Sequence where\r
+    @inline\r
+    return v = Sequence (\cont -> cont v)\r
+    @inline\r
+    seq >>= f = Sequence (\cont -> execSequence seq (\result -> execSequence (f result) cont)) \r
+\r
+"""\r
+The sequence `execute action` is an instantious sequence that executes the operation `action` in the simulator.\r
+"""\r
+@inline\r
+execute :: (<Action,Proc> a) -> Sequence a\r
+execute action = Sequence (\cont -> cont action)\r
+\r
+"""\r
+The sequence `fork seq` is an instantious sequence that creates a new sequence thread behaving like the sequence `seq`.\r
+"""\r
+fork :: Sequence a -> Sequence ()\r
+fork seq = Sequence (\cont -> do { scheduleNow cont ; execSequence seq ignore })\r
+\r
+"""\r
+The sequence `halt` ends the current sequence thread and the sequence .\r
+"""\r
+halt :: Sequence a\r
+halt = Sequence (\cont -> ())\r
+\r
+"""\r
+The sequence `stop` stops all sequence threads, stopping the simulation completely.\r
+"""\r
+stop :: Sequence a\r
+stop = Sequence (\cont -> stop_)\r
+\r
+"""\r
+The sequence `waitStep` waits that the simulator takes one simulation step.\r
+It is a primitive mechanism that can be used to implement other events by\r
+inspecting the simulator state after each time step.\r
+"""\r
+waitStep :: Sequence ()\r
+waitStep = Sequence (\cont -> scheduleNextStep cont)\r
+\r
+"""The sequence `waitUntil time` waits until the simulation time is at least the given `time`."""\r
+waitUntil :: Double -> Sequence ()\r
+waitUntil t = Sequence (\cont -> scheduleAt t cont)\r
+\r
+"""The sequence `wait duration` waits that `duration` seconds elapses from the current simulation time."""\r
+wait :: Double -> Sequence ()\r
+wait duration = Sequence (\cont -> scheduleAt (time+duration) cont)\r
+\r
+"""The sequence `waitCondition condition` waits until the `condition` is satisfied."""\r
+waitCondition :: (<Action,Proc> Boolean) -> Sequence ()\r
+waitCondition condition = Sequence (\cont ->\r
+    let loop _ = if condition\r
+                 then cont ()\r
+                 else scheduleNextStep loop \r
+    in  loop ())\r
+\r