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

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