-- |
-- Module      : OAlg.Data.Reducible
-- Description : reducible data
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- reducing values to there canonical value.
module OAlg.Data.Reducible
  (
    -- * Reducible
    Reducible(..), reduceWith, (>>>=), Rdc, RdcState(..), reducesTo

  )
  where 

import OAlg.Control.Action

--------------------------------------------------------------------------------
-- Reducible -

-- | types admitting reducible values.
--
-- __Definition__ @'reduce' e@ is called the __/algebraic value/__ of @e@.
--
-- Reducing an @e@ twice yield the \'same\' value and the idea is that in an algebraic calculation
-- it will be \'safe\' to substitute any occurrence of @e@ by its reduced value, i.e. both calculations
-- will yield the same result.
--
-- __Property__ Let @__e__@ be a reducible type admitting equality, then
-- for all @e@ in @__e__@ holds: @'reduce' ('reduce' e) == 'reduce' e@.
class Reducible e where

  -- | reducing @e@ to its algebraic value. 
  --
  --   __Note__ The default implementation is @'reduce' = 'id'@.
  reduce :: e -> e
  reduce = e -> e
forall a. a -> a
id

--------------------------------------------------------------------------------
-- Rdc -

-- | 'Action' according to the state type 'RdcState'.
type Rdc = Action RdcState

-- | reduction state.
data RdcState
  = Unchanged  -- ^ no reduction has been applied.
  | Changed -- ^ a reduction has been applied.
  deriving (Int -> RdcState -> ShowS
[RdcState] -> ShowS
RdcState -> String
(Int -> RdcState -> ShowS)
-> (RdcState -> String) -> ([RdcState] -> ShowS) -> Show RdcState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RdcState -> ShowS
showsPrec :: Int -> RdcState -> ShowS
$cshow :: RdcState -> String
show :: RdcState -> String
$cshowList :: [RdcState] -> ShowS
showList :: [RdcState] -> ShowS
Show,ReadPrec [RdcState]
ReadPrec RdcState
Int -> ReadS RdcState
ReadS [RdcState]
(Int -> ReadS RdcState)
-> ReadS [RdcState]
-> ReadPrec RdcState
-> ReadPrec [RdcState]
-> Read RdcState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RdcState
readsPrec :: Int -> ReadS RdcState
$creadList :: ReadS [RdcState]
readList :: ReadS [RdcState]
$creadPrec :: ReadPrec RdcState
readPrec :: ReadPrec RdcState
$creadListPrec :: ReadPrec [RdcState]
readListPrec :: ReadPrec [RdcState]
Read,RdcState -> RdcState -> Bool
(RdcState -> RdcState -> Bool)
-> (RdcState -> RdcState -> Bool) -> Eq RdcState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RdcState -> RdcState -> Bool
== :: RdcState -> RdcState -> Bool
$c/= :: RdcState -> RdcState -> Bool
/= :: RdcState -> RdcState -> Bool
Eq,Eq RdcState
Eq RdcState =>
(RdcState -> RdcState -> Ordering)
-> (RdcState -> RdcState -> Bool)
-> (RdcState -> RdcState -> Bool)
-> (RdcState -> RdcState -> Bool)
-> (RdcState -> RdcState -> Bool)
-> (RdcState -> RdcState -> RdcState)
-> (RdcState -> RdcState -> RdcState)
-> Ord RdcState
RdcState -> RdcState -> Bool
RdcState -> RdcState -> Ordering
RdcState -> RdcState -> RdcState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RdcState -> RdcState -> Ordering
compare :: RdcState -> RdcState -> Ordering
$c< :: RdcState -> RdcState -> Bool
< :: RdcState -> RdcState -> Bool
$c<= :: RdcState -> RdcState -> Bool
<= :: RdcState -> RdcState -> Bool
$c> :: RdcState -> RdcState -> Bool
> :: RdcState -> RdcState -> Bool
$c>= :: RdcState -> RdcState -> Bool
>= :: RdcState -> RdcState -> Bool
$cmax :: RdcState -> RdcState -> RdcState
max :: RdcState -> RdcState -> RdcState
$cmin :: RdcState -> RdcState -> RdcState
min :: RdcState -> RdcState -> RdcState
Ord,Int -> RdcState
RdcState -> Int
RdcState -> [RdcState]
RdcState -> RdcState
RdcState -> RdcState -> [RdcState]
RdcState -> RdcState -> RdcState -> [RdcState]
(RdcState -> RdcState)
-> (RdcState -> RdcState)
-> (Int -> RdcState)
-> (RdcState -> Int)
-> (RdcState -> [RdcState])
-> (RdcState -> RdcState -> [RdcState])
-> (RdcState -> RdcState -> [RdcState])
-> (RdcState -> RdcState -> RdcState -> [RdcState])
-> Enum RdcState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RdcState -> RdcState
succ :: RdcState -> RdcState
$cpred :: RdcState -> RdcState
pred :: RdcState -> RdcState
$ctoEnum :: Int -> RdcState
toEnum :: Int -> RdcState
$cfromEnum :: RdcState -> Int
fromEnum :: RdcState -> Int
$cenumFrom :: RdcState -> [RdcState]
enumFrom :: RdcState -> [RdcState]
$cenumFromThen :: RdcState -> RdcState -> [RdcState]
enumFromThen :: RdcState -> RdcState -> [RdcState]
$cenumFromTo :: RdcState -> RdcState -> [RdcState]
enumFromTo :: RdcState -> RdcState -> [RdcState]
$cenumFromThenTo :: RdcState -> RdcState -> RdcState -> [RdcState]
enumFromThenTo :: RdcState -> RdcState -> RdcState -> [RdcState]
Enum,RdcState
RdcState -> RdcState -> Bounded RdcState
forall a. a -> a -> Bounded a
$cminBound :: RdcState
minBound :: RdcState
$cmaxBound :: RdcState
maxBound :: RdcState
Bounded)

--------------------------------------------------------------------------------
-- reducesTo -

-- | indicates that a term has the given reduction step, i.e. returns the given value and sets the
-- state to 'Changed'.
reducesTo :: x -> Rdc x
reducesTo :: forall x. x -> Rdc x
reducesTo x
x = do
  RdcState
_ <- RdcState -> Action RdcState RdcState
forall s. s -> Action s s
setState RdcState
Changed
  x -> Rdc x
forall x. x -> Rdc x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x

--------------------------------------------------------------------------------
-- reduceWith -

-- | reduces @x@ by the given rules until no more reductions are applicable. 
reduceWith :: (x -> Rdc x) -> x -> x
reduceWith :: forall x. (x -> Rdc x) -> x -> x
reduceWith x -> Rdc x
r x
x = case RdcState
s of
                   RdcState
Unchanged -> x
x'
                   RdcState
_         -> (x -> Rdc x) -> x -> x
forall x. (x -> Rdc x) -> x -> x
reduceWith x -> Rdc x
r x
x'
                
  where (x
x',RdcState
s) = Rdc x -> RdcState -> (x, RdcState)
forall s x. Action s x -> s -> (x, s)
run (x -> Rdc x
r x
x) (RdcState -> (x, RdcState)) -> RdcState -> (x, RdcState)
forall a b. (a -> b) -> a -> b
$ RdcState
Unchanged

--------------------------------------------------------------------------------
-- (>>>=) -
infixr 1 >>>=

-- | composition of two reductions.
(>>>=) :: (x -> Rdc x) -> (x -> Rdc x) -> x -> Rdc x
>>>= :: forall x. (x -> Rdc x) -> (x -> Rdc x) -> x -> Rdc x
(>>>=) x -> Rdc x
f x -> Rdc x
g x
x = x -> Rdc x
f x
x Rdc x -> (x -> Rdc x) -> Rdc x
forall a b.
Action RdcState a -> (a -> Action RdcState b) -> Action RdcState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> Rdc x
g