-- |
-- 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 = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RdcState] -> ShowS
$cshowList :: [RdcState] -> ShowS
show :: RdcState -> String
$cshow :: RdcState -> String
showsPrec :: Int -> RdcState -> ShowS
$cshowsPrec :: Int -> RdcState -> ShowS
Show,ReadPrec [RdcState]
ReadPrec RdcState
Int -> ReadS RdcState
ReadS [RdcState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RdcState]
$creadListPrec :: ReadPrec [RdcState]
readPrec :: ReadPrec RdcState
$creadPrec :: ReadPrec RdcState
readList :: ReadS [RdcState]
$creadList :: ReadS [RdcState]
readsPrec :: Int -> ReadS RdcState
$creadsPrec :: Int -> ReadS RdcState
Read,RdcState -> RdcState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RdcState -> RdcState -> Bool
$c/= :: RdcState -> RdcState -> Bool
== :: RdcState -> RdcState -> Bool
$c== :: RdcState -> RdcState -> Bool
Eq,Eq 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
min :: RdcState -> RdcState -> RdcState
$cmin :: RdcState -> RdcState -> RdcState
max :: RdcState -> RdcState -> RdcState
$cmax :: RdcState -> RdcState -> RdcState
>= :: RdcState -> RdcState -> Bool
$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
compare :: RdcState -> RdcState -> Ordering
$ccompare :: RdcState -> RdcState -> Ordering
Ord,Int -> RdcState
RdcState -> Int
RdcState -> [RdcState]
RdcState -> RdcState
RdcState -> RdcState -> [RdcState]
RdcState -> RdcState -> RdcState -> [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
enumFromThenTo :: RdcState -> RdcState -> RdcState -> [RdcState]
$cenumFromThenTo :: RdcState -> RdcState -> RdcState -> [RdcState]
enumFromTo :: RdcState -> RdcState -> [RdcState]
$cenumFromTo :: RdcState -> RdcState -> [RdcState]
enumFromThen :: RdcState -> RdcState -> [RdcState]
$cenumFromThen :: RdcState -> RdcState -> [RdcState]
enumFrom :: RdcState -> [RdcState]
$cenumFrom :: RdcState -> [RdcState]
fromEnum :: RdcState -> Int
$cfromEnum :: RdcState -> Int
toEnum :: Int -> RdcState
$ctoEnum :: Int -> RdcState
pred :: RdcState -> RdcState
$cpred :: RdcState -> RdcState
succ :: RdcState -> RdcState
$csucc :: RdcState -> RdcState
Enum,RdcState
forall a. a -> a -> Bounded a
maxBound :: RdcState
$cmaxBound :: RdcState
minBound :: RdcState
$cminBound :: 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
_ <- forall s. s -> Action s s
setState RdcState
Changed
  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
_         -> forall x. (x -> Rdc x) -> x -> x
reduceWith x -> Rdc x
r x
x'
                
  where (x
x',RdcState
s) = forall s x. Action s x -> s -> (x, s)
run (x -> Rdc x
r x
x) 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> Rdc x
g