[Haskell-cafe] StableNames and monadic functions
Ismael Figueroa Palet
ifigueroap at gmail.com
Tue Jun 26 17:50:25 CEST 2012
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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120626/7953d221/attachment-0001.htm>
More information about the Haskell-Cafe
mailing list