[Haskell-cafe] StableNames and monadic functions

Lorenzo Bolla lbolla at gmail.com
Tue Jun 26 16:15:49 CEST 2012


The point I was making is that StableName might be what you want. You are
using it to check if two functions are the same by comparing their
"stablehash". But from StableName documentation:

The reverse is not necessarily true: if two stable names are not equal,
> then the objects they name may still be equal.


The `eq` you implemented means this, I reckon: if `eq` returns True then
the 2 functions are equal, if `eq` returns False then you can't tell!

Does it make sense?
L.


On Tue, Jun 26, 2012 at 1:54 PM, Ismael Figueroa Palet <ifigueroap at gmail.com
> wrote:

> Thanks Lorenzo, I'm cc'ing the list with your response also:
>
> As you point out, when you do some kind of "let-binding", using the where
> clause, or explicit let as in:
>
> main :: IO ()
> main = do
>        let f1 = (successor :: Int -> State Int Int)
>        let f2 = (successor :: Int -> Maybe Int)
>        b2 <- eq f2 f2
>        b1 <- eq f1 f1
>        print (show b1 ++ " " ++ show b2)
>
> The behavior is as expected. I guess the binding triggers some internal
> optimization or gives more information to the type checker; but I'm still
> not clear why it is required to be done this way -- having to let-bind
> every function is kind of awkward.
>
> I know the details of StableNames are probably implementation-dependent,
> but I'm still wondering about how to detect / restrict this situation.
>
> Thanks
>
>
> 2012/6/26 Lorenzo Bolla <lbolla at gmail.com>
>
>> From StableName docs:
>>
>>> The reverse is not necessarily true: if two stable names are not equal,
>>> then the objects they name may still be equal.
>>
>>
>> This version works as expected:
>>
>> import System.Mem.StableName
>> import Control.Monad.State
>>
>> eq :: a -> b -> IO Bool
>> eq a b = do
>>              pa <- makeStableName a
>>              pb <- makeStableName b
>>              return (hashStableName pa == hashStableName pb)
>>
>> successor :: (Num a, Monad m) => a -> m a
>> successor n = return (n+1)
>>
>> --  main :: IO ()
>> --  main = do
>> --         b2 <- eq (successor :: Int -> State Int Int) (successor :: Int
>> -> State Int Int)
>> --         b1 <- eq (successor :: Int -> Maybe Int) (successor :: Int ->
>> Maybe Int)
>> --         print (show b1 ++ " " ++ show b2)
>>
>> main :: IO ()
>> main = do
>>        b2 <- eq f2 f2
>>        b1 <- eq f1 f1
>>        print (show b1 ++ " " ++ show b2)
>>    where f1 = (successor :: Int -> Maybe Int)
>>          f2 = (successor :: Int -> State Int Int)
>>
>>
>>
>> hth,
>> L.
>>
>>
>>
>>
>> On Tue, Jun 26, 2012 at 1:15 PM, Ismael Figueroa Palet <
>> ifigueroap at gmail.com> wrote:
>>
>>> I'm using StableNames to have a notion of function equality, and I'm
>>> running into problems when using monadic functions.
>>>
>>> Consider the code below, file Test.hs
>>>
>>> import System.Mem.StableName
>>> import Control.Monad.State
>>>
>>> eq :: a -> b -> IO Bool
>>> eq a b = do
>>>              pa <- makeStableName a
>>>              pb <- makeStableName b
>>>              return (hashStableName pa == hashStableName pb)
>>>
>>> successor :: (Num a, Monad m) => a -> m a
>>> successor n = return (n+1)
>>>
>>> main :: IO ()
>>> main = do
>>>        b1 <- eq (successor :: Int -> Maybe Int) (successor :: Int ->
>>> Maybe Int)
>>>        b2 <- eq (successor :: Int -> State Int Int) (successor :: Int ->
>>> State Int Int)
>>>        print (show b1 ++ " " ++ show b2)
>>>
>>> Running the code into ghci the result is "False False". There is some
>>> old post saying that this is due to the dictionary-passing style for
>>> typeclasses, and compiling with optimizations improves the situation.
>>>
>>> Compiling with ghc --make -O Tests.hs and running the program, the
>>> result is "True True", which is what I expect.
>>> However, if I change main to be like the following:
>>>
>>>  main :: IO ()
>>> main = do
>>>        b2 <- eq (successor :: Int -> State Int Int) (successor :: Int ->
>>> State Int Int)
>>>        b1 <- eq (successor :: Int -> Maybe Int) (successor :: Int ->
>>> Maybe Int)
>>>        print (show b1 ++ " " ++ show b2)
>>>
>>> i.e. just changing the sequential order, and then compiling again with
>>> the same command, I get "True False", which is very confusing for me.
>>> Similar situations happens when using the state monad transformer, and
>>> manually built variations of it.
>>>
>>> It sounds the problem is with hidden closures created somewhere that do
>>> not point to the same memory locations, so StableNames yields false for
>>> that cases, but it is not clear to me under what circumstances this
>>> situation happens. Is there other way to get some approximation of function
>>> equality? or a way to "configure" the behavior of StableNames in presence
>>> of class constraints?
>>>
>>> I'm using the latests Haskell Platform on OS X Lion, btw.
>>>
>>> Thanks
>>>
>>> --
>>> Ismael
>>>
>>>
>>> _______________________________________________
>>> Haskell-Cafe mailing list
>>> Haskell-Cafe at haskell.org
>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>>
>>>
>>
>
>
> --
> Ismael
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120626/ff567d2f/attachment.htm>


More information about the Haskell-Cafe mailing list