[Haskell-cafe] StableNames and monadic functions

Ismael Figueroa Palet ifigueroap at gmail.com
Tue Jun 26 18:50:54 CEST 2012


Yes I agree, so far StableNames have been a good approximation, except for
the problem I described when using monads/class constraints :-(

2012/6/26 Lorenzo Bolla <lbolla at gmail.com>

> This is very tricky and it really depends on what you mean...
> Formally, two functions are the same if they have the same domain and f(x)
> == g(x) for each x in the domain. But this is not always
> easy/feasible/efficient to implement! (See also
> http://en.wikipedia.org/wiki/Rice%27s_theorem and
> http://stackoverflow.com/questions/4844043/are-two-functions-equal.)
>
> Depending on your problem, you might get away with just defining a
> "signature" of your function and compare them: for example the signature
> could be the concat of the function name, args types, etc. But I'm
> speculating here...
>
> L.
>
>
>
> On Tue, Jun 26, 2012 at 4:50 PM, Ismael Figueroa Palet <
> ifigueroap at gmail.com> wrote:
>
>> thanks again for your comments, any idea on how to implement
>> "Equivalence" for functions?
>>
>> 2012/6/26 Lorenzo Bolla <lbolla at gmail.com>
>>
>>> In other words there is a difference between Identity and Equivalence.
>>> What you have implemented with StableName is an "Identity" (sometimes
>>> called "reference equality"), as opposed to an "Equivalence" (aka "value
>>> equality").
>>>
>>> In Python, for example:
>>>
>>> >>> x = {1:2}
>>> >>> y = {1:2}
>>> >>> x == y
>>> True
>>> >>> x is y
>>> False
>>>
>>> L.
>>>
>>>
>>> On Tue, Jun 26, 2012 at 3:42 PM, Lorenzo Bolla <lbolla at gmail.com> wrote:
>>>
>>>> I think about StableName like the "&" operator in C, that returns you
>>>> the memory address of a variable. It's not the same for many reasons, but
>>>> by analogy, if &x == &y then x == y, but &x != &y does not imply x != y.
>>>>
>>>> So, values that are semantically equal, may be stored in different
>>>> memory locations and have different StableNames.
>>>>
>>>> The fact that changing the order of the lines also changes the result
>>>> of the computation is obviously stated in the type signature of
>>>> makeStableName, which lives in the IO monad. On the other hand
>>>> hashStableNAme is a pure function.
>>>>
>>>> L.
>>>>
>>>>
>>>>
>>>> On Tue, Jun 26, 2012 at 3:26 PM, Ismael Figueroa Palet <
>>>> ifigueroap at gmail.com> wrote:
>>>>
>>>>>
>>>>>
>>>>> 2012/6/26 Lorenzo Bolla <lbolla at gmail.com>
>>>>>
>>>>>> 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.
>>>>>>
>>>>>
>>>>> Yes  it does make sense, and I'm wondering why the hash are equal in
>>>>> one case but are not equal on the other case (i.e. using let/where vs not
>>>>> using it) because I'd like it to behave the same in both situations
>>>>>
>>>>> Thanks again
>>>>>
>>>>>
>>>>>>
>>>>>>
>>>>>> 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
>>>>>>>
>>>>>>>
>>>>>>
>>>>>
>>>>>
>>>>> --
>>>>> Ismael
>>>>>
>>>>>
>>>>
>>>
>>
>>
>> --
>> Ismael
>>
>>
>


-- 
Ismael
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120626/9abcabe0/attachment.htm>


More information about the Haskell-Cafe mailing list