Skip to content
Snippets Groups Projects
Commit 49dbe605 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Major improvement to pattern bindings

This patch makes a number of related improvements

a) Implements the Haskell Prime semantics for pattern bindings
   (Trac #2357).  That is, a pattern binding p = e is typed
   just as if it had been written
        t = e
        f = case t of p -> f
        g = case t of p -> g
        ... etc ...
   where f,g are the variables bound by p. In paricular it's
   ok to say
      (f,g) = (\x -> x, \y -> True)
   and f and g will get propertly inferred types
      f :: a -> a
      g :: a -> Int

b) Eliminates the MonoPatBinds flag altogether.  (For the moment
   it is deprecated and has no effect.)  Pattern bindings are now
   generalised as per (a).  Fixes Trac #2187 and #4940, in the
   way the users wanted!

c) Improves the OutsideIn algorithm generalisation decision.
   Given a definition without a type signature (implying "infer
   the type"), the published algorithm rule is this:
      - generalise *top-level* functions, and
      - do not generalise *nested* functions
   The new rule is
      - generalise a binding whose free variables have
        Guaranteed Closed Types
      - do not generalise other bindings

   Generally, a top-level let-bound function has a Guaranteed
   Closed Type, and so does a nested function whose free vaiables
   are top-level functions, and so on. (However a top-level
   function that is bitten by the Monomorphism Restriction does
   not have a GCT.)

   Example:
     f x = let { foo y = y } in ...
   Here 'foo' has no free variables, so it is generalised despite
   being nested.

d) When inferring a type f :: ty for a definition f = e, check that
   the compiler would accept f :: ty as a type signature for that
   same definition.  The type is rejected precisely when the type
   is ambiguous.

   Example:
      class Wob a b where
        to :: a -> b
        from :: b -> a

      foo x = [x, to (from x)]
   GHC 7.0 would infer the ambiguous type
      foo :: forall a b. Wob a b => b -> [b]
   but that type would give an error whenever it is called; and
   GHC 7.0 would reject that signature if given by the
   programmer.  The new type checker rejects it up front.

   Similarly, with the advent of type families, ambiguous types are
   easy to write by mistake.  See Trac #1897 and linked tickets for
   many examples.  Eg
      type family F a :: *
      f ::: F a -> Int
      f x = 3
   This is rejected because (F a ~ F b) does not imply a~b.  Previously
   GHC would *infer* the above type for f, but was unable to check it.
   Now even the inferred type is rejected -- correctly.

The main implemenation mechanism is to generalise the abe_wrap
field of ABExport (in HsBinds), from [TyVar] to HsWrapper. This
beautiful generalisation turned out to make everything work nicely
with minimal programming effort.  All the work was fiddling around
the edges; the core change was easy!
parent 20ceffb6
No related branches found
No related tags found
No related merge requests found
Showing
with 439 additions and 306 deletions
Loading
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment