Hi,

Aha! This page explains what is going on: http://hackage.haskell.org/trac/ghc/blog/LetGeneralisationInGhc7

The summary is that the definition of what is "local" is not what one might expect:  only things that depend
on variables in scope are considered to be locals, other bindings, that could be lifted out (e.g., like `p` in both examples)
are not considered local and are generalized.  Of course, with implicit parameters this is not what one might hope for...

A while back there was a discussion about adding a construct for monomorphic bindings to the language (I think the proposed notation was something like "x := 2").
Perhaps we should revisit it, it seems much simpler than the rather surprising behavior of `MonoLocalBinds`.

-Iavor






On Thu, Mar 28, 2013 at 4:39 PM, Iavor Diatchki <iavor.diatchki@gmail.com> wrote:
Hi,
This does not appear to be related to ImplicitParameters, rather `MonoLocalBinds` is not working as expected.

Here is an example without implicit parameters that compiles just fine, but would be rejected if `p` was monomorphic:

{-# LANGUAGE NoMonomorphismRestriction, MonoLocalBinds #-}

class C a where
  f :: a -> ()

instance C Bool where f = const ()
instance C Char where f = const ()

g = let p = f
    in (p 'a', p True)

-Iavor




On Fri, Mar 22, 2013 at 1:39 AM, Roman Cheplyaka <roma@ro-che.info> wrote:
The value of the following expression

  let ?y = 2  in
  let  p = ?y in
  let ?y = 1  in
  p

depends on whether the second binding is generalised.

MonomorphismRestriction makes it not generalise, hence the value is 2.

What surprises me is that MonoLocalBinds doesn't have this effect.

  Prelude> :set -XImplicitParams -XNoMonomorphismRestriction -XMonoLocalBinds
  Prelude> let ?y = 2 in let p = ?y in let ?y = 1 in p
  1

What's going on here?

Roman

_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users