packages feed

AFSM 0.1.1.1 → 0.1.1.2

raw patch · 4 files changed

+77/−45 lines, 4 files

Files

AFSM.cabal view
@@ -1,5 +1,5 @@ name:                AFSM-version:             0.1.1.1+version:             0.1.1.2 synopsis:            Arrowized functional state machines description: Arrowized functional state machines.              This module is inspired by Yampa and the paper
README.md view
@@ -26,20 +26,21 @@  (&&&) :: SM a b -> SM a c -> SM a (b, c) -----           /--------\  b---      /--->| SM a b |>---\---    a |    \--------/    | (b,c)---  >---|                  |------->---      |    /--------\  c |---      \--->| SM a c |>---/---           \--------/     +--            /--------\  b+--       /--->| SM a b |>---\+--    a  |    \--------/    |  (b,c)+--  >--->|                  |>------->+--       |    /--------\  c |+--       \--->| SM a c |>---/+--            \--------/       exec :: SM a b -> [a] -> (SM a b, [b]) ```-From the theoretical perspective, this model is a simplified version of FRP, but adding states on functions directly. In another word, it is switching the focus from time to states. -From the engineering perspective, the other difference from AFRP(Yampa) is that we provide the constructor to use the transition function ```trans :: s -> a -> (SM a b, b)``` to build ```SM a b``` directly. +From a theoretical point of view, this model is a simplified version of FRP, but adding states on functions directly. In another word, it is switching the focus from time to states. +From an engnieering point of view, the other difference from AFRP(Yampa) is that we provide the constructor to use the transition function ```trans :: s -> a -> (SM a b, b)``` to build ```SM a b``` directly. + ### Simplifed model  In functional reactive programming(FRP), the key concepts are the signal, ```Signal a :: Time -> a```, and the signal function from signal to signal, ```SF a b :: Signal a -> Signal b```.@@ -60,6 +61,13 @@  The key idea is using the GADTs extension to hide the state(storage) type. If we do not use the GADTs extension, then ```SM a b``` will become ```SM s a b``` where ```s``` denotes the state(storage) type. +## Examples++### Reverse Polish notation(RPN.hs)++It is also known as postfix notation, and it is very straightforward example. The input is the infix expression, and the output is the value. First, we build a SM named in2post to convert infix notation to postfix expression. Then we build a SM named post2ret to evaluate the valus. Finally, we use them to compose ```in2ret = in2post >>> post2ret```.++ ## To-Do   * Basic state machines   * Event@@ -74,5 +82,5 @@  [Haskell/Arrow tutorial](https://en.wikibooks.org/wiki/Haskell/Arrow_tutorial) -  * Just realize that both AFRP and our model is very similar with ```Circuit```. Actually, FRP is simulating signal systems, also it's why I prefer to use the name ```signal function``` instead of ```behaivor function```. On other hand, AFRP is AFSM with fix storage type ```DTime```, and the benefit is that it does not require the GADTs extension.+  * Just realize that both AFRP and our model are very similar with ```Circuit```. Actually, FRP is simulating signal systems, also it's why I prefer to use the name ```signal function``` instead of ```behavior function```. On the other hand, AFRP is AFSM with fix storage type ```DTime```, and the benefit is that it does not require the GADTs extension.
examples/RPN.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE Arrows #-}
 
+-----------------------------------------------------------------------------
+-- A simple calculator
+-----------------------------------------------------------------------------
+
 module Main where
 
 import Control.AFSM
@@ -141,7 +145,7 @@   if elem x ",\n" then End : (parseStr xs)
   else if x == ' ' then parseStr xs
   else if isNum x then
-    let (ys, zs) = span isNum xs in (Num $ read (x:ys)):(parseStr xs)
+    let (ys, zs) = span isNum xs in (Num $ read (x:ys)):(parseStr zs)
   else if elem x "()+-*/" then
     (parseOp x):(parseStr xs)
   else
src/Control/AFSM.hs view
@@ -3,7 +3,7 @@ -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.AFSM
--- Copyright   :  (c) Hanzhong Xu 2016,
+-- Copyright   :  (c) Hanzhong Xu, Meng Meng 2016,
 -- License     :  MIT License
 --
 -- Maintainer  :  hanzh.xu@gmail.com
@@ -20,6 +20,8 @@ module Control.AFSM (
   module Control.Arrow,
   
+  Event(..),
+  
   -- * The 'SM' type
   SM,
   
@@ -30,6 +32,9 @@   newSM,
   simpleSM,
   
+  -- * Basic State Machines
+  constSM,
+  
   -- * High order functions
   execSM,
   
@@ -41,22 +46,35 @@ import Control.Category
 import Control.Arrow
 
-type SMState r a b = (r -> a -> (SM a b, b))
+import Control.AFSM.Event
 
+
+type SMState s a b = (s -> a -> (SM a b, b))
+
 -- | 'SM' is a type representing a state machine.
 data SM a b where 
-  SM :: r -> (SMState r a b) -> SM a b
+  SM :: s -> (SMState s a b) -> SM a b
   
 -- Constructors
 
-newSM :: r -> (SMState r a b) -> SM a b
+-- | newSM is the same with SM constructor.
+newSM :: s -> (SMState s a b) -> SM a b
 newSM = SM
 
-simpleSM :: r -> (r -> a -> (r, b)) -> SM a b
-simpleSM r f = SM r f'
+-- | simpleSM is to build a simple SM which have only one SMState.
+simpleSM :: s -> (s -> a -> (s, b)) -> SM a b
+simpleSM s f = SM s f'
   where
-    f' = (\r' a' -> let (r'', b) = f r' a' in (SM r'' f', b))
+    f' = (\s' a' -> let (s'', b) = f s' a' in (SM s'' f', b))
+    
+-- Basic State Machines
 
+-- | constSM build a SM which always return b
+constSM :: b -> SM a b
+constSM b = SM () f
+  where
+    f _ a = ((constSM b), b)
+
 -- Category instance    
 
 instance Category SM where
@@ -69,10 +87,10 @@ composeSM :: SM b c -> SM a b -> SM a c
 composeSM sm1 sm0 = SM (sm0,sm1) f2
   where
-    f2 ((SM r0 f0),(SM r1 f1)) a = (SM (sm0', sm1') f2, c)
+    f2 ((SM s0 f0),(SM s1 f1)) a = (SM (sm0', sm1') f2, c)
       where
-        (sm0', b) = f0 r0 a
-        (sm1', c) = f1 r1 b
+        (sm0', b) = f0 s0 a
+        (sm1', c) = f1 s1 b
 
         
 -- Arrow instance
@@ -91,32 +109,32 @@ firstSM :: SM a b -> SM (a, c) (b, c)
 firstSM sm = SM sm f1
   where
-    f1 (SM r f) (a,c) = ((SM sm' f1), (b, c))
+    f1 (SM s f) (a,c) = ((SM sm' f1), (b, c))
       where
-        (sm', b) = f r a
+        (sm', b) = f s a
         
 secondSM :: SM a b -> SM (c, a) (c, b)
 secondSM sm = SM sm f1
   where
-    f1 (SM r f) (c,a) = ((SM sm' f1), (c, b))
+    f1 (SM s f) (c,a) = ((SM sm' f1), (c, b))
       where
-        (sm', b) = f r a
+        (sm', b) = f s a
 
 productSM :: SM a b -> SM c d -> SM (a, c) (b, d)
 productSM sm0 sm1 = SM (sm0, sm1) f2
   where
-    f2 ((SM r0 f0),(SM r1 f1)) (a, c) = (SM (sm0', sm1') f2, (b, d))
+    f2 ((SM s0 f0),(SM s1 f1)) (a, c) = (SM (sm0', sm1') f2, (b, d))
       where
-        (sm0', b) = f0 r0 a
-        (sm1', d) = f1 r1 c
+        (sm0', b) = f0 s0 a
+        (sm1', d) = f1 s1 c
 
 fanoutSM :: SM a b -> SM a c -> SM a (b, c)
 fanoutSM sm0 sm1 = SM (sm0, sm1) f2
   where
-    f2 ((SM r0 f0),(SM r1 f1)) a = (SM (sm0', sm1') f2, (b, c))
+    f2 ((SM s0 f0),(SM s1 f1)) a = (SM (sm0', sm1') f2, (b, c))
       where
-        (sm0', b) = f0 r0 a
-        (sm1', c) = f1 r1 a
+        (sm0', b) = f0 s0 a
+        (sm1', c) = f1 s1 a
 
 -- ArrowChoice 
 
@@ -124,29 +142,29 @@ leftSM sm = SM sm f1
   where
     f1 sm' (Right c) = (SM sm' f1, Right c)
-    f1 (SM r0 f0) (Left a) = (SM sm'' f1, Left b)
+    f1 (SM s0 f0) (Left a) = (SM sm'' f1, Left b)
       where
-        (sm'', b) = f0 r0 a
+        (sm'', b) = f0 s0 a
 
 rightSM :: SM a b -> SM (Either c a) (Either c b)
 rightSM sm = SM sm f1
   where
     f1 sm' (Left c) = (SM sm' f1, Left c)
-    f1 (SM r f) (Right a) = ((SM sm'' f1), Right b)
+    f1 (SM s f) (Right a) = ((SM sm'' f1), Right b)
       where
-        (sm'', b) = f r a
+        (sm'', b) = f s a
         
 sumSM :: SM a b -> SM c d -> SM (Either a c) (Either b d)
 sumSM sm0 sm1 = SM (sm0, sm1) f2
   where
-    f2 (SM r0 f0, sm1') (Left a)  = let (sm0', b) = f0 r0 a in (SM (sm0', sm1') f2, Left b)
-    f2 (sm0', SM r1 f1) (Right c) = let (sm1', d) = f1 r1 c in (SM (sm0', sm1') f2, Right d)
+    f2 (SM s0 f0, sm1') (Left a)  = let (sm0', b) = f0 s0 a in (SM (sm0', sm1') f2, Left b)
+    f2 (sm0', SM s1 f1) (Right c) = let (sm1', d) = f1 s1 c in (SM (sm0', sm1') f2, Right d)
 
 faninSM :: SM a c -> SM b c -> SM (Either a b) c
 faninSM sm0 sm1 = SM (sm0, sm1) f2
   where
-    f2 (SM r0 f0, sm1') (Left a)  = let (sm0', c) = f0 r0 a in (SM (sm0', sm1') f2, c)
-    f2 (sm0', SM r1 f1) (Right b) = let (sm1', c) = f1 r1 b in (SM (sm0', sm1') f2, c)
+    f2 (SM s0 f0, sm1') (Left a)  = let (sm0', c) = f0 s0 a in (SM (sm0', sm1') f2, c)
+    f2 (sm0', SM s1 f1) (Right b) = let (sm1', c) = f1 s1 b in (SM (sm0', sm1') f2, c)
 
 instance ArrowChoice SM where
   left = leftSM
@@ -160,23 +178,25 @@ loopSM :: SM (a, c) (b, c) -> SM a b
 loopSM sm = SM sm f1
   where
-    f1 (SM r f) a = (SM sm' f1, b)
+    f1 (SM s f) a = (SM sm' f1, b)
       where
-        (sm', (b, c)) = f r (a, c)
+        (sm', (b, c)) = f s (a, c)
 
 instance ArrowLoop SM where
     loop = loopSM
         
 -- Evaluation
 
+-- | execute SM a b with input [a].
 exec :: SM a b -> [a] -> (SM a b, [b])
 exec sm [] = (sm, [])
-exec (SM r f) (x:xs) = (sm'', b:bs)
+exec (SM s f) (x:xs) = (sm'', b:bs)
   where 
-    (sm', b) = f r x
+    (sm', b) = f s x
     (sm'', bs) = (exec sm' xs)
     
 -- High order functions
-    
+ 
+-- | execSM converts SM a b -> SM [a] [b], it is very useful to compose SM a [b] and SM b c to SM a [c].
 execSM :: SM a b -> SM [a] [b]
 execSM sm = simpleSM sm exec