{-# LANGUAGE RebindableSyntax, NPlusKPatterns, FlexibleInstances,
             MultiParamTypeClasses, FunctionalDependencies #-}
{-# OPTIONS -Wno-error=missing-monadfail-instances #-}

module Main where
        {
--      import Prelude;
        import qualified Prelude;
        import Prelude(String,undefined,Maybe(..),IO,putStrLn,
                Integer,(++),Rational, (==), (>=) );

        debugFunc :: String -> IO a -> IO a;
        debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
                (ioa Prelude.>>= (\a ->
                        (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
                ));

        infixl 1 >>=;
        infixl 1 >>;

        returnIO :: a -> IO a;
        returnIO = Prelude.return;

        class HasReturn m where
                {
                return :: a -> m a;
                };

        class HasBind m n mn | m n -> mn, m mn -> n where
                {
                (>>=) :: m a -> (a -> n b) -> mn b;
                };

        class HasSeq m n mn | m n -> mn, m mn -> n where
                {
                (>>) :: m a -> n b -> mn b;
                };

        class HasFail m where
                {
                fail :: String -> m a;
                };

        instance HasReturn IO where
                {
                return a = debugFunc "return" (returnIO a);
                };

        instance HasBind IO IO IO where
                {
                (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb);
                };

        instance HasSeq IO IO IO where
                {
                (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb);
                };

        instance HasFail IO where
                {
                fail s = debugFunc "fail" (returnIO undefined);
        --      fail s = debugFunc "fail" (Prelude.fail s);
                };

        class HasFromInteger a where
                {
                fromInteger :: a -> a;
                };

        instance HasFromInteger Integer where
                {
                fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
                };

        class HasFromRational a where
                {
                fromRational :: a -> a;
                };

        instance HasFromRational Rational where
                {
                fromRational a = a Prelude.+ a Prelude.+ a; -- three times
                };

        class HasNegate a where
                {
                negate :: a -> a;
                };

        instance HasNegate Integer where
                {
                negate a = a; -- don't actually negate
                };

        instance HasNegate Rational where
                {
                negate a = a; -- don't actually negate
                };

        class HasMinus a where
                {
                (-) :: a -> a -> a;
                };

        instance HasMinus Rational where
                {
                (-) x y = y; -- changed function
                };

        instance HasMinus Integer where
                {
                (-) x y = y; -- changed function
                };

        test_do f g = do
                {
                f;                              -- >>
                Just a <- g;    -- >>= (and fail if g returns Nothing)
                return a;               -- return
                };

        test_fromInteger :: Integer;
        test_fromInteger = 27;

        test_fromRational :: Rational;
        test_fromRational = 31.5;

        test_negate :: Integer -> Integer;
        test_negate a = - a;

        test_fromInteger_pattern :: Integer -> String;
        test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
        test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
        test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;

        test_fromRational_pattern :: Rational -> String;
        test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
        test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
        test_fromRational_pattern a = "_=" ++ (Prelude.show a);

        doTest :: String -> IO a -> IO ();
        doTest s ioa =
                (putStrLn ("start test " ++ s))
                        Prelude.>>
                ioa
                        Prelude.>>
                (putStrLn ("end test " ++ s));

        main :: IO ();
        main =
                (doTest "test_do failure"
                        (test_do (returnIO ()) (returnIO Nothing))
                )
                        Prelude.>>
                (doTest "test_do success"
                        (test_do (returnIO ()) (returnIO (Just ())))
                )
                        Prelude.>>
                (doTest "test_fromInteger"
                        (putStrLn (Prelude.show test_fromInteger))
                )
                        Prelude.>>
                (doTest "test_fromRational"
                        (putStrLn (Prelude.show test_fromRational))
                )
                        Prelude.>>
                (doTest "test_negate"
                        (putStrLn (Prelude.show (test_negate 3)))
                )
                        Prelude.>>
                (doTest "test_fromInteger_pattern 1"
                        (putStrLn (test_fromInteger_pattern 1))
                )
                        Prelude.>>
                (doTest "test_fromInteger_pattern (-2)"
                        (putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer)))
                )
                        Prelude.>>
                (doTest "test_fromInteger_pattern 9"
                        (putStrLn (test_fromInteger_pattern 9))
                )
                        Prelude.>>
                (doTest "test_fromRational_pattern 0.5"
                        (putStrLn (test_fromRational_pattern 0.5))
                )
                        Prelude.>>
                (doTest "test_fromRational_pattern (-0.7)"
                        (putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational)))
                )
                        Prelude.>>
                (doTest "test_fromRational_pattern 1.7"
                        (putStrLn (test_fromRational_pattern 1.7))
                )
           ;
        }


{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE NPlusKPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

module Main where
        {
        import qualified Prelude;
        import Prelude(String,undefined,Maybe(..),IO,putStrLn,
                Integer,(++),Rational, (==), (>=) );

        debugFunc :: String -> IO a -> IO a;
        debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
                (ioa Prelude.>>= (\a ->
                        (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
                ));

        infixl 1 >>=;
        infixl 1 >>;

        returnIO :: a -> IO a;
        returnIO = Prelude.return;

        class HasReturn a where
                {
                return :: a;
                };

        class HasBind a where
                {
                (>>=) :: a;
                };

        class HasSeq a where
                {
                (>>) :: a;
                };

        class HasFail a where
                {
                fail :: a;
                };

        instance HasReturn (a -> IO a) where
                {
                return a = debugFunc "return" (Prelude.return a);
                };

        instance HasBind (IO a -> (a -> IO b) -> IO b) where
                {
                (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb);
                };

        instance HasSeq (IO a -> IO b -> IO b) where
                {
                (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb);
                };

        instance HasFail (String -> IO a) where
                {
                fail s = debugFunc "fail" (Prelude.return undefined);
        --      fail s = debugFunc "fail" (Prelude.fail s);
                };

        class HasFromInteger a where
                {
                fromInteger :: a;
                };

        instance HasFromInteger (Integer -> Integer) where
                {
                fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
                };

        class HasFromRational a where
                {
                fromRational :: a;
                };

        instance HasFromRational (Rational -> Rational) where
                {
                fromRational a = a Prelude.+ a Prelude.+ a; -- three times
                };

        class HasNegate a where
                {
                negate :: a;
                };

        instance (b ~ (a -> a)) => HasNegate b where
                {
                negate a = a; -- don't actually negate
                };

        class HasMinus a where
                {
                (-) :: a;
                };

        instance (b ~ (a -> a -> a)) => HasMinus b where
                {
                (-) x y = y; -- changed function
                };

        test_do :: forall a b. IO a -> IO (Maybe b) -> IO b;
        test_do f g = do
                {
                f;                      -- >>
                Just (b::b) <- g;       -- >>= (and fail if g returns Nothing)
                return b;               -- return
                };

        test_fromInteger :: Integer;
        test_fromInteger = 27;

        test_fromRational :: Rational;
        test_fromRational = 31.5;

        test_negate :: Integer -> Integer;
        test_negate a = - a;

        test_fromInteger_pattern :: Integer -> String;
        test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
        test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
        test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;

        test_fromRational_pattern :: Rational -> String;
        test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
        test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
        test_fromRational_pattern a = "_=" ++ (Prelude.show a);

        doTest :: String -> IO a -> IO ();
        doTest s ioa =
                (putStrLn ("start test " ++ s))
                        Prelude.>>
                ioa
                        Prelude.>>
                (putStrLn ("end test " ++ s));

        main :: IO ();
        main =
                (doTest "test_do failure"
                        (test_do (Prelude.return ()) (Prelude.return Nothing))
                )
                        Prelude.>>
                (doTest "test_do success"
                        (test_do (Prelude.return ()) (Prelude.return (Just ())))
                )
                        Prelude.>>
                (doTest "test_fromInteger"
                        (putStrLn (Prelude.show test_fromInteger))
                )
                        Prelude.>>
                (doTest "test_fromRational"
                        (putStrLn (Prelude.show test_fromRational))
                )
                        Prelude.>>
                (doTest "test_negate"
                        (putStrLn (Prelude.show (test_negate 3)))
                )
                        Prelude.>>
                (doTest "test_fromInteger_pattern 1"
                        (putStrLn (test_fromInteger_pattern 1))
                )
                        Prelude.>>
                (doTest "test_fromInteger_pattern (-2)"
                        (putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer)))
                )
                        Prelude.>>
                (doTest "test_fromInteger_pattern 9"
                        (putStrLn (test_fromInteger_pattern 9))
                )
                        Prelude.>>
                (doTest "test_fromRational_pattern 0.5"
                        (putStrLn (test_fromRational_pattern 0.5))
                )
                        Prelude.>>
                (doTest "test_fromRational_pattern (-0.7)"
                        (putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational)))
                )
                        Prelude.>>
                (doTest "test_fromRational_pattern 1.7"
                        (putStrLn (test_fromRational_pattern 1.7))
                );
        }


{-# OPTIONS -XRebindableSyntax #-}

-- This one tests rebindable syntax for do-notation

module Main where

import qualified Prelude
import GHC.Num
import GHC.Base hiding( Monad(..) )

class Foo a where
  op :: a -> a

data T a = MkT a

instance Foo Int where
  op x = x+1

(>>=) :: Foo a => T a -> (a -> T b) -> T b
(>>=) (MkT x) f = f (op x)

(>>) :: Foo a => T a -> T b -> T b
(>>) x y = x >>= (\_ -> y)

return :: Num a => a -> T a
return x = MkT (x+1)

fail :: String -> T a
fail s = error "urk"

t1 :: T Int
t1 = MkT 4

myt = do { x <- t1
         ; return x }

main = case myt of
         MkT i -> Prelude.print i


{-# LANGUAGE RebindableSyntax, MultiParamTypeClasses #-}

-- Trac #1537

module Foo where
import Prelude hiding (Monad(..))

class Bind m1 m2 m3 where
  (>>=) :: m1 a -> (a -> m2 b) -> m3 b

class Return m where
  return :: a -> m a
  fail   :: String -> m a

instance Bind Maybe [] [] where
  Just x  >>= f = f x
  Nothing >>= f = []

instance Return [] where
  return x = [x]
  fail _   = []

should_compile :: [Int]
should_compile = do
  a <- Just 1
  [a]


{-# LANGUAGE RebindableSyntax, FlexibleInstances,
             MultiParamTypeClasses, FunctionalDependencies #-}

-- Trac #1537

module Foo where
import qualified Prelude
import Prelude hiding (Monad(..))

import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)

newtype Identity a = Identity { runIdentity :: a }

instance Prelude.Functor Identity where
    fmap = liftM

instance Applicative Identity where
    pure = Prelude.return
    (<*>) = ap

instance Prelude.Monad Identity where
    return a = Identity a
    m >>= k  = k (runIdentity m)

class Bind m1 m2 m3 | m1 m2 -> m3 where
  (>>=) :: m1 a -> (a -> m2 b) -> m3 b

class Return m where
  returnM :: a -> m a
  fail   :: String -> m a

instance Bind Maybe [] [] where
  Just x  >>= f = f x
  Nothing >>= f = []

instance              Bind Identity a a   where m >>= f = f (runIdentity m)
instance Functor a => Bind a Identity a   where m >>= f = fmap (runIdentity . f) m

instance Prelude.Monad m => Bind m m m where (>>=) = (Prelude.>>=)

instance Return [] where
  returnM x = [x]
  fail _   = []

return :: a -> Identity a
return = Prelude.return

should_compile :: [Int]
should_compile = do
  a <- Just 1
  b <- [a*1,a*2]
  return (b+1)


{-# LANGUAGE RankNTypes, RebindableSyntax #-}
module T10112 where

import qualified Prelude as P

(>>=) :: a -> ((forall b . b) -> c) -> c
a >>= f = f P.undefined
return a = a
fail s = P.undefined

t1 = 'd' >>= (\_ -> 'k')

t2 = do { _ <- 'd'
        ; 'k' }

foo = P.putStrLn [t1, t2]


{-# LANGUAGE RebindableSyntax #-}

module Bug where

foo :: (a, b) -> ()
foo x | (_,_) <- x = ()


{-# LANGUAGE RebindableSyntax #-}

module Bug where

data Maybe a = Just a | Nothing

foo :: [Maybe a] -> [a]
foo xs = [ x | Just x <- xs ]


{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RebindableSyntax #-}

import Prelude

class IfThenElse a b where
  ifThenElse :: a -> b -> b -> b

instance IfThenElse Bool b where
  ifThenElse c x y = if c then x else y

data Foo = Foo | Bar | Baz deriving (Eq, Ord)

main :: IO ()
main = print $ Foo < Bar


{-# LANGUAGE RebindableSyntax #-}

module Lib where

import Prelude (IO)

pure = undefined

foo :: IO ()
foo = do
  pure ()


{-# LANGUAGE RebindableSyntax #-}

-- Trac #303

module T where
import qualified Prelude as P

class IxMonad m where
    return :: a -> m i i a
    (>>=) :: m i j a -> (a -> m j k b) -> m i k b
    (>>)  :: m i j a -> m j k b -> m i k b
    m >> n = m >>= \_ -> n

    fail :: P.String -> m i j a
    fail s = P.error s

data T a b c = T
instance IxMonad T where
    return _ = T
    m >>= f  = T
    fail _   = T

testM :: T (a,b) b a
testM = T

test1 = testM >>= \x -> return x

test2  = do
   x <- testM
   return x


{-# LANGUAGE Arrows, RebindableSyntax #-}
module T4851 where

import Prelude hiding ( id, (.) )

import Control.Category ( Category(..) )
import Control.Arrow

garbage x =
  proc b ->
    do rec (c, d) <- undefined -< (b, d)
       returnA -< c


{-# LANGUAGE RebindableSyntax #-}
module Main (main) where

import Prelude

ifThenElse True t f = f
ifThenElse False t f = t

main = print (if True then 1 else 2 :: Int)
-- Should print 2!


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE
    ExplicitForAll
  , GADTs
  , RebindableSyntax #-}
module T5908
       ( Writer
       , runWriter
       , execWriter
       , WriterT
       , runWriterT
       , execWriterT
       , tell
       ) where

import Control.Category (Category (id), (>>>))

import Prelude hiding (Monad (..), id)
import qualified Prelude

newtype Identity a = Identity { runIdentity :: a }

class Monad m where
  (>>=) :: forall e ex x a b . m e ex a -> (a -> m ex x b) -> m e x b
  (>>) :: forall e ex x a b . m e ex a -> m ex x b -> m e x b
  return :: a -> m ex ex a
  fail :: String -> m e x a

  {-# INLINE (>>) #-}
  m >> k = m >>= \ _ -> k
  fail = error

type Writer w = WriterT w Identity

runWriter :: Writer w e x a -> (a, w e x)
runWriter = runIdentity . runWriterT

execWriter :: Writer w e x a -> w e x
execWriter m = snd (runWriter m)

newtype WriterT w m e x a = WriterT { runWriterT :: m (a, w e x) }

execWriterT :: Prelude.Monad m => WriterT w m e x a -> m (w e x)
execWriterT m = do
  ~(_, w) <- runWriterT m
  return w
  where
    (>>=) = (Prelude.>>=)
    return = Prelude.return

instance (Category w, Prelude.Monad m) => Monad (WriterT w m) where
  return a = WriterT $ return (a, id)
    where
      return = Prelude.return
  m >>= k = WriterT $ do
    ~(a, w) <- runWriterT m
    ~(b, w') <- runWriterT (k a)
    return (b, w >>> w')
    where
      (>>=) = (Prelude.>>=)
      return = Prelude.return
  fail msg = WriterT $ fail msg
    where
      fail = Prelude.fail

tell :: (Category w, Prelude.Monad m) => w e x -> WriterT w m e x ()
tell w = WriterT $ return ((), w)
  where
    return = Prelude.return


{-# LANGUAGE ScopedTypeVariables #-}
module Main where

-- Register Allocator Unit Tests
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- This file contains fine-grained tests of the register allocator
-- ("regalloc"), which maps variables onto real machine registers.
-- These tests require inspection and manipulation
-- of the register allocator's intermediate data structures.
--
-- The tests are enumerated in the "runTests" function--each returns a Bool
-- and runTests simply checks that none returned False.
-- (currently the only test is testGraphNoSpills--see its comments for
-- details)
--
-- If the tests pass it will print "All tests passed", otherwise it will
-- print which ones failed.
--
-- Also note: "on x86" means "as if we were compiling for x86"--this test
-- doesn't actually have to run on any particular architecture.

import qualified RegAlloc.Graph.Stats as Color
import qualified RegAlloc.Linear.Base as Linear
import qualified X86.Instr
import HscMain
import CgUtils
import AsmCodeGen
import CmmBuildInfoTables
import CmmPipeline
import CmmParse
import CmmInfo
import Cmm
import Module
import Debug
import GHC
import GhcMonad
import UniqFM
import UniqSupply
import DynFlags
import ErrUtils
import Outputable
import BasicTypes

import Stream (collect, yield)

import Data.Typeable
import Data.Maybe
import Control.Monad
import Control.Applicative
import Control.Exception (Exception, throwIO)
import System.Environment
import System.IO

main :: IO ()
main = do
    [libdir] <- getArgs

    --get a GHC context and run the tests
    runGhc (Just libdir) $ do
        dflags <- fmap setOptions getDynFlags
        reifyGhc $ \_ -> do
            us <- unitTestUniqSupply
            runTests dflags us

    return ()

    where setOptions = (flip gopt_set) Opt_RegsGraph

-- | TODO: Make this an IORef along the lines of Data.Unique.newUnique to add
-- stronger guarantees a UniqSupply won't be accidentally reused
unitTestUniqSupply :: IO UniqSupply
unitTestUniqSupply = mkSplitUniqSupply 't'

newtype RegAllocTestException = RegAllocTestException String
            deriving (Show, Typeable)

instance Exception RegAllocTestException

-- | a safer assert in the IO monad
-- perform some action if the passed Bool is false
assertOr :: (String -> IO ()) -> String -> Bool -> IO Bool
assertOr alt msg False = alt msg >> return False
assertOr _   msg True  = return True

-- | Raise an exception if the passed Bool is false
assertIO :: String -> Bool -> IO Bool
assertIO = assertOr $ \msg -> void (throwIO . RegAllocTestException $ msg)

-- | compile the passed cmm file and return the register allocator stats
-- ***NOTE*** This function sets Opt_D_dump_asm_stats in the passed
-- DynFlags because it won't work without it.  Handle stderr appropriately.
compileCmmForRegAllocStats ::
    DynFlags ->
    FilePath ->
    (DynFlags ->
        NcgImpl (Alignment, CmmStatics) X86.Instr.Instr X86.Instr.JumpDest) ->
    UniqSupply ->
    IO [( Maybe [Color.RegAllocStats (Alignment, CmmStatics) X86.Instr.Instr]
        , Maybe [Linear.RegAllocStats])]
compileCmmForRegAllocStats dflags' cmmFile ncgImplF us = do
    let ncgImpl = ncgImplF dflags
    hscEnv <- newHscEnv dflags

    -- parse the cmm file and output any warnings or errors
    ((warningMsgs, errorMsgs), parsedCmm) <- parseCmmFile dflags cmmFile

    -- print parser errors or warnings
    mapM_ (printBagOfErrors dflags) [warningMsgs, errorMsgs]

    let initTopSRT = emptySRT thisMod
    cmmGroup <- fmap snd $ cmmPipeline hscEnv initTopSRT $ fromJust parsedCmm

    rawCmms <- cmmToRawCmm dflags (Stream.yield cmmGroup)

    collectedCmms <- mconcat <$> Stream.collect rawCmms

    -- compile and discard the generated code, returning regalloc stats
    mapM (\ (count, thisCmm) ->
        cmmNativeGen dflags thisMod thisModLoc ncgImpl
            usb dwarfFileIds dbgMap thisCmm count >>=
                (\(_, _, _, _, colorStats, linearStats, _) ->
                -- scrub unneeded output from cmmNativeGen
                return (colorStats, linearStats)))
                $ zip [0.. (length collectedCmms)] collectedCmms

    where
          --the register allocator's intermediate data
          --structures are usually discarded
          --(in AsmCodeGen.cmmNativeGen) for performance
          --reasons.  To prevent this we need to tell
          --cmmNativeGen we want them printed out even
          --though we ignore stderr in the test configuration.
          dflags = dopt_set dflags' Opt_D_dump_asm_stats
          [usa, usb, usc, usd] = take 4 . listSplitUniqSupply $ us
          -- don't need debugging information
          dwarfFileIds = emptyUFM
          dbgMap = debugToMap []
          thisMod = mkModule
                        (stringToUnitId . show . uniqFromSupply $ usc)
                        (mkModuleName . show . uniqFromSupply $ usd)
          thisModLoc = ModLocation Nothing (cmmFile ++ ".hi") (cmmFile ++ ".o") (cmmFile ++ ".hie")

-- | The register allocator should be able to see that each variable only
-- has a dependency on the one before it and that therefore only 1 variable
-- is live after each computation, no spilling needed.
noSpillsCmmFile = "no_spills.cmm"

-- | Run each unit test in this file and notify the user of success or
-- failure.
runTests :: DynFlags -> UniqSupply -> IO ()
runTests dflags us = testGraphNoSpills dflags noSpillsCmmFile us >>= \res ->
                        if res then putStrLn "All tests passed."
                               else hPutStr stderr "testGraphNoSpills failed!"

-- | To map an unlimited number of abstract variables to a limited number of
-- real registers the allocator is sometimes forced to "spill" data that
-- isn't needed for the next instruction from a register into memory.
-- This is expensive so minimizing spills and reloads is a high priority.
--
-- testGraphNoSpills compiles the passed cmm file using the graph coloring
-- register allocator and asserts that it doesn't contain
-- any spill instructions.  This (very basic) test is for cases where
-- the register allocator should be able to do everything
-- (on x86) in the passed file without any spills or reloads.
--
testGraphNoSpills :: DynFlags -> FilePath -> UniqSupply -> IO Bool
testGraphNoSpills dflags' path us = do
        colorStats <- fst . concatTupledMaybes <$>
                        compileCmmForRegAllocStats dflags path x86NcgImpl us

        assertIO "testGraphNoSpills: color stats should not be empty"
                        $ not (null colorStats)

        -- spill, reload, and reg-reg moves for the cmm file we just
        -- compiled
        let srms = foldr (\(a, b, c) (x, y, z) ->
                    (a + x, b + y, c + z)) (0, 0, 0)
                    . mapMaybe extractSRMs $ colorStats

        assertIO
                ("testGraphNoSpills called with " ++ path
                    ++ ": (spill, reload, reg-reg) = " ++ show srms)
                (matchesExpected srms)

    where concatTupledMaybes :: [( Maybe [a], Maybe [b])] -> ([a], [b])
          concatTupledMaybes =
            -- either concat the underlying list or return the accumulator list
            let acc n = maybe n (++ n) in
              foldr (\(as, bs) (xs, ys) -> (acc xs as, acc ys bs)) ([], [])

          dflags = dflags' { optLevel = 2 }

          -- discard irrelevant stats
          extractSRMs x = case x of
                                Color.RegAllocStatsColored _ _ _ _ _ _ _ _
                                    rSrms -> Just rSrms
                                _ -> Nothing

          matchesExpected (a, b, c) = a == 0 && b == 0


-- !!! Checking that you can hide a constructor
module ShouldCompile where

import Rn037Help hiding( C )
        -- C is the constructor, but we should
        -- still be able to hide it

-- we should still be able to refer to the type constructor, though
type Foo = T


module Rn037Help( T(C) ) where

data T = C


-- !!! Checking that you can hide a constructor
module ShouldCompile where

import Rn037Help hiding( C )
        -- C is the constructor, but we should
        -- still be able to hide it

f x = Rn037Help.C


module A(method) where
class Class a where method :: a -> a


-- !!! Exporting a class method should not export the class too
module B where
import A
f :: Class a => a -> a
f = method


module A(foo, Bar(..)) where

foo :: Bar
foo = MkBar 42

data Bar = MkBar Int


module B(module A) where

import A hiding (Bar)
import A(Bar)


module C where

import B

baz :: Bar
baz = foo


module VersionGraphClient(
   VersionGraphClient,

   ) where

import ViewType

newtype VersionGraphClient = VersionGraphClient Int


{-
Bug report submitted by George Russell, 1/10/2004:

With both ghc6.2 and 6.2.20040915 on Linux, ghc --make cannot compile
the attached files and produces a confusing error message.

  # ghc --make View.hs
Chasing modules from: View.hs
Compiling ViewType         ( ./ViewType.hs, ./ViewType.o )
Compiling VersionGraphClient ( ./VersionGraphClient.hs, ./VersionGraphClient.o )Compiling View             ( View.hs, View.o )

View.hs:14:
     Couldn't match `VersionGraphClient' against `VersionGraphClient'
        Expected type: VersionGraphClient
        Inferred type: VersionGraphClient
     In the `graphClient1' field of a record
     In the record construction: View {graphClient1 = graphClient}

However ghc without make has no problems.

# ghc -c ViewType.hs
# ghc -c VersionGraphClient.hs
# ghc -c View.hs
-}

-- | This module defines the fundamental structure of the (untyped)
-- objects in a repository.
--
-- We depend circularly on CodedValue.hs.  This module is compiled
-- first and uses CodedValue.hi-boot.
module View(
   ) where

import ViewType
import VersionGraphClient

createView :: VersionGraphClient -> IO View
createView graphClient =
   do
      return (View {
         graphClient1 = graphClient
         })


module ViewType(

   View(..),
   ) where

import {-# SOURCE #-} VersionGraphClient

data View = View {
   graphClient1 :: VersionGraphClient
   }


module A (f, y) where

import B.C (T(..))

f (T x) = x

y = T 42


module Main (main, z) where

import A

main = print (f y)

z = y


module Main where

import System.Directory
import System.Environment

main :: IO ()
main = do d <- getCurrentDirectory
          putStr $ concatMap f d
    where f '\\' = "/"
          f c    = [c]


#!/usr/bin/env runhaskell
> module Main where
> import Distribution.Simple
> main :: IO ()
> main = defaultMain


module B.C where

newtype T = T Int
 deriving Show


{-# OPTIONS_GHC -fwarn-dodgy-imports #-}
module Dodgy where

import DodgyA (X(..))


{-# LANGUAGE TypeFamilies #-}

module DodgyA(C(..), X(..)) where

class C a where
  data X a

instance C Int where
  data X Int = X1 Bool


{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeApplications #-}

module ExplicitForAllRules1 where

import Data.Proxy
import Data.Kind

-- From Proposal 0007 (w/ fix to "example")

{-# RULES
"example"  forall a b. forall. map @a @b f = f
"example2" forall a. forall (x :: a). id x = x
  #-}

{-# NOINLINE f #-}
f :: a -> b
f = undefined

-- More tests

{-# RULES
"example3" forall (a :: Type -> Type) (b :: a Int) c. forall x y. g @(Proxy b) @(Proxy c) x y = ()
"example4" forall (a :: Bool) (b :: Proxy a). forall x. g @(Proxy b) @() x = id @()
"example5" forall (a :: Type). forall. h @a = id @a
"example5" forall k (c :: k). forall (x :: Proxy c). id @(Proxy c) x = x
  #-}

{-# NOINLINE g #-}
g :: a -> b -> ()
g _ _ = ()

{-# NOINLINE h #-}
h :: a -> a
h x = x

-- Should NOT have a parse error :(
{-# RULES "example6" forall a forall. g a forall = () #-}

-- Should generate a warning
{-# RULES "example7" forall a b. forall (x :: a). id x = x #-}


module Imp100Aux where
import Imp100

data T1 a
data T2 a b
data T3 a b c
data T4 a b c d
data T5 a b c d e
data T6 a
data T7 a b
data T8 a b c
data T9 a b c d
data T10 a b c d e


module Imp10Aux where
import Imp10
data T1 a
data T2 a b
data T3 a b c
data T4 a b c d
data T5 a b c d e
data T6 a
data T7 a b
data T8 a b c
data T9 a b c d
data T10 a b c d e


module Imp500Aux where
import Imp500

data T1 a
data T2 a b
data T3 a b c
data T4 a b c d
data T5 a b c d e
data T6 a
data T7 a b
data T8 a b c
data T9 a b c d
data T10 a b c d e


{-# Language NoImplicitPrelude #-}
module LookupSub where
import qualified LookupSubA
import qualified LookupSubB

data FD = FD

getEcho = FD

instance LookupSubA.IODevice FD where
  getEcho = getEcho


module LookupSubA where

class IODevice a where
  getEcho :: a


module LookupSubB where

getEcho = undefined


{-# LANGUAGE MonadComprehensions, TransformListComp #-}

-- Test performed for TransformListComp and should work for monad comp aswell:
-- GHC 7.0.1 failed because the renamer didn't attach
-- all the used variables to the TransformListComp constructor

module List where

intersectFront :: Ord a => [a] -> [a] -> [a]
intersectFront xs ys = [x | (x,y) <- zip xs ys, then takeWhile by x == y]


{-# OPTIONS_GHC -fwarn-unused-matches #-}
{-# LANGUAGE MonadComprehensions, ParallelListComp #-}
-- Test for parallel list comp should work for monad comp aswell:
--
-- GHC 6.4 erroneously reported that the
-- bindings for q and z were unused
--
-- Note the parallel list comprehension,
-- which was the cause of the trouble

module ShouldCompile where

t :: [Int]
t = [ q | y <- [1..10]
        | z <- [30..40], let q = z*z]


{-# LANGUAGE RecordWildCards, MonadComprehensions, TransformListComp, NamedFieldPuns #-}

module T3901 where

import GHC.Exts (groupWith)

data Rec = Rec {a :: Int} deriving (Show)

recs1 = [a | Rec {a=a} <- [Rec 1], then group by a using groupWith]

recs2 = [a | Rec {a} <- [Rec 1], then group by a using groupWith]

recs3 = [a | Rec {..} <- [Rec 1], then group by a using groupWith]

recs4 :: [[Int]]
recs4 = [a | Rec {..} <- [Rec 1], then group by a using groupWith]


{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE MonadComprehensions, ParallelListComp #-}
-- Test for parallel list comp, which should work for monad comp as well:
--
-- On GHC 6.0 and earlier, this parallel list comprehension generated
-- an incorrect unused-binding warning.

module ShouldCompile where

t :: [(Char,Char)]
t = [ (a,b) | a <- "foo" | b <- "bar" ]


module Foo (f) where
-- export food
f x = x

-- !!! weird patterns with no variables
1  = f 1
[] = f []
1  = f (f 1)
[] = f (f [])


-- !!! rn005: simplest case: a few non-recursive bindings

module Test where

f = []
g x = x
h x y = x
i x y z = x


-- !!! rn006: two sets of mutually-recursive blobs:
-- !!!  f, g, h are mut rec
-- !!!  i, j, k are mut rec

module Test where

f x = g x x
i x = j x x

g x y = h x x y
j x y = k x x y

h x y z = f z
k x y z = i z


module Imp10 where
import {-# SOURCE #-} Imp10Aux


module Imp100 where
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10
import {-# SOURCE #-} Int10


module Imp100 where
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux
import {-# SOURCE #-} Imp100Aux


module Imp500 where
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux
import {-# SOURCE #-} Imp500Aux


module Mod10 where

data T1 a = C1 a

data T2 a b = T2C1 a | T2C2 b

data T3 a b c = T3C1 a | T3C2 b | T3C3 c

data T4 a b c d = T4C1 a | T4C2 b | T4C3 c | T4C4 d

data T5 a b c d e = T5C1 a | T5C2 b | T5C3 c | T5C4 d | T5C5 e

data T6 a = T6C6 a

data T7 a b = T7C6 a | T7C7 b

data T8 a b c = T8C1 a | T8C2 b | T8C3 c

data T9 a b c d = T9C1 a | T9C2 b | T9C3 c | T9C4 d

data T10 a b c d e = T10C1 a | T10C2 b | T10C3 c | T10C4 d | T10C5 e


-- !! Rexporting
module Test ( module Test , module RnAux017 ) where

import {-# SOURCE #-} RnAux017

f x = x

data Foo = MkFoo

class FOO a where
    op :: a -> Int

instance FOO Foo where
    op x = 42


module Silly (
        Data.Array.accum
  ) where
import qualified Data.Array


-- !!! Duplicate fields in record decls

module OK where

data X = A {a :: Int} | B {a :: Int}

f x = x

-- data Y = V {a :: Int}

-- f y = y


-- this is legal, I think (WDP)

module Confused where

import Prelude hiding (otherwise)

otherwise = False

f x | otherwise = 1

g otherwise | otherwise = 2


-- !! This one is fine in Haskell 1.4
--
module Foo ( Bar(..) ) where { data Bar = Bar X; data X = Y }


-- !! This is fine in Haskell 1.4
--
module Foo ( Baz(..) ) where

class Baz a where
    opx :: Int -> Bar -> a -> a

data Bar = Bar X
data X = Y


-- !!! Re-exporting a module whose contents is partially hidden.
module ShouldCompile ( module Data.List ) where

import Data.List hiding ( sort )


-- !!! Checking that more than imported module can share a local
-- !!! local alias.
module ShouldCompile where

import qualified Data.List  as X
import qualified Data.Maybe as X

x :: Ord a => [a] -> [a]
x = X.sort

y :: Maybe a -> Bool
y = X.isJust


-- !!! Checking that an imported module may still have
-- !!! a local alias without having used 'qualified'.
module ShouldCompile where

import Data.List  as X
import Data.Maybe as X

x :: Ord a => [a] -> [a]
x = X.sort

y :: Maybe a -> Bool
y = X.isJust


-- !!! Checking that a toplevel declaration 'f' in module M is accessible
-- !!! as both 'f' and 'M.f' within the scope of M. Similarly for imported
-- !!! entities.
module ShouldCompile where

import Data.List ( sort )

x :: Int
x = 2

y :: Int
y = x

z :: Int
z = ShouldCompile.x

sortOf :: Ord a=> [a] -> [a]
sortOf = Data.List.sort


-- !!! Checking that lazy name clashing works.
module ShouldCompile where

import Data.List ( reverse, sort )

sort :: Int     -- Clashes with Data.List.sort,
sort = 4        -- but never used, so OK

reverse :: Int  -- Clashes with Data.List.reverse,
reverse = 3     -- but the only uses are qualified

x = ShouldCompile.reverse

y = Data.List.reverse


-- !!! Checking that an imported module may still have
-- !!! a local alias without having used 'qualified'.
module ShouldCompile where

import Data.List  as X
import Data.Maybe as X

x :: Ord a => [a] -> [a]
x = X.sort

y :: Maybe a -> Bool
y = isJust


-- !!! Checking that lazy name clashing works
module ShouldCompile where

import Data.List ( sort )

sort :: Int
sort = 3

foo :: Int
foo = ShouldCompile.sort

baz :: (Ord a) => [a] -> [a]
baz = Data.List.sort


-- !!! Checking that empty declarations are permitted.
module ShouldCompile where

class Foo a where

class Foz a

x = 2 where
y = 3

instance Foo Int where


-- !!! Checking what's legal in the body of a class declaration.
module ShouldCompile where

class Foo a where {
  (--<>--) :: a -> a -> Int  ;
  infixl 5 --<>-- ;
  (--<>--) _ _ = 2 ; -- empty decl at the end.
};


-- !!! Checking that qualified method names are legal in instance body.
--     but not (now -- Aug 02) in the binding position
module ShouldCompile where

import Prelude hiding (Eq, (==))
import Prelude as P (Eq,(==))

data Foo = Foo Int Integer

instance P.Eq Foo where
  (Foo a1 b1) == (Foo a2 b2) = a1 P.== a2 && b1 P.== b2


{-# OPTIONS -fwarn-unused-imports #-}
-- !!! test unused import warning
import Data.List
main = return () :: IO ()


{-# OPTIONS -fwarn-name-shadowing #-}
module ShouldCompile where

-- !!! test shadowing of a global name

g = 42 where f -1 = -1  -- shadows (-), probably by accident!


{-# OPTIONS -fwarn-unused-binds #-}
module ShouldCompile where

-- !!! should produce warnings about unused identifiers
x :: [()]
x = [ () | y <- [] ]

z = do w <- getContents; return ()


{-# OPTIONS -fwarn-unused-binds #-}

-- Test reports of unused bindings

module ShouldCompile( t ) where

f x = f x       -- Unused

g x = h x       -- Unused
h x = g x

t x = t x       -- Used by export list


-- Record field selectors imported alone; should be ok

module M where

import Rn042_A( field )


module Rn042_A( Type(..) ) where

data Type a = Constr { field :: a }


-- This one should succeed; M.x is unambiguous

module ShouldCompile (module M) where

 import Rn043_A as M    -- x, M.x
 import Rn043_B         -- x, Rn043_A.x


-- This one should succeed; x is unambiguous, even
-- though M.x is not

module ShouldCompile (module M) where

import qualified Rn044_A as M  -- M.x
import Rn044_B as M            -- x, M.x


{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE ParallelListComp #-}
-- On GHC 6.0 and earlier, this parallel list comprehension generated
-- an incorrect unused-binding warning.

module ShouldCompile where

t :: [(Char,Char)]
t = [ (a,b) | a <- "foo" | b <- "bar" ]


module ShouldCompile where
import Data.List (nub) -- all unused
import Data.Char (ord, chr)  -- some unused

x = chr 42


{-# OPTIONS_GHC -fwarn-unused-matches #-}
{-# LANGUAGE ParallelListComp #-}
-- GHC 6.4 erroneously reported that the
-- bindings for q and z were unused
--
-- Note the parallel list comprehension,
-- which was the cause of the trouble

module ShouldCompile where

t :: [Int]
t = [ q | y <- [1..10]
        | z <- [30..40], let q = z*z]


{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -W #-}
-- Produced a bogus unused-import warning in versions of GHC 6.6

module Bug ( Structure (..) ) where

import Prelude hiding( Rational )
   -- Rational is exported by Prelude
import Data.Ratio ( Rational )

data Structure a where
   StructCons  :: Int   -> Structure Int
   StructRatio ::          Structure Rational


-- GHC 6.4.1 said
--  test.hs:1:5:
--     Warning: accepting non-standard pattern guards
--              (-fglasgow-exts to suppress this message)
--         [x <- ((1 * 2) + 3) * 4, undefined]
-- Note the wrongly-parenthesised expression

{-# LANGUAGE Haskell98 #-}

module ShouldCompile where

main | x <- 1*2+3*4 = x


{-# OPTIONS_GHC -fwarn-warnings-deprecations #-}

-- Test deprecation of constructors and class ops

module ShouldCompile where

import Rn050_A

instance Foo T where
  op x  = x
  bop y = y

foo = op C


module Rn050_A where

{-# DEPRECATED C "Use D instead" #-}
{-# DEPRECATED op "Use bop instead" #-}

data T = C | D

class Foo a where
  op :: a -> a
  bop :: a -> a


{-# OPTIONS -XNoImplicitPrelude #-}

-- This one crashed GHC 6.6 in lookupDeprec
-- See Trac #1128
-- and Note [Used names with interface not loaded]
-- in RnNames

module ShouldCompile where

import Prelude

foo :: Int -> Float
foo x = 3.0


module Rn052 where

import qualified Rn052Aux

data D = D

instance Rn052Aux.C D where
    f _ = True


module Rn052Aux where

class C a where
    f :: a -> Bool


module Rn053 (D(C1, C2)) where

import qualified Rn053_A
import           Rn053_A hiding (D(..))
import           Rn053_B


module Rn054 where

import Data.Bits (shiftL)


{-# OPTIONS_GHC -fwarn-implicit-prelude -fwarn-unused-imports #-}
module ShouldCompile where

-- !!! should produce warnings about implicitly imported Prelude
--     (but not about the implicit import being unused)


{-# OPTIONS_GHC -fwarn-implicit-prelude -fwarn-unused-imports #-}
module ShouldCompile where

import Prelude ()

-- !!! should produce no warnings
--     (the other use of importing nothing is
--     to nullify the implicit import of the Prelude)


{-# OPTIONS_GHC -fwarn-implicit-prelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
module ShouldCompile where

-- !!! should produce no warning


{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS_GHC -fwarn-unused-imports #-}

-- Trac #1386
-- We do not want a warning about unused imports

module Foo () where

import Control.Monad (liftM)

foo :: IO ()
foo = id `liftM` return ()

foreign export ccall "hs_foo" foo :: IO ()


{-# OPTIONS_GHC -XDisambiguateRecordFields #-}

module Foo () where

import Rn059_A
import Rn059_B

a = A { label = 'a' }

b = B { label = 'b' }

f (A { label = a }) (B { label = b }) = (a,b)


module Rn059_A where

data A = A { label :: Char }


module Rn059_B where

data B = B { label :: Char }


module Foo (module Data.List) where

import Data.List
import Data.List as Foo


-- Trac #2055

module Foo where

import qualified Data.List

foo genericReplicate = genericReplicate True


{-# OPTIONS_GHC -Wall #-}

module Foo where

-- We should complain that both x and y are unused.
-- We used to not warn for recursive bindings, like x (trac #2136).

v :: a
v = let x = x in undefined

w :: a
w = let y = 'a' in undefined


{-# OPTIONS_GHC -Wall #-}

module Foo where

-- We should complain that the first r shadows the second one, and give
-- the right locations for the two of them. (trac #2137)

z :: a
z = r
    where
        _a = 'a'
        _f r = r
        _b = 'b'
        r = undefined
        _c = 'c'


{-# LANGUAGE RecordWildCards #-}

-- trac #1491

module Foo where

import Rn065A

f T{..} = a + 1


module Rn065A where

data T = T { a :: Int }


{-# OPTIONS_GHC -fwarn-warnings-deprecations #-}

-- Test warnings on constructors and class ops

module ShouldCompile where

import Rn066_A

instance Foo T where
  op x  = x
  bop y = y

foo = op C


module Rn066_A where

{-# WARNING C "Are you sure you want to do that?" #-}
{-# WARNING op "Is that really a good idea?" #-}

data T = C | D

class Foo a where
  op :: a -> a
  bop :: a -> a


module ShouldCompile where

import Rn067_A

x = 'a'

-- The use of x here should not be reported as ambiguous, as it refers
-- to the local variable.
--
-- hugs Sept 2006 says:
--
-- ERROR "rn067.hs":14 - Ambiguous variable occurrence "x"
test = let x = "" in x


module Foo where

data A = A1 { a, b :: Int }
       | A2 { a, b :: Int }
       | A3 { a, b :: Int }


module RnAux017 where
import Test     -- Import main module so there really is a loop
                -- (avoid warning message)
data Wibble = Wibble
data Wobble = Wobble

a :: Int -> Int
a = undefined

b :: Int -> Int
b = undefined

c :: Int -> Int
c = undefined


{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS_GHC -Wall -Wno-name-shadowing #-}

module T10625 where

data Ex a = forall a. Ex a


module Foo (Monad(..)) where

import Prelude (Monad((>>=), return))


{-# LANGUAGE TypeOperators, TypeFamilies #-}
module T10816 where

class C a where
  type a # b
  infix 4 #

  type a *** b
  type a +++ b
  infixr 5 ***, +++
  (***), (+++) :: a -> a -> a


{-# LANGUAGE TypeFamilies #-}
module T11164a where

data family T a


{-# LANGUAGE TypeFamilies #-}
module T11164b where

import T11164a

data instance T Int = MkT


module T11167 where

data SomeException

newtype ContT r m a = ContT {runContT :: (a -> m r) -> m r}

runContT' :: ContT r m a -> (a -> m r) -> m r
runContT' = runContT

catch_ :: IO a -> (SomeException -> IO a) -> IO a
catch_ = undefined

foo :: IO ()
foo = (undefined :: ContT () IO a)
        `runContT` (undefined :: a -> IO ())
        `catch_` (undefined :: SomeException -> IO ())

foo' :: IO ()
foo' = (undefined :: ContT () IO a)
         `runContT'` (undefined :: a -> IO ())
         `catch_` (undefined :: SomeException -> IO ())


{-# LANGUAGE DuplicateRecordFields #-}
module T11167_ambig where

data SomeException

newtype ContT r m a = ContT {runContT :: (a -> m r) -> m r}
newtype ContT' r m a = ContT' {runContT :: (a -> m r) -> m r}

runContT' :: ContT r m a -> (a -> m r) -> m r
runContT' = runContT

catch_ :: IO a -> (SomeException -> IO a) -> IO a
catch_ = undefined

foo :: IO ()
foo = (undefined :: ContT () IO a)
        `runContT` (undefined :: a -> IO ())
        `catch_` (undefined :: SomeException -> IO ())

foo' :: IO ()
foo' = (undefined :: ContT () IO a)
         `runContT'` (undefined :: a -> IO ())
         `catch_` (undefined :: SomeException -> IO ())


module T11624 where
import T11624a
concat :: Int -> Int
concat n = n + 2


module T11624a where
import {-# SOURCE #-} T11624
import Prelude ()
x = concat 3


{-# LANGUAGE NamedFieldPuns #-}
module T11662 where

import T11662_A (Rec (Rec))
import qualified T11662_A

g :: Rec -> Integer
g (Rec { T11662_A.f }) = f

h :: Integer -> Rec -> Rec
h f r = r { T11662_A.f }

k :: Integer -> Rec
k f = Rec { T11662_A.f }


module T11662_A where

data Rec = Rec { f :: Integer }


module T12127 where

import T12127a( T(..), C(..) )


{-# LANGUAGE TypeFamilies #-}

module T12127a where

class C a where
  data T a

instance C Int where
  data T Int = MkT { x, y :: Int }


{-# LANGUAGE ScopedTypeVariables, DefaultSignatures #-}

module T12533 where

class Foo x where
  foo :: forall a . x a -> x a
  default foo :: forall a . x a -> x a
  foo x = go
    where go :: x a
          go = undefined


{-# OPTIONS_GHC -Wunused-binds #-}
{-# LANGUAGE PatternSynonyms #-}

module Foo (pattern P) where

-- x is used!!
x :: Int
x = 0

pattern P :: Int
pattern P <- _ where
        P = x


{-# OPTIONS_GHC -Wmissing-signatures #-}

module T12597 where

f x = x


{-# OPTIONS_GHC -Wunused-imports #-}
module T13064 where

import Control.Applicative
import Prelude (IO, pure)   -- Import of 'pure' is redundant

foo :: IO ()
foo = () <$ pure ()


module Bug where

newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }

foo bar baz = (`runContT` bar.baz)


{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE BangPatterns #-}

module T13646 where

import Control.Exception

foo :: IO ()
foo = do let !() = assert False ()
             -- Should not give a warning

         let () = assert False ()
             -- Should give a warning

         pure ()


module T14487 where

import T14487A hiding (duplicateName)

test = X duplicateName

duplicateName = 5


{-# LANGUAGE DuplicateRecordFields #-}

module T14487A where

data X = X {
    duplicateName :: Int
}


{-# LANGUAGE PatternSynonyms, DisambiguateRecordFields #-}

module T14747 where

import T14747A

pattern T{x} = [x]

e = S { x = 42 }


{-# LANGUAGE PatternSynonyms #-}

module T14747A where

pattern S{x} = [x]


module T14881 where

import qualified T14881Aux as Aux (L(Cons), x, tail, adjust, length)

x = Aux.Cons


module T14881Aux where

-- unambiguous function name.
adjust :: ()
adjust = undefined

-- ambiguous function name.
length :: ()
length = undefined

data L = Cons { x :: Int      -- unambiguous field selector
              , tail :: [Int] -- ambiguous field selector
              }


{-# LANGUAGE DisambiguateRecordFields #-}
module Main where
import T15149B
import T15149C
main = do print (AnDouble{an=1}, AnInt{an=1})


{-# LANGUAGE TypeFamilies #-}
module T15149A where

import Data.Kind (Type)

data family An c :: Type


{-# LANGUAGE TypeFamilies #-}
module T15149B where
import T15149A
data instance An Int = AnInt {an :: Int} deriving Show


{-# LANGUAGE TypeFamilies #-}
module T15149C where
import T15149A
data instance An Double = AnDouble {an :: Double} deriving Show


{-# LANGUAGE DerivingStrategies #-}

{-# OPTIONS_GHC -Wmissing-deriving-strategies #-}

module T15798a () where

data Foo a = Foo a
  deriving stock (Eq)

data Bar a = Bar a
  deriving (Eq, Show)
  deriving stock (Ord)


{-# LANGUAGE StandaloneDeriving #-}

{-# OPTIONS_GHC -Wmissing-deriving-strategies #-}

module T15798b () where

data Foo a = Foo a

deriving instance Eq a => Eq (Foo a)


{-# OPTIONS_GHC -Wmissing-deriving-strategies #-}

module T15798c () where

data Foo a = Foo a
  deriving (Eq)


{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module T15957 where

data P = P { x :: Int, y :: Int }

g1 P{..} = x + 3 -- x from .. is used
g2 P{x, ..} = x + y -- y from .. is used, even if it's in a weird style

old P{..} | x < 5 = 10

-- Record wildcards in lets have different scoping rules.. they bring
-- all the identifiers into scope
do_example :: IO Int
do_example = do
  let P{..} = P 1 2
  return $ x + y

let_in_example =
  let P{..} = P 1 2
  in x + 4


module T15994 where

import System.IO

f = [ReadMode, ReadMode]


{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module T16616a where

class C a where
  type T a b

instance C (Maybe a) where
  type forall b. T (Maybe a) b = Either a b


{-# OPTIONS_GHC -fwarn-missing-import-lists #-}

-- Test Trac #1789
module T1789 where

import Prelude
import Data.Map
import Data.Map (size)
import Data.Maybe (Maybe(..))
import Data.Maybe hiding (isJust)
import qualified Data.Set as Set


{-# OPTIONS_GHC -fwarn-missing-import-lists #-}

-- Test Trac #1789
module T1789_2 where

import Data.Map (size)
import Data.Maybe (Maybe(Just, Nothing))
import qualified Data.Set as Set (insert)


module T1792_imports (B.putStr, z, zipWith) where

import qualified Data.ByteString as B (putStr, readFile, zip, zipWith)

z = B.readFile


{-# OPTIONS_GHC -fwarn-unused-top-binds #-}

-- Trac #17

module Temp (foo, bar, quux) where

top :: Int
top = 1

foo :: ()
foo = let True = True in ()

bar :: Int -> Int
bar match = 1

quux :: Int
quux = let local = True
       in 2


{-# OPTIONS_GHC -fwarn-unused-local-binds #-}

-- Trac #17

module Temp (foo, bar, quux) where

top :: Int
top = 1

foo :: ()
foo = let True = True in ()

bar :: Int -> Int
bar match = 1

quux :: Int
quux = let local = True
       in 2


{-# OPTIONS_GHC -fwarn-unused-pattern-binds #-}

-- Trac #17

module Temp (foo, bar, quux) where

top :: Int
top = 1

foo :: ()
foo = let True = True in ()

bar :: Int -> Int
bar match = 1

quux :: Int
quux = let local = True
       in 2


{-# OPTIONS_GHC -fwarn-unused-matches #-}

-- Trac #17

module Temp (foo, bar, quux) where

top :: Int
top = 1

foo :: ()
foo = let True = True in ()

bar :: Int -> Int
bar match = 1

quux :: Int
quux = let local = True
       in 2


{-# OPTIONS_GHC -fwarn-unused-binds #-}

-- Trac #17

module Temp (foo, bar, quux) where

top :: Int
top = 1

foo :: ()
foo = let True = True in ()

bar :: Int -> Int
bar match = 1

quux :: Int
quux = let local = True
       in 2


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -Werror #-}
module Bug(P) where

newtype P a = P (IO a) deriving (Functor, Applicative, Monad)


{-# OPTIONS_GHC -fwarn-name-shadowing -fwarn-unused-binds #-}

-- Trac #1972

module Temp where

import Data.List

data Data = Data {name :: String}

h :: a -> a
h name = name

f mapAccumL x = x

mapAccumL y = y

test x = a+b
  where
    (a,b,c) = x


{-# OPTIONS_GHC -XTypeOperators #-}

-- Test fixity of type operators
-- Trac #2205

module ShouldCompile where

 infixr 0 :->
 data a :-> b = P a b

 fst3:: (a :-> (b :-> c)) -> a
 fst3 (P a (P b c)) = a

 fst3':: (a :-> b :-> c) -> a
 fst3' (P a (P b c)) = a


{-# LANGUAGE TypeFamilies,EmptyDataDecls,MultiParamTypeClasses #-}
module Test where

type family Fam1 a

class C b where
    f :: ( Fam1 s ~ () ) => b -> s


{-# LANGUAGE TypeFamilies #-}
module Bar where
import qualified T2435Foo as Foo
instance Foo.C Int where type T Int = Int


{-# LANGUAGE TypeFamilies #-}
module T2435Foo where
class C a where type T a


{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fwarn-duplicate-exports #-}

module T2436( C(..), T(..), module T2436a, S(..) ) where

import T2436a

class C a where
  data T a

instance C Int where
  data T Int = TInt Int

data instance S Int = SInt


{-# LANGUAGE TypeFamilies #-}
module T2436a( S ) where

data family S a


-- Trac #2506

module ShouldCompile where
import Control.Exception (assert)

foo = True `assert` ()


{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

module T2600 where

-- ** See trac #10595 for why we're okay with this generating warnings! **

class T t where
    to :: [a] -> t a
    from :: t a -> [a]
    tmap :: (a -> a) -> t a -> t a

{-# RULES

"myrule" forall t a. forall f x.
     from (tmap f (to x :: t a)) = map f (from (to x :: t a))

  #-}


{-# LANGUAGE TypeFamilies, RecordWildCards #-}
module AssocWildCards where

class FooClass a where
   data FooType a

instance FooClass Int where
   data FooType Int = FooInt { fooIntVal :: Int }

fooInt :: Int -> FooType Int
fooInt fooIntVal = FooInt{..}

fromFooInt :: FooType Int -> Int
fromFooInt (FooInt{..}) = fooIntVal


{-# OPTIONS_GHC -Werror -fwarn-unused-binds #-}

-- Test Trac #3221: the constructors are used by the deriving
--                  clause, even though they are not exported

module T3221( Foo ) where

data Foo = Bar | Baz  deriving (Show,Read)


{-# OPTIONS -fwarn-name-shadowing #-}

-- Trac #3262: report shadowing in g but not f

module T3262 where

f x = let _ignored = 10 in
      let _ignored = 20 in
      x + _ignored

g x = let not_ignored = 10 in
      let not_ignored = 20 in
      x + not_ignored

mf x = do let _ignored = 10
          let _ignored = 20
          return (x + _ignored)

mg x = do let not_ignored = 10
          let not_ignored = 20
          return (x + not_ignored)


{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fwarn-unused-matches #-}

-- Should warn about the unused 'a', but not about the unused 'c'

module T3371(bar) where

data Foo = Foo { a,b,c :: Int } deriving(Eq)

bar Foo{ a = a, ..} = print b


module T3449 (Foo, f1) where

import T3449A

class Foo a where
    f1 :: a
    f2 :: a

instance Foo Char where
    f1 = f2
    f2 = aChar


module T3449A where

import {-# SOURCE #-} T3449

z :: Foo a => a
z = f1

aChar :: Char
aChar = 'a'


{-# LANGUAGE NamedFieldPuns #-}

module T3640 where

data Record = Record { f1, f2, f3 :: Int }

goodPun Record{f1,f2,f3} = f1 + f2 + f3

badPun r = f1 + f2 + f3
    where Record{f1=f1,f2,f3} = r


module T3823A where

import T3823B

data A = X { x :: Bool } | Y

y :: A -> A
y = \_ -> Y


module T3823B where

import {-# SOURCE #-} T3823A

data B = A A

a = x (X True)
b = y a


{-# LANGUAGE RecordWildCards, TransformListComp, NamedFieldPuns #-}

module T3901 where

import GHC.Exts (groupWith)

data Rec = Rec {a :: Int} deriving (Show)

recs1 = [a | Rec {a=a} <- [Rec 1], then group by a using groupWith]

recs2 = [a | Rec {a} <- [Rec 1], then group by a using groupWith]

recs3 = [a | Rec {..} <- [Rec 1], then group by a using groupWith]

recs4 :: [[Int]]
recs4 = [a | Rec {..} <- [Rec 1], then group by a using groupWith]


{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE ViewPatterns #-}

module T3943 where

-- Note that 'r' is used, in the view pattern
-- The bug was that 'r' was reported unused

test :: ([a], [a]) -> [a]
test x = let (r,(r++) -> rs) = x in rs


{-# LANGUAGE DeriveDataTypeable #-}

module T4003A where

import T4003B

import Data.Data

data MyId = MyId
    deriving (Data, Typeable)

data HsExpr id
  = HsOverLit (HsOverLit id)
  | HsBracketOut (HsExpr MyId)
  deriving (Data, Typeable)


{-# LANGUAGE DeriveDataTypeable #-}

module T4003B where

import {-# SOURCE #-} T4003A (HsExpr)

import Data.Data

data HsLit = HsChar
  deriving (Data, Typeable)

data HsOverLit id
  = OverLit (HsExpr id)
  deriving (Data, Typeable)

data OverLitVal = HsIntegral
  deriving (Data, Typeable)


{-# LANGUAGE TypeOperators #-}

module T4239A where

data (:+++) = (:+++)
            | (:---)
            | X
            | Y

(Â·) = undefined


module T4240 where

import T4240B

v :: Int
v = m


module T4240A where

class C a where
    m :: a

instance C Int where
    m = 5


{-# LANGUAGE RankNTypes #-}

module T4426 where

-- GHC 8.0 no longer allows implicit quantification
-- on the RHS.  This is more consistent:
--       type F a = a -> m a
-- has always been rejected and hence so should
-- these four.  (It was already deprecated in 7.10.)
type F a = Monad m => a -> m a

data X a = X (Eq b => a -> b)

data Y a = Y { k :: Eq b => a -> b -> c }

f :: forall b. (Monad m => m b) -> b
f = undefined

-- But these ones are fine:
type F' a = forall m. Monad m => a -> m a

data X' a = X' (forall b. Eq b => a -> b)

data Y' a = Y' { k' :: forall b c. Eq b => a -> b -> c }

f' :: forall b. (forall m. Monad m => m b) -> b
f' = undefined


-- We don't want to warn about duplicate exports for things exported
-- by both "module" exports
module T4478 (module Prelude, module Data.List) where

import Prelude
import Data.List


{-# OPTIONS_GHC -fwarn-missing-import-lists #-}
module T4489 where

import Data.Maybe
import Data.Maybe( Maybe(..) )
import Data.Maybe( Maybe(Just) )


{-# LANGUAGE TransformListComp #-}

-- GHC 7.0.1 failed because the renamer didn't attach
-- all the used variables to the TransformListComp constructor

module List where

intersectFront :: Ord a => [a] -> [a] -> [a]
intersectFront xs ys = [x | (x,y) <- zip xs ys, then takeWhile by x == y]


{-# LANGUAGE TypeFamilies #-}
module T5306 where

import T5306b(F(FInt))   -- succeeds
import T5306a(F(FBool))  -- failed (before fix)


{-# LANGUAGE TypeFamilies #-}
module T5306a( F(..) ) where
import T5306b

data instance F Bool = FBool


{-# LANGUAGE TypeFamilies #-}
module T5306b where

data family F a
data instance F Int = FInt


{-# LANGUAGE GADTs, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}

module Foo where

data T a

data S = forall a.S1

data W where
  W1 :: forall a. W

f :: forall a. Int
f = 3


{-# LANGUAGE RecordWildCards #-}

module T5334 where

data T = T { a, b :: Int }

t = T {..}
  where
     a = 1
     -- b = 2

data S = S { x, y :: Int }

s = S { x = 1 }


{-# LANGUAGE RecordWildCards #-}
module Main where

import qualified T5592a as MR (MyRecord(MyRecord, field))

main
  = do { let field = "Hello, world!"
             rec = MR.MyRecord {..}
       ; print rec }


module T5592a where

data MyRecord = MyRecord { field :: String }
  deriving (Show)


module T5867( f ) where
import T5867a

boo = f
bar = f


module T5867a where

{-# DEPRECATED f "Don't use f!" #-}
f x = x


{-# LANGUAGE TypeOperators #-}

module T6027 where

data (?) a b = Q a b

infixr 2 ?

test :: Int ? String ? Bool
test = 0 `Q` ("foo" `Q` True)


{-# LANGUAGE ViewPatterns, BangPatterns #-}

module T6038 where

data T = MkT { x,y :: Int }

f (MkT { x = !v, y = negate -> w }) = v + w


module T6120 where

infix 3 +++

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

{-# DEPRECATED fail "fail is deprecated" #-}
fail :: String -> String
fail = id


module T7007 where

import Data.Monoid( Monoid(..) )

infixr 5 ++   -- This unambiguously refers to the local definition

(++) :: Monoid a => a -> a -> a
(++) = mappend


{-# OPTIONS_GHC -fwarn-unused-binds #-}

module ShouldFail where

foo :: Int -> Int
foo n = n + 1
   where
     Nothing = Just n


module T7145a ( Applicative(pure) ) where


{-# LANGUAGE CPP #-}
module T7145b ( A.Applicative(pure) ) where

import qualified Control.Applicative as A

pure :: ()
pure = ()


{-# OPTIONS_GHC -fwarn-dodgy-imports #-}

module T7167 where

import Data.List hiding (foo)


module T7336 ( U, T ) where

data U = MkU deriving Show
-- Want to report MkU as unused

data T = MkT deriving Read
-- But MkT is not unused; we might
-- parse a string to generate it


module T7672 where
import qualified T7672a as XX
data T = S XX.T


module T7672a(Decl.T) where
import {-# SOURCE #-} qualified T7672 as Decl


module T7963 where

import Prelude hiding (unlines)
import T7963a (unlines)

foo :: IO ()
foo = writeFile "/tmp/foo" (unlines ["hello", "world"])


module T7963a where

import Prelude ()
import GHC.List

unlines = concat


{-# LANGUAGE StandaloneDeriving #-}
module T7969 where
import T7969a

deriving instance Eq T


{-# LANGUAGE BangPatterns #-}
module T9127 where

f = let !_ = 2 * 2
    in 2*2


{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module T9778 where

data T = A | B

data G a where
  C :: G A


{-# LANGUAGE NoImplicitPrelude, GeneralizedNewtypeDeriving #-}

module Foreign.Ptr () where

import GHC.Show (Show(..))
import GHC.Word (Word)
import GHC.Base (Num)

newtype WordPtr = WordPtr Word
    deriving Num


\begin{code}
{-# LANGUAGE NoImplicitPrelude #-}

module GHC.Base
        (
        module GHC.Classes,
        module GHC.Prim,
        Num(..)
  ) where

import GHC.Classes
import GHC.Prim

class Num a  where
    signum    :: a -> a
\end{code}


{-# LANGUAGE NoImplicitPrelude #-}

module GHC.Num (fromInteger) where

import GHC.Base
import GHC.Integer

fromInteger :: Num a => Integer -> a
fromInteger = fromInteger


\begin{code}
{-# LANGUAGE NoImplicitPrelude #-}

module GHC.Show (Show(..)) where

import GHC.Types

class  Show a  where
    show      :: a   -> [Char]
\end{code}


{-# LANGUAGE NoImplicitPrelude #-}

module GHC.Unicode ( ) where

import GHC.Show ()


{-# LANGUAGE NoImplicitPrelude, MagicHash #-}

module GHC.Word (
    Word(..),
    ) where

import GHC.Base
import GHC.Types
import GHC.Num ()

import {-# SOURCE #-} GHC.Unicode ()

instance Num Word where
    signum 0               = 0
    signum _               = 1


{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TypeApplications #-}

module ExplicitForAllRules2 where

{-# RULES "new4" forall a. forall (x :: b). id @a (wk x) = (wk x) #-}
{-# RULES "new5" forall a. forall (x :: a). id @a y = y #-}
{-# RULES "new6" forall a. forall (x :: a). id @c x = x #-}

{-# NOINLINE wk #-}
wk :: forall b a. b -> a
wk _ = error ""


-- Test for transform list comp which should work for monad comp as well:
--
-- Test trying to use a function bound in the list comprehension as the transform function

{-# OPTIONS_GHC -XRankNTypes -XMonadComprehensions -XTransformListComp #-}

module RnFail048 where

functions :: [[a] -> [a]]
functions = [take 4, take 5]

output = [() | f <- functions, then f]


-- Test for transform list comp which should work for monad comp aswell:
--
-- Test trying to use a function bound in the list comprehension as the group function

{-# OPTIONS_GHC -XRankNTypes -XMonadComprehensions -XTransformListComp #-}

module RnFail049 where

import Data.List(inits, tails)

functions :: [[a] -> [[a]]]
functions = [inits, tails]

output = [() | f <- functions, then group using f]


module Misplaced where

instance Eq (T a)
{-# SPECIALISE instance Eq (T Int) #-}
 -- A mis-placed signature

data T a = T a


-- !!! rn001: super-simple set of bindings,
-- !!!  incl wildcard pattern-bindings and *duplicates*

x = []
y = []
y = []
_ = []
_ = 1
z = []
_ = []


-- !!! split definition of f (error)
f [] = []
g x = x
f (x:xs) = []


-- !!! multiple definitions, but hidden in patterns
module Foo where

f x = x
  where
    a           = []
    (b,c,a)     = ([],[],d)
    [d,b,_]     = ([],a,[])


-- !!! Main module with no definition of main

module Main where

f x = x


-- !!! Class and instance decl

module Test where

class K a where
        op1 :: a -> a -> a
        op2 :: Int -> a

instance K Int where
        op1 a b = a+b
        op2 x   = x

instance K Bool where
        op1 a b = a
        -- Pick up the default decl for op2

instance K [a] where
        op3 a = a       -- Oops!  Isn't a class op of K


module Foo where

data F = A | B

data G = A | C


type A = Int

type B = Bool

type A = [Bool]


class A a where
 op1 :: a

class B a where
 op2 :: b -> b

class A a where
 op3 :: a


-- !!! Conflicting constructors from two data type decls

module Foo where

data T1 = MkT Int

data T2 = MkT Bool

f (MkT x) = x


module ShouldFail where

-- !!! duplicate constructors in datatype
-- (bug report from Alex Ferguson, c. 2.06)

data Token
     =  TokNewline
     |  TokLiteral
     |  TokCount
     |  TokCheck
     |  TokIs
     |  TokDeref
     |  TokFind
     |  TokLiteral              -- Duplicated!
     |  TokThe

      deriving Show

main = print TokCount


{-# OPTIONS_GHC -fno-warn-typed-holes #-}
module ShouldFail where

-- !!! Pattern syntax in expressions

f x = x @ x


{-# OPTIONS_GHC -fno-warn-typed-holes #-}
module ShouldFail where

-- !!! Pattern syntax in expressions

f x = ~ x


module ShouldFail where

-- !!! Precedence of unary negation

f1 x y = x + -y         -- Fails
f2 x y = x * -y         -- Fails

f3 x y = -x + y         -- OK: means  (-x) + y
                        -- since - is left associative

f4 x y = - x*y          -- OK: means -(x*y)
                        -- since - binds less tightly than *

f5 x y = x >= -y        -- OK means x >= (-y)


{-# LANGUAGE MultiParamTypeClasses, ExplicitForAll #-}

module ShouldFail where

-- !!! For-all with parens

-- This one crashed ghc-4.04proto; the parens after the for-all fooled it

class Monad m => StateMonad s m where
   getState :: m s

setState0 :: forall b. (StateMonad (a,b) m => m a)
setState0 = getState >>= \ (l,_r) -> return l


module ShouldFail where

-- !!! Section with with a bad precedence

f x y = (x:y:)

-- GHC 4.04 (as released) let this by, but it's a precedence error.


{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- !!! Error messages with scoped type variables

module Foo where

data Set a = Set a

unionSetB :: Eq a => Set a -> Set a -> Set a
unionSetB (s1 :: Set a) s2 = unionSets s1 s2
 where
   unionSets :: Eq a => Set a -> Set a -> Set a
   unionSets a b = a

{- In GHC 4.04 this gave the terrible message:

    None of the type variable(s) in the constraint `Eq a'
        appears in the type `Set a -> Set a -> Set a'
    In the type signature for `unionSets'
-}


-- !!! Qualified names in binding positions are rejected

module Foo where

(Baz.f, x) = True


-- !!! Check that 'qualified' doesn't bring the unqual'ed name into scope.
module ShouldFail where

import qualified Data.List as L ( intersperse )

x = L.intersperse

y = intersperse


-- !!! Check that type signatures and pragmas that
-- !!! don't have a "parent" are correctly reported

module ShouldFail where

-- Top level test
f :: Int -> Int
{-# INLINE f #-}

-- Nested test
h :: Int -> Int -- This one is ok
h x = x
    where
      g :: Int -> Int   -- Bogus


module ShouldFail where

sig_without_a_defn :: a -> b

f :: a -> b
f = sig_without_a_defn


module ShouldFail where

sig_without_a_defn :: a -> b

-- We don't even refer to the variable.  This compiled without error
-- in ghc-4.08.


{-# LANGUAGE RankNTypes, FlexibleInstances #-}

-- This one made ghc-4.08 crash
-- rename/RnEnv.lhs:239: Non-exhaustive patterns in function get_tycon_key
-- The type in the Monad instance is utterly bogus, of course

module ShouldCompile ( Set ) where

data Set a = Set [a]
       deriving (Eq, Ord, Read, Show)
{-
instance Functor Set where
        f `fmap` (Set xs) = Set $ f `fmap` xs
-}
instance Monad (forall a. Eq a => Set a) where
        return x = Set [x]
{-
instance Eq (forall a. [a]) where
-}


-- !!! infix declarations for unknown identifiers aren't allowed

module ShouldFail where

infixl 9 `wibble`


-- !!! illegal to export a module we haven't imported.
module ShouldFail ( module List ) where


-- !!! conflicting exports for a function name
module ShouldFail ( Data.List.map, module ShouldFail ) where
import qualified Data.List
map = undefined


-- !!! check that unqualified imports don't bring qualified names into scope
module ShouldFail ( Data.List.map ) where
import Data.List ()


-- !!! check that qualified imports can be restricted to certain names
module ShouldFail ( Data.List.map ) where
import qualified Data.List ( foldr )


-- !!! check that hiding works with qualified imports
module ShouldFail ( Data.List.map ) where
import qualified Data.List hiding ( map )


-- !!! check that hiding on an unqualified import also hides the qualified name
module ShouldFail ( Data.List.map ) where
import Data.List hiding ( map )


-- !!! qualified names aren't allowed in local binds either
-- (Haskell 98 (revised) section 5.5.1)
module M where
g x = let M.y = x + 1 in M.y


-- !!! can't name a constructor in an export list
module ShouldFail ( C ) where
data T = C


-- !!! Checking that qualified method names are ILLEGAL
--     in the binding position instance body.
module ShouldFail where

import Prelude hiding (Eq, (==))
import Prelude as P (Eq,(==))

data Foo = Foo Int Integer

instance P.Eq Foo where
  (Foo a1 b1) P.== (Foo a2 b2) = a1 P.== a2 && b1 P.== b2


-- This one should fail, because it exports
-- both Data.List:nub and Rnfail040_A:nub
--
--  Data.List:nub   is in scope as M.nub and nub
--  Rnfail040_A:nub is in scope as T.nub, M.nub, and nub

module M1 (module M) where

 import qualified Rnfail040_A as M  -- M.nub
 import Data.List as M              -- M.nub nub
 import Rnfail040_A as T            -- T.nub nub


module Rnfail040_A( nub ) where
  nub = True


-- Uses of built-in syntax should provoke a decent error message

module ShouldFail where

data T0 = ()
data T3= (,,,)
data Nil = []
data List = Int : Bool


{-# LANGUAGE TemplateHaskell #-}

-- Duplicate bindings introduced one at a time with TH
module ShouldFail where

f x = x

$([d| h x = x |])

f x = x


-- Renamer test
-- The ambiguity is between the Prelude import and the defn
-- of splitAt. The import of Data.List has nothing to do with it.

module A ( splitAt ) where

  import qualified Data.List
  splitAt = undefined


-- These crashed GHC 6.4.2

module ShouldFail where

x `op1` y = True
op1 x = False

op2 x = False
x `op2` y = True


-- Qualified name in binding position
module ShouldFail where

data Test = Map.Map Int Int


-- trac #924: RnFail047_A.hs-boot exports more than RnFail047_A.hs

module RnFail047 where

import {-# SOURCE #-} RnFail047_A

v = x


module RnFail047_A (x) where

import RnFail047

x :: Int
x = 3


-- Trac #1888
-- Pretty printing for pragmas

module ShouldFail where

{-# NOINLINE[1] foo #-}
{-# NOINLINE[~2] foo #-}
{-# NOINLINE foo #-}
{-# INLINE[1] foo #-}
{-# INLINE[~2] foo #-}
{-# INLINE foo #-}

foo n = foo (n+1)


-- Test trying to use a function bound in the list comprehension as the group function

{-# OPTIONS_GHC -XRankNTypes -XTransformListComp #-}

module RnFail049 where

import Data.List(inits, tails)

functions :: [[a] -> [[a]]]
functions = [inits, tails]

output = [() | f <- functions, then group using f]


-- Test trying to use a function bound in the list comprehension as the transform function

{-# OPTIONS_GHC -XRankNTypes -XTransformListComp #-}

module RnFail048 where

functions :: [[a] -> [a]]
functions = [take 4, take 5]

output = [() | f <- functions, then f]


-- trac #2033: This used to fail when the renamer didn't check for a view
-- /pattern/ being used in an /expression/ context

module RnFail051 where

main :: IO ()
main = wrapper (_ -> putStrLn "_")

wrapper :: (String -> IO ()) -> IO ()
wrapper f = f ""


-- Error messages when you use 'forall' *without* the RankN flags
-- Test cases similar to Trac #2114

module ShouldFail where

f :: forall a. a->a
f = error "ur"

g :: Int -> (forall a. a-> a) -> Int
g = error "ur"

data S = MkS (forall a. a->a)
  -- This one complains about 'a' and 'forall' not in scope
  -- because they aren't implicitly quantified,
  -- whereas implicit quantification deals with the first two


-- Test Trac #2114 (error message)

module ShouldFail where

data T = forall a. MkT a


-- Test for trac #2141

module Foo where

foo :: () -> ()
foo x = x { foo = 1 }


{-# LANGUAGE MultiParamTypeClasses,RankNTypes,ExistentialQuantification,DatatypeContexts #-}
module RnFail055 where

import RnFail055_aux

-- Id with different type
f1 :: Int -> Float
f1 = undefined

-- type synonym with different arity
type S1 a b = (a,b)

-- type synonym with different rhs
type S2 a b = forall a. (a,b)

-- type synonym with alpha-renaming (should be ok)
type S3 a = [a]

-- datatype with different fields
data T1 a b = T1 [b] [a]

-- datatype with different stupid theta
data (Eq b) => T2 a b = T2 a

-- different constructor name
data T3' = T3
data T3 = T3'

-- check alpha equivalence
data T4 a = T4 (forall b. a -> b)

-- different field labels
data T5 a = T5 { field5 :: a }

-- different strict marks
data T6 = T6 Int

-- different existential quantification
data T7 a = forall a . T7 a

-- extra method in the hs-boot
class C1 a b where {}

-- missing method in the hs-boot
class C2 a b where { m2 :: a -> b; m2' :: a -> b }

-- different superclasses
class (Eq a, Ord a) => C3 a where { }


module RnFail055_aux where

import {-# SOURCE #-} RnFail055


-- TupleSections not enabled
{-# LANGUAGE UnboxedTuples #-}

module Foo where

foo = (1,)

bar = (# 1, #)


{-# LANGUAGE KindSignatures #-}

module BindKindName where

type Foo (a :: DontExistKind) = a


{-# LANGUAGE StaticPointers #-}

module RnStaticPointersFail01 where

f x = static x


{-# LANGUAGE StaticPointers #-}

module RnStaticPointersFail02 where

f = static T

data T = TDataCons


{-# LANGUAGE StaticPointers #-}

module RnStaticPointersFail03 where

import Data.Typeable
import GHC.StaticPtr

f x = static (x . id)

f0 x = static (k . id)
  where
    k = const (const () x)

f1 x = static (k . id)
  where
    k = id

f2 :: Typeable a => a -> StaticPtr TypeRep
f2 x = const (static (g undefined)) (h x)
  where
    g = h
    h = typeOf


-- Test for top-level duplicates

module Dup where

data T = MkT | MkT

data S = MkT

data P = MkP { rf :: Int, rf :: Int }
data Q = MkQ { rf :: Int }

class C a where
  data CT a
  f :: CT a -> a
  data CT a
  f :: CT a -> a


module T10618 where

foo = Just $ Nothing <|> Nothing


module T10668 where

import Data.Type.Equality(Refl)


module T10781 where
{- ghc-7.10.2 reported:

T10781.hs:6:5:
    Found hole â€˜_nameâ€™ with type: t
    Where: â€˜tâ€™ is a rigid type variable bound by
               the inferred type of f :: t at T10781.hs:6:1
    Relevant bindings include f :: t (bound at T10781.hs:6:1)
    In the expression: Foo._name
    In an equation for â€˜fâ€™: f = Foo._name
-}
f = Foo._name


module T11071 where

import Data.List (lines)
import qualified Data.Map as M ()
import qualified Data.IntMap as M ()
import qualified Data.IntMap as M () -- just to see if this confused the code

import qualified Data.Ord as Ord hiding (Down)

import qualified Data.Map as M' hiding (size, filter)
import qualified Data.Map as M' hiding (size)
import qualified Data.IntMap as M' hiding (size)
import qualified System.IO as M' () -- unrelated

ignore :: a -> IO ()
ignore = const (return ())

main = do
    ignore NoSuchModule.foo  -- no such module
    ignore Data.List.foobar  -- does not exist (one import)
    ignore M.foobar          -- does not exist (two imports)
    ignore M'.foobar         -- does not exist (three imports)
    ignore Data.List.sort    -- needs import
    ignore Data.List.unlines -- needs import, similar to imported
    ignore M.size            -- multiple modules to import from
    ignore M.valid           -- only one module to import from
    ignore Ord.Down          -- explicit hiding
    ignore M'.size           -- hidden and/or missing in import list


module T11071 where

import Data.List (lines)
import Data.IntMap ()
import Data.Ord hiding (Down)
import Prelude hiding (True)

ignore :: a -> IO ()
ignore = const (return ())

main = do
    ignore intersperse       -- missing in import list (one import)
    ignore foldl'            -- missing in import list (two imports)
    ignore Down              -- explicitly hidden
    ignore True              -- explicitly hidden from prelude (not really special)
    ignore foobar            -- genuinely out of scope


{-# LANGUAGE PolyKinds #-}

module Bug11592 where

data A (a :: a) = MkA String

data B b (a :: a b) = MkB String
data C b (a :: b a) = MkC String

data D b c (a :: c a b) = MkD String


module T11663 where

-- All of these should fail as type signatures are not allowed
-- in patterns without -XScopedTypeVariables.
hello0 = \(h :: Int) -> print h
hello1 (h :: Int) = print h
hello2 = case 54 of (x :: Int) -> print x
hello4 = case Just 54 of Just (x :: Int) -> print x


-- Test Trac #12146

module T12146 where

ipmort Data.Char


{-# LANGUAGE RecordWildCards #-}

module T12229 where

data T = MkT { x, pi :: Float }

f x = MkT { .. }  -- 'pi' is not initialised, because
                  -- there is no local binding

g x pi = MkT { .. }  -- 'pi' is initialised


module T12681 where
import qualified T12681a

x = T12681a.A { a = 0 }


module T12681a where
  data A = A { a :: Int }


module T12686 where

import Data.Proxy

x = True

data Bad = Bad 'x
-- The 'x should be rejeted in a civilised way

data AlsoBad = AlsoBad {
  a :: Int,
  b :: Either Int 'a }
-- Ditto 'a here


{-# LANGUAGE TypeApplications #-}
module ShouldFail where

f x = x@x


module T13568 where

import T13568a

data S = A

foo :: A -> ()
foo = undefined


module T13644 where

import T13644A

baseENDECfuncs :: FuncId -> ()
baseENDECfuncs FuncId{ name = nm } = undefined


module T13644A
(
  FuncId(FuncId)
, module X
)
where

import T13644C as X

import T13644B


module T13644B where

data FuncId         = FuncId    { name       :: () }


module T13644C where

data T = T { name :: () }


module Main where
import qualified T13847A as A
foo = "foo"
main = print $ A.foo $ A.A { foo = () }


module T13847A where
data A = A { foo :: () }


{-# LANGUAGE TypeOperators #-}
module T13947 where

f :: () -> Int :~: Int
f = undefined


{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}

module T14307 where

data A = A { field :: Int }
data B = B { field :: Int }

f :: B -> Int
f (C { field }) = field


-- Checks that the ordering constraint on the groupWith function is respected
{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-}

module T14591 where

import GHC.Exts (groupWith)

data Unorderable = Gnorf | Pinky | Brain
foo = [ ()
      | Gnorf <- [Gnorf, Brain]
      , then group by x using groupWith
      ]


module T14907a where

class (Bool, a, b)


module T14907b where

-- This is effectively trying to redefine the constraint tuples already
-- defined in 'GHC.Classes'.
class ()
class (a,b)
class (a,b,c)


{-# LANGUAGE TypeOperators #-}
module T15214 where

type (~) = Either


module T15487 where

import qualified T15487a

null = 42

foo x = null


{-# LANGUAGE RankNTypes #-}
module T15539 where

foo :: String
foo = show a
  where a = baz

-- We get top level constraints
--     Show a
--     forall . <not in scope baz>
-- We want the insoluble non-in-scope error to suppress
-- the Show a, just as it does if the whole things is nested

bar :: Int
bar = 1

bam = putStrLn foo


{-# LANGUAGE RebindableSyntax #-}
module T15607 where

import Prelude hiding (pure, return)

t = do { pure 5 }


module T15659 where

{-# RULES "test" forall x. f x  = x #-}


{-# LANGUAGE TypeFamilies, ExplicitForAll #-}

module T15828 where

class C a where
  type T a b

instance C (Maybe a) where
  type forall a b. T (Maybe a) b = b