Process.hs

{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- Copyright 2015, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- Processes support choices and sequences and are modelled after Hoare's CSP
-- calculus.
--
-----------------------------------------------------------------------------
--  $Id: Process.hs 8758 2015-10-22 06:48:52Z bastiaan $

module Ideas.Common.Strategy.Process
   ( Process, eqProcessBy, menu, withMenu
   , fold, runProcess
   ) where

import Ideas.Common.Classes
import Ideas.Common.Strategy.Choice
import Ideas.Common.Strategy.Sequence

------------------------------------------------------------------------
-- Process data type

-- | Process data type with efficient support for sequences
newtype Process a = P [Menu a (Process a)]

instance Eq a => Eq (Process a) where
   (==) = eqProcessBy (==)

instance Functor Process where
   fmap f = rec
    where
      rec (P xs) = P (map g xs)
      g = onMenu (\a q -> f a |-> rec q) doneMenu

instance Choice (Process a) where
   empty   = P [empty]
   x .|. y = P [menu x .|. menu y]
   x ./. y = P [menu x ./. menu y]
   x |>  y = P [menu x |>  menu y]

instance Sequence (Process a) where
   type Sym (Process a) = a

   done = P []
   a ~> b = P [a |-> b]
   P xs .*. P ys = P (xs ++ ys)
   sequence ps = P [ x | P xs <- ps, x <- xs ]

instance Fix (Process a)

instance Firsts (Process a) where
   type Elem (Process a) = a

   firsts = bests . menu
   ready  = hasDone . menu

runProcess :: Apply f => Process (f a) -> a -> [a]
runProcess p a = withMenu op [a] p
 where
   op f x = [ c | b <- applyAll f a, c <- runProcess x b ]

menu :: Process a -> Menu a (Process a)
menu (P zs) = rec zs
 where
   rec []     = doneMenu
   rec [x]    = x
   rec (x:xs) = onMenu (\a (P ys) -> a |-> P (ys ++ xs)) (rec xs) x

withMenu :: Choice b => (a -> Process a -> b) -> b -> Process a -> b
withMenu op e (P zs) = rec zs
 where
   rec []     = e
   rec [x]    = onMenu op e x
   rec (x:xs) = onMenu (\a (P ys) -> op a (P (ys ++ xs))) (rec xs) x

-- | Generalized equality of processes, which takes an equality function for
-- the symbols.
eqProcessBy :: (a -> a -> Bool) -> Process a -> Process a -> Bool
eqProcessBy eq = rec
 where
   rec p q = eqMenuBy eq rec (menu p) (menu q)

fold :: Choice b => (a -> b -> b) -> b -> Process a -> b
fold op e = rec
 where
   rec = withMenu (\a -> op a . rec) e