[GHC] #12936: Type inference regression in GHC HEAD

[GHC]

#12936: Type inference regression in GHC HEAD
-------------------------------------+-------------------------------------
           Reporter:  RyanGlScott    |             Owner:
               Type:  bug            |            Status:  new
           Priority:  high           |         Milestone:  8.2.1
          Component:  Compiler       |           Version:  8.1
  (Type checker)                     |
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  GHC rejects
  Unknown/Multiple                   |  valid program
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 First noticed in https://ghc.haskell.org/trac/ghc/ticket/12790#comment:8.
 This causes `parsec-3.1.11` to fail to build with GHC HEAD.

 Here is as small of a test case that I can manage, with no dependencies:

 {{{#!hs
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 module Parsec (makeTokenParser) where

 import Data.Char (digitToInt)

 data ParsecT s u (m :: * -> *) a

 instance Functor (ParsecT s u m) where
     fmap = undefined

 instance Applicative (ParsecT s u m) where
     pure = undefined
     (<*>) = undefined

 instance Monad (ParsecT s u m) where
     return = undefined
     (>>=)  = undefined
     fail   = undefined

 parserZero :: ParsecT s u m a
 parserZero = undefined

 infixr 1 <|>
 (<|>) :: (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)
 (<|>) = undefined

 class (Monad m) => Stream s m t | s -> t where

 digit :: (Stream s m Char) => ParsecT s u m Char
 digit = undefined

 hexDigit :: (Stream s m Char) => ParsecT s u m Char
 hexDigit = undefined

 octDigit :: (Stream s m Char) => ParsecT s u m Char
 octDigit = undefined

 option :: (Stream s m t) => a -> ParsecT s u m a -> ParsecT s u m a
 option = undefined

 many1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]
 many1 = undefined

 data GenTokenParser s u m
     = TokenParser {
         float            :: ParsecT s u m Double,
         naturalOrFloat   :: ParsecT s u m (Either Integer Double)
     }

 makeTokenParser :: (Stream s m Char) => GenTokenParser s u m
 makeTokenParser
     = TokenParser{
                    float = float_
                  , naturalOrFloat = naturalOrFloat_
                  }
     where

     -----------------------------------------------------------
     -- Numbers
     -----------------------------------------------------------
     naturalOrFloat_ = lexeme natFloat

     float_          = lexeme floating

     -- floats
     floating        = do{ n <- decimal
                         ; fractExponent n
                         }


     natFloat        =     zeroNumFloat
                       <|> decimalFloat

     zeroNumFloat    =  do{ n <- hexadecimal <|> octal
                          ; return (Left n)
                          }
                     <|> decimalFloat

     decimalFloat    = do{ n <- decimal
                         ; option (Left n)
                                  (fractFloat n)
                         }

     fractFloat n    = do{ f <- fractExponent n
                         ; return (Right f)
                         }

     fractExponent n = do{ fract <- fraction
                         ; expo  <- option "" exponent'
                         ; readDouble (show n ++ fract ++ expo)
                         }
                     <|>
                       do{ expo <- exponent'
                         ; readDouble (show n ++ expo)
                         }
                       where
                         readDouble s =
                           case reads s of
                             [(x, "")] -> return x
                             _         -> parserZero

     fraction        = do{ digits <- many1 digit
                         ; return ('.' : digits)
                         }

     exponent'       = do{ e <- decimal
                         ; return (show e)
                         }

     -- integers and naturals
     decimal         = number 10 digit
     hexadecimal     = number 16 hexDigit
     octal           = number 8 octDigit

     number base baseDigit
         = do{ digits <- many1 baseDigit
             ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0
 digits
             ; seq n (return n)
             }

     -----------------------------------------------------------
     -- White space & symbols
     -----------------------------------------------------------
     lexeme p = do{ x <- p; whiteSpace; return x  }
     whiteSpace = return ()
 }}}

 In GHC 8.0.1 and 8.0.2, this compiles without issue. But on GHC HEAD:

 {{{
 $ ~/Software/ghc/inplace/bin/ghc-stage2 Parsec.hs
 [1 of 1] Compiling Parsec           ( Parsec.hs, Parsec.o )

 Parsec.hs:83:27: error:
     • Could not deduce (Stream s m t0) arising from a use of ‘option’
       from the context: Stream s m Char
         bound by the type signature for:
                    makeTokenParser :: Stream s m Char => GenTokenParser s
 u m
         at Parsec.hs:53:1-60
       The type variable ‘t0’ is ambiguous
       Relevant bindings include
         decimalFloat :: ParsecT s u1 m (Either Integer Double)
           (bound at Parsec.hs:82:5)
         fractFloat :: forall b a1 u a2.
                       (Read b, Show a2) =>
                       a2 -> ParsecT s u m (Either a1 b)
           (bound at Parsec.hs:87:5)
         fractExponent :: forall a1 u a2.
                          (Show a2, Read a1) =>
                          a2 -> ParsecT s u m a1
           (bound at Parsec.hs:91:5)
         fraction :: forall u. ParsecT s u m [Char]
           (bound at Parsec.hs:105:5)
         exponent' :: forall u. ParsecT s u m String
           (bound at Parsec.hs:109:5)
         decimal :: forall u. ParsecT s u m Integer
           (bound at Parsec.hs:114:5)
         lexeme :: forall b. ParsecT s u m b -> ParsecT s u m b
           (bound at Parsec.hs:127:5)
         (Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max-
 relevant-binds)
     • In a stmt of a 'do' block: option (Left n) (fractFloat n)
       In the expression:
         do { n <- decimal;
              option (Left n) (fractFloat n) }
       In an equation for ‘decimalFloat’:
           decimalFloat
             = do { n <- decimal;
                    option (Left n) (fractFloat n) }
 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/12936>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler