Stable names and type constraints
Simon Marlow
marlowsd at gmail.com
Wed Nov 23 11:43:56 CET 2011
On 23/11/2011 04:56, Lee Pike wrote:
> Hi Everybody,
>
> This is a question about System.Mem.StableName
> <http://www.haskell.org/ghc/docs/latest/html/libraries/base-4.4.1.0/System-Mem-StableName.html>---let
> me know if this isn't the right forum, but my understanding is that
> stable names are GHC-specific.
>
> Consider the module below. For a function with type constraints,
> stable names fails to "realize" that we are pointing to the same
> object. As a couple of my colleagues pointed out to me, the cause is
> the dictionary being passed around causing new closures to be created.
>
> This can be rectified using a local variable binding (e.g., using a
> where clause), but it'd be nice if there were a solution to allow for
> observable sharing, even for functions with type constraints.
>
> Are there known solutions other than monomorphism or local variable bindings?
Compile it with -O, and GHC recovers the sharing for you :-) (I'm not
joking, try it).
I don't know of a general solution to this particular problem.
Observable sharing is a bit of a minefield, I expect problems like this
should crop up quite often in practice (but perhaps not?).
Cheers,
Simon
> Thanks,
> Lee
>
> -------------------------------------------------------------------------------
>
> module Test where
>
> import System.Mem.StableName (StableName, makeStableName)
>
> ---------------------------------------------------------------------------------
>
> type Map a = [StableName (Expr a)]
>
> analyze :: Expr a -> IO (Map a)
> analyze = analyzeExpr []
>
> analyzeExpr :: (Map a) -> Expr a -> IO (Map a)
> analyzeExpr env e@(Op e0) = do
> sn<- makeStableName e
> if elem sn env
> then return env
> else analyzeExpr (sn : env) e0
>
> ---------------------------------------------------------------------------------
> -- Language, with one constructor
>
> class Typed a where
>
> instance Typed Int
>
> data Expr a = Op (Expr a)
>
> expr0 :: Expr a
> expr0 = Op expr0
>
> expr1 :: Typed a => Expr a
> expr1 = Op expr1
>
> expr2 :: Typed a => Expr a
> expr2 = x
> where x = Op x
>
> ---------------------------------------------------------------------------------
> -- Tests
>
> -- Returns 1
> test0 :: IO ()
> test0 = test (expr0 :: Expr Int)
>
> -- Doesn't terminate!
> test1 :: IO ()
> test1 = test (expr1 :: Expr Int)
>
> -- Returns 1
> test2 :: IO ()
> test2 = test (expr2 :: Expr Int)
>
> test :: Expr a -> IO ()
> test e = analyze e>>= putStrLn . show . length
More information about the Glasgow-haskell-users
mailing list