[Haskell-cafe] Full strict functor by abusing Haskell exceptions
Neil Brown
nccb2 at kent.ac.uk
Tue Sep 14 06:27:47 EDT 2010
On 13/09/10 17:25, Maciej Piechotka wrote:
>> import Control.Exception
>> import Foreign
>> import Prelude hiding (catch)
>>
>> data StrictMonad a = StrictMonad a deriving Show
>>
>> instance Monad StrictMonad where
>> return x = unsafePerformIO $ do
>> (return $! x) `catch` \(SomeException _) -> return x
>> return $! StrictMonad x
>> StrictMonad v>>= f = f v
>>
> It seems to be valid IMHO Functor and Monad (I haven't prove it) as long
> as functions terminates.
>
I'm not sure if I'm allowed to use unsafePerformIO in my
counter-example, but you used it so why not ;-)
The first monad law says: "return a >>= k = k a"
let k = const (StrictMonad ())
a = unsafePerformIO launchMissiles
In "k a" no missiles will be launched, in "return a >>= k", they will be
launched. You can construct a similar example against "m >>= return =
m". Although, if you changed your definition of bind to:
StrictMonad v >>= f = return v >>= f >>= return
Then as long as "return x >>= return = return x" (which it does for you)
then you automatically satisfy the first two monad laws! Which is an
interesting way of solving the problem -- haven't checked the third law
though.
Thanks,
Neil.
More information about the Haskell-Cafe
mailing list