{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE NoMonomorphismRestriction #-} module ExtraConstraints3 where import qualified Prelude as P import Prelude (Bool, Bounded, Char, Either, Enum, Eq, FilePath, Floating, Fractional, Functor, IO, IOError, Int, Integer, Integral, Maybe, Monad, Num, Ord, Ordering, Rational, Read, ReadS, Real, RealFloat, RealFrac, Show, ShowS, String) -- Proof by enumeration! jk :p -- All of Prelude typechecks given the dummy type signature `_ => _`, -- which is the same as omitting the type signature entirely. (!!) :: _ => _ (!!) = (P.!!) ($!) :: _ => _ ($!) = (P.$!) ($) :: _ => _ ($) = (P.$) (&&) :: _ => _ (&&) = (P.&&) (*) :: _ => _ (*) = (P.*) (**) :: _ => _ (**) = (P.**) (+) :: _ => _ (+) = (P.+) (++) :: _ => _ (++) = (P.++) (-) :: _ => _ (-) = (P.-) (.) :: _ => _ (.) = (P..) (/) :: _ => _ (/) = (P./) (/=) :: _ => _ (/=) = (P./=) (<) :: _ => _ (<) = (P.<) (<=) :: _ => _ (<=) = (P.<=) (=<<) :: _ => _ (=<<) = (P.=<<) (==) :: _ => _ (==) = (P.==) (>) :: _ => _ (>) = (P.>) (>=) :: _ => _ (>=) = (P.>=) (>>) :: _ => _ (>>) = (P.>>) (>>=) :: _ => _ (>>=) = (P.>>=) (^) :: _ => _ (^) = (P.^) (^^) :: _ => _ (^^) = (P.^^) (||) :: _ => _ (||) = (P.||) abs :: _ => _ abs = P.abs acos :: _ => _ acos = P.acos acosh :: _ => _ acosh = P.acosh all :: _ => _ all = P.all and :: _ => _ and = P.and any :: _ => _ any = P.any appendFile :: _ => _ appendFile = P.appendFile asTypeOf :: _ => _ asTypeOf = P.asTypeOf asin :: _ => _ asin = P.asin asinh :: _ => _ asinh = P.asinh atan :: _ => _ atan = P.atan atan2 :: _ => _ atan2 = P.atan2 atanh :: _ => _ atanh = P.atanh break :: _ => _ break = P.break ceiling :: _ => _ ceiling = P.ceiling compare :: _ => _ compare = P.compare concat :: _ => _ concat = P.concat concatMap :: _ => _ concatMap = P.concatMap const :: _ => _ const = P.const cos :: _ => _ cos = P.cos cosh :: _ => _ cosh = P.cosh curry :: _ => _ curry = P.curry cycle :: _ => _ cycle = P.cycle decodeFloat :: _ => _ decodeFloat = P.decodeFloat div :: _ => _ div = P.div divMod :: _ => _ divMod = P.divMod drop :: _ => _ drop = P.drop dropWhile :: _ => _ dropWhile = P.dropWhile either :: _ => _ either = P.either elem :: _ => _ elem = P.elem encodeFloat :: _ => _ encodeFloat = P.encodeFloat enumFrom :: _ => _ enumFrom = P.enumFrom enumFromThen :: _ => _ enumFromThen = P.enumFromThen enumFromThenTo :: _ => _ enumFromThenTo = P.enumFromThenTo enumFromTo :: _ => _ enumFromTo = P.enumFromTo error :: _ => _ error = P.error even :: _ => _ even = P.even exp :: _ => _ exp = P.exp exponent :: _ => _ exponent = P.exponent fail :: _ => _ fail = P.fail filter :: _ => _ filter = P.filter flip :: _ => _ flip = P.flip floatDigits :: _ => _ floatDigits = P.floatDigits floatRadix :: _ => _ floatRadix = P.floatRadix floatRange :: _ => _ floatRange = P.floatRange floor :: _ => _ floor = P.floor fmap :: _ => _ fmap = P.fmap foldl :: _ => _ foldl = P.foldl foldl1 :: _ => _ foldl1 = P.foldl1 foldr :: _ => _ foldr = P.foldr foldr1 :: _ => _ foldr1 = P.foldr1 fromEnum :: _ => _ fromEnum = P.fromEnum fromInteger :: _ => _ fromInteger = P.fromInteger fromIntegral :: _ => _ fromIntegral = P.fromIntegral fromRational :: _ => _ fromRational = P.fromRational fst :: _ => _ fst = P.fst gcd :: _ => _ gcd = P.gcd getChar :: _ => _ getChar = P.getChar getContents :: _ => _ getContents = P.getContents getLine :: _ => _ getLine = P.getLine head :: _ => _ head = P.head id :: _ => _ id = P.id init :: _ => _ init = P.init interact :: _ => _ interact = P.interact ioError :: _ => _ ioError = P.ioError isDenormalized :: _ => _ isDenormalized = P.isDenormalized isIEEE :: _ => _ isIEEE = P.isIEEE isInfinite :: _ => _ isInfinite = P.isInfinite isNaN :: _ => _ isNaN = P.isNaN isNegativeZero :: _ => _ isNegativeZero = P.isNegativeZero iterate :: _ => _ iterate = P.iterate last :: _ => _ last = P.last lcm :: _ => _ lcm = P.lcm length :: _ => _ length = P.length lex :: _ => _ lex = P.lex lines :: _ => _ lines = P.lines log :: _ => _ log = P.log logBase :: _ => _ logBase = P.logBase lookup :: _ => _ lookup = P.lookup map :: _ => _ map = P.map mapM :: _ => _ mapM = P.mapM mapM_ :: _ => _ mapM_ = P.mapM_ max :: _ => _ max = P.max maxBound :: _ => _ maxBound = P.maxBound maximum :: _ => _ maximum = P.maximum maybe :: _ => _ maybe = P.maybe min :: _ => _ min = P.min minBound :: _ => _ minBound = P.minBound minimum :: _ => _ minimum = P.minimum mod :: _ => _ mod = P.mod negate :: _ => _ negate = P.negate not :: _ => _ not = P.not notElem :: _ => _ notElem = P.notElem null :: _ => _ null = P.null odd :: _ => _ odd = P.odd or :: _ => _ or = P.or otherwise :: _ => _ otherwise = P.otherwise pi :: _ => _ pi = P.pi pred :: _ => _ pred = P.pred print :: _ => _ print = P.print product :: _ => _ product = P.product properFraction :: _ => _ properFraction = P.properFraction putChar :: _ => _ putChar = P.putChar putStr :: _ => _ putStr = P.putStr putStrLn :: _ => _ putStrLn = P.putStrLn quot :: _ => _ quot = P.quot quotRem :: _ => _ quotRem = P.quotRem read :: _ => _ read = P.read readFile :: _ => _ readFile = P.readFile readIO :: _ => _ readIO = P.readIO readList :: _ => _ readList = P.readList readLn :: _ => _ readLn = P.readLn readParen :: _ => _ readParen = P.readParen reads :: _ => _ reads = P.reads readsPrec :: _ => _ readsPrec = P.readsPrec realToFrac :: _ => _ realToFrac = P.realToFrac recip :: _ => _ recip = P.recip rem :: _ => _ rem = P.rem repeat :: _ => _ repeat = P.repeat replicate :: _ => _ replicate = P.replicate return :: _ => _ return = P.return reverse :: _ => _ reverse = P.reverse round :: _ => _ round = P.round scaleFloat :: _ => _ scaleFloat = P.scaleFloat scanl :: _ => _ scanl = P.scanl scanl1 :: _ => _ scanl1 = P.scanl1 scanr :: _ => _ scanr = P.scanr scanr1 :: _ => _ scanr1 = P.scanr1 seq :: _ => _ seq = P.seq sequence :: _ => _ sequence = P.sequence sequence_ :: _ => _ sequence_ = P.sequence_ show :: _ => _ show = P.show showChar :: _ => _ showChar = P.showChar showList :: _ => _ showList = P.showList showParen :: _ => _ showParen = P.showParen showString :: _ => _ showString = P.showString shows :: _ => _ shows = P.shows showsPrec :: _ => _ showsPrec = P.showsPrec significand :: _ => _ significand = P.significand signum :: _ => _ signum = P.signum sin :: _ => _ sin = P.sin sinh :: _ => _ sinh = P.sinh snd :: _ => _ snd = P.snd span :: _ => _ span = P.span splitAt :: _ => _ splitAt = P.splitAt sqrt :: _ => _ sqrt = P.sqrt subtract :: _ => _ subtract = P.subtract succ :: _ => _ succ = P.succ sum :: _ => _ sum = P.sum tail :: _ => _ tail = P.tail take :: _ => _ take = P.take takeWhile :: _ => _ takeWhile = P.takeWhile tan :: _ => _ tan = P.tan tanh :: _ => _ tanh = P.tanh toEnum :: _ => _ toEnum = P.toEnum toInteger :: _ => _ toInteger = P.toInteger toRational :: _ => _ toRational = P.toRational truncate :: _ => _ truncate = P.truncate uncurry :: _ => _ uncurry = P.uncurry undefined :: _ => _ undefined = P.undefined unlines :: _ => _ unlines = P.unlines until :: _ => _ until = P.until unwords :: _ => _ unwords = P.unwords unzip :: _ => _ unzip = P.unzip unzip3 :: _ => _ unzip3 = P.unzip3 userError :: _ => _ userError = P.userError words :: _ => _ words = P.words writeFile :: _ => _ writeFile = P.writeFile zip :: _ => _ zip = P.zip zip3 :: _ => _ zip3 = P.zip3 zipWith :: _ => _ zipWith = P.zipWith zipWith3 :: _ => _ zipWith3 = P.zipWith3