<div dir="ltr">And just to complicate things more, there is also MonoLocalBinds which monomorphizes certain let bindings and is turned on by some extensions (iirc including type families) because they get much harder to type otherwise.</div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Thu, Oct 7, 2021 at 1:30 PM Olaf Klinke <<a href="mailto:olf@aatal-apotheke.de">olf@aatal-apotheke.de</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">> <br>
> {-# LANGUAGE RankNTypes #-}<br>
> > newtype General = General {<br>
> >     useGeneral :: forall a. Integral a => a -> Bool<br>
> >     }<br>
> > <br>
> > doesNotWork :: General<br>
> > doesNotWork = let<br>
> >          g = even :: forall a. Integral a => a -> Bool<br>
> >          b = specializeGeneral g<br>
> >          in General g<br>
> > <br>
> > doesWork :: General<br>
> > doesWork = let<br>
> >          g = General even<br>
> >          b = specializeGeneral (useGeneral g)<br>
> >          in g<br>
> > <br>
> > specializeGeneral :: (Int -> Bool) -> Bool<br>
> > specializeGeneral p = p 5<br>
> > <br>
> > I was under the impression that one can always use a more general type <br>
> > where a more special type is needed. In `doesNotWork` above, despite the <br>
> > explicit Rank-2 type annotation, usage in `specializeGeneral` apparently <br>
> > makes the compiler infer the type of `g` to be (Int -> Bool) and <br>
> > complains that `a` can not me matched with `Bool`. What gets me is that <br>
> > the compiler error is at `General g`, so the compiler must have ignored <br>
> > my Rank-2 type annotation. Should it be allowed to do that?<br>
> > <br>
> > Olaf<br>
><br>
> Hi Olaf,<br>
> <br>
> This is the monomorphism restriction. g is a binding without a <br>
> signature, so it gets specialized. The type annotation is part of<br>
the <br>
> body of g, but if you want to generalize g it should be a separate <br>
> declaration<br>
> <br>
>      let g :: forall ...<br>
>          g = ...<br>
> <br>
<br>
Oh, thanks! I should have suspected. But somehow I feel my type<br>
annotation should have circumvented the monomorphism restriction. So <br>
   g = even<br>
is a pattern binding and therefore subject to monomorphism restriction,<br>
regardless of following type annotation? <br>
<br>
So thanks for teaching me that it is not irrelevant where to place a<br>
type annotation. To this day I believed that <br>
   name = expression :: type<br>
and <br>
  name :: type<br>
  name = expression<br>
are equivalent because one is syntactic sugar for the other. Do the two<br>
give rise to different elements in the abstract syntax tree? Am I the<br>
only one who finds this odd? Which Haskell book should I have read to<br>
be aware of this? The Consequences part in Section 4.5.5 of the Haskell<br>
report mentions the distinction between function an pattern bindings,<br>
but is not clear about the position of the type annotation. It merely<br>
states "the user must be careful to affix these [pattern bindings] with<br>
type signatures to retain full overloading". <br>
<br>
Olaf<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div><br clear="all"><div><br></div>-- <br><div dir="ltr" class="gmail_signature"><div dir="ltr"><div><div dir="ltr"><div>brandon s allbery kf8nh</div><div><a href="mailto:allbery.b@gmail.com" target="_blank">allbery.b@gmail.com</a></div></div></div></div></div>