module IdempotSP where
import Spops(getSP,putSP)
import SP(SP)

idempotSP :: Eq a => SP a a
idempotSP :: SP a a
idempotSP =
    Cont (SP a a) a
forall a b. Cont (SP a b) a
getSP Cont (SP a a) a -> Cont (SP a a) a
forall a b. (a -> b) -> a -> b
$ \ a
x ->
    a -> SP a a -> SP a a
forall b a. b -> SP a b -> SP a b
putSP a
x (SP a a -> SP a a) -> SP a a -> SP a a
forall a b. (a -> b) -> a -> b
$
    a -> SP a a
forall b. Eq b => b -> SP b b
idempotSP' a
x
  where
    idempotSP' :: b -> SP b b
idempotSP' b
x =
      Cont (SP b b) b
forall a b. Cont (SP a b) a
getSP Cont (SP b b) b -> Cont (SP b b) b
forall a b. (a -> b) -> a -> b
$ \ b
x' ->
      (if b
x'b -> b -> Bool
forall a. Eq a => a -> a -> Bool
==b
x
       then SP b b -> SP b b
forall a. a -> a
id
       else b -> SP b b -> SP b b
forall b a. b -> SP a b -> SP a b
putSP b
x') (SP b b -> SP b b) -> SP b b -> SP b b
forall a b. (a -> b) -> a -> b
$
      b -> SP b b
idempotSP' b
x'