AFSM (empty) → 0.1.0.0

raw patch · 4 files changed

+231/−0 lines, 4 filesdep +basesetup-changed

Dependencies added: base

Files

AFSM.cabal +76/−0
LICENSE +20/−0
Setup.hs +2/−0
src/Control/AFSM.hs +133/−0

+ AFSM.cabal view

@@ -0,0 +1,76 @@+-- Initial AFSM.cabal generated by cabal init.  For further documentation, +-- see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                AFSM++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            Arrowized functional state machines++-- A longer description of the package.+description: Arrowized functional state machines.+             This module is inspired by Yampa and the paper +             /Functional Reactive Programming, Continued*/ written by+             Henrik Nilsson, Antony Courtney and John Peterson.        ++-- URL for the project homepage or repository.+homepage:            https://github.com/FiveEye/AFSM++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Hanzhong Xu++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          hanzh.xu@gmail.com++-- A copyright notice.+-- copyright:           ++category:            FRP++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+-- extra-source-files:  +--   examples/RPN.hs+-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10+++library+  -- Modules exported by the library.+  exposed-modules:     Control.AFSM+  +  -- Modules included in this library but not exported.+  -- other-modules:       +  +  -- LANGUAGE extensions used by modules in this package.+  other-extensions:    Arrows, GADTs+  +  -- Other library packages from which modules are imported.+  build-depends:       base >=4.7 && <4.8+  +  -- Directories containing source files.+  hs-source-dirs:      src+  +  -- Base language which the package is written in.+  default-language:    Haskell2010+  +source-repository head+  type: git+  location: git@github.com:FiveEye/AFSM.git

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2016 Hanzhong Xu++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ src/Control/AFSM.hs view

@@ -0,0 +1,133 @@+{-# LANGUAGE GADTs #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  
+-- Copyright   :  (c) Hanzhong Xu 2016,
+-- License     :  MIT License
+--
+-- Maintainer  :  hanzh.xu@gmail.com
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Arrowized functional state machines.
+--
+--   This module is inspired by Yampa and the paper 
+--   /Functional Reactive Programming, Continued*/ written by
+--     Henrik Nilsson, Antony Courtney and John Peterson.
+-----------------------------------------------------------------------------
+
+module Control.AFSM (
+  module Control.Arrow,
+  
+  -- * The 'SM' type
+  SM,
+  
+  -- * The 'SMState' type
+  SMState,
+  
+  -- * Constructors
+  newSM,
+  simpleSM,
+  
+  -- * High order functions
+  execSM,
+  
+  -- * Evaluation
+  exec
+  
+) where
+
+import Control.Category
+import Control.Arrow
+
+type SMState r a b = (r -> 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
+  
+-- Constructors
+
+newSM :: r -> (SMState r a b) -> SM a b
+newSM = SM
+
+simpleSM :: r -> (r -> a -> (r, b)) -> SM a b
+simpleSM r f = SM r f'
+  where
+    f' = (\r' a' -> let (r'', b) = f r' a' in (SM r'' f', b))
+
+-- Category instance    
+
+instance Category SM where
+  id  = idSM
+  (.) = composeSM
+  
+idSM :: SM a a
+idSM = SM () (\_ a -> (idSM, a))
+  
+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)
+      where
+        (sm0', b) = f0 r0 a
+        (sm1', c) = f1 r1 b
+
+        
+-- Arrow instance
+  
+instance Arrow SM where
+  arr = arrSM
+  first = firstSM
+  second = secondSM
+  (***) = productSM
+  (&&&) = fanoutSM
+
+arrSM :: (a -> b) -> SM a b
+arrSM f =
+  SM () (\_ a ->(arrSM f, f a))
+          
+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))
+      where
+        (sm', b) = f r 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))
+      where
+        (sm', b) = f r 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))
+      where
+        (sm0', b) = f0 r0 a
+        (sm1', d) = f1 r1 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))
+      where
+        (sm0', b) = f0 r0 a
+        (sm1', c) = f1 r1 a
+
+-- Evaluation
+
+exec :: SM a b -> [a] -> (SM a b, [b])
+exec sm [] = (sm, [])
+exec (SM r f) (x:xs) = (sm'', b:bs)
+  where 
+    (sm', b) = f r x
+    (sm'', bs) = (exec sm' xs)
+    
+-- High order functions
+    
+execSM :: SM a b -> SM [a] [b]
+execSM sm = simpleSM sm exec