diff options
Diffstat (limited to 'ghc/compiler/tests')
539 files changed, 15804 insertions, 0 deletions
diff --git a/ghc/compiler/tests/Jmakefile b/ghc/compiler/tests/Jmakefile new file mode 100644 index 0000000000..716cc71966 --- /dev/null +++ b/ghc/compiler/tests/Jmakefile @@ -0,0 +1,11 @@ +#define IHaveSubdirs + +SUBDIRS = reader \ + rename \ + simplCore \ + typecheck \ + deSugar \ + printing \ + ccall \ + deriving \ + bugs diff --git a/ghc/compiler/tests/README b/ghc/compiler/tests/README new file mode 100644 index 0000000000..467ae42e7f --- /dev/null +++ b/ghc/compiler/tests/README @@ -0,0 +1,77 @@ +Installing a new compiler test +============================== + +[If the test if for the driver, the parser, the runtime system, the +std prelude, ... in short _not_ the compiler, it belongs elsewhere.] + +1. Copy your Haskell program into an appropriately named file in the + appropriate directory, e.g., "typecheck/tc093.hs" for the 93rd + typechecker test. + +2. Edit the Jmakefile in that dir to add your test: almost certainly + just a line of the form... + +RunStdTest(tc093,$(TESTGHC), "-ddump-tc tc093.hs", 0, /dev/null, tc093.stderr) + ^^^^^ +name of test|||| + ^^^^^^^^^^ +driver to use----|||||||||| + ^^^^^^^^^^^^^^^^^^^^ +driver command line----------|||||||||||||||||||| + ^^ +expected exit status (0=success, 1=failure)-------|| + ^^^^^^^^^ +file holding expected standard output----------------||||||||| + ^^^^^^^^^^^^^ +file holding expected output on standard error------------------||||||||||||| + + The example above is typical. The command-line stuff may vary, + but it's likely to be "dump pass <foo> output" (e.g., -ddump-tc) + and the input file name. Dump output is on stderr, hence the + expected-output files. + + The current best documentation of the flags to use is in + $(TOP)/driver/ghc (invoke w/ -help option). + +3. Create the expected-output files. I'm usually lazy and just + "touch" them (creating an empty file), then update them (section + below) after the test has "failed". + +4. "make Makefile", to make a Makefile from the Jmakefile. + +5. "make runtest_<testname>" (e.g., make runtest_tc093) to run the + one test. + + IF "make" FALLS OVER, THEN IMMEDIATEDLY "mv Makefile.bak Makefile"!! + You probably had a typo in the Jmakefile; fix it and resume from + step 4. + + +Running tests +============= + +* You may run all tests by typing "make runtests" (or, if you expect + or don't mind errors, "make -k runtests"). + +* You may run one test <foo> with "make runtest_<foo>". + +* You may run tests <foo> to <bar> with a simple script, + "dotests <foo> <bar>". You may pass "make" arguments to it as well, + as in: + dotests -k tc019 tc028 + + +Updating the "expected output" files +==================================== + +Sometimes, it will happen that the differences between expected and +actual output of the tests will not mean failure but that the actual +output is "more correct". + +If you save the output of "make runtests" (mainly from "diff"), you +may automatically update the expected-output files by using + + patch -p0 < saved-output + +(You should probably ^C out of the "patch" if it doesn't do exactly +what you expect.) diff --git a/ghc/compiler/tests/TIMING/HelpMicroPrel.hi b/ghc/compiler/tests/TIMING/HelpMicroPrel.hi new file mode 100644 index 0000000000..9c8423ecf8 --- /dev/null +++ b/ghc/compiler/tests/TIMING/HelpMicroPrel.hi @@ -0,0 +1,378 @@ +interface HelpMicroPrel where +alpha :: UniType +alpha_tyvar :: TyVar +alpha_tyvarU :: Int +alpha_tyvars :: [TyVar] +applySubstToId :: Subst -> Id -> Id +applySubstToTauTy :: Subst -> UniType -> UniType +applySubstToThetaTy :: Subst -> [(Class, UniType)] -> [(Class, UniType)] +applySubstToTy :: Subst -> UniType -> UniType +applyTy :: UniType -> UniType -> UniType +applyTyCon :: TyCon -> [UniType] -> UniType +applyTyConLazily :: TyCon -> TyCon -> [UniType] -> UniType +assocMaybe :: (Eq a) => a -> [(a, b)] -> Labda b +bOTTOM_ID :: Id +beta_tyvar :: TyVar +beta_tyvarU :: Int +binTyCon :: TyCon +binTyConU :: Int +catMaybes :: [Labda a] -> [a] +catQuickStrings :: [QuickString] -> QuickString +charPrimRelOpTy :: UniType +charPrimTy :: UniType +charPrimTyCon :: TyCon +charPrimTyConU :: Int +checkInstanceShape :: UniType -> Labda (TyCon, [TyVar]) +chrPrimId :: Id +data PprStyle = PprForUser | PprDebug | PprShowAll | PprInterface deriving () +data Env a b +data GVE +data TCE +data PrettyRep +data PrimitiveOp +class AbsSynParam a where + hasType :: a -> Bool + getType :: a -> UniType + isConop :: a -> Bool + isAconid :: a -> Bool + isAconop :: a -> Bool + isAvarid :: a -> Bool + isAvarop :: a -> Bool +class Outputable a where + frc :: a -> Int + ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep +data Annotations +data CLabelInfo +data Class +data ConFamilySize = SmallConFamily Int | LargeConFamily deriving () +data CoreExpr a b +data Id = Local Name Unique UniType | Imported Name UniType (Labda (CoreExpr Id Id)) | DataCon Name Int [TyVar] [(Class, UniType)] [UniType] TyCon deriving () +data Labda a = Just a | Nothing deriving () +data MaybeErr a b = Succeeded a | Failed b deriving () +data Name +data PrimitiveKind +data QuickString +data Subst +data TyCon = TyConSynonym Name Unique Int [TyVar] UniType | TyConData Name Unique Int [TyVar] ConFamilySize [Id] | TyConBuiltIn Name Unique Int deriving () +data TyVar +data TyVarOrTyCon = IsTyVar TyVar | IsTyCon TyCon [UniType] deriving () +data UniType = UniTyVar TyVar | UniFun UniType UniType | UniData TyCon [UniType] | UniSyn TyCon [UniType] UniType | UniDict Class UniType | UniForall TyVar UniType deriving () +data TypecheckedPat +data Expr a b +data Matches a b +data MonoBinds a b +data Binds a b +data GRHSs a b +data UnifyErrContext = PredCtxt (Expr Id TypecheckedPat) | AppCtxt (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) | OpAppCtxt (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) | SectionLAppCtxt (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) | SectionRAppCtxt (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) | CaseCtxt (Expr Id TypecheckedPat) (Matches Id TypecheckedPat) | BranchCtxt (Expr Id TypecheckedPat) (Expr Id TypecheckedPat) | ListCtxt [Expr Id TypecheckedPat] | ConPatCtxt QuickString [TypecheckedPat] | ConOpPatCtxt TypecheckedPat QuickString TypecheckedPat | ListPatCtxt [TypecheckedPat] | MatchPairCtxt (Matches Id TypecheckedPat) (Matches Id TypecheckedPat) | FilterCtxt (Expr Id TypecheckedPat) | GeneratorCtxt TypecheckedPat (Expr Id TypecheckedPat) | GRHSsBranchCtxt (GRHSs Id TypecheckedPat) (GRHSs Id TypecheckedPat) | GRHSsGuardCtxt (Expr Id TypecheckedPat) | RecCtxt [QuickString] (MonoBinds Id TypecheckedPat) | PatMonoBindsCtxt TypecheckedPat (GRHSs Id TypecheckedPat) (Binds Id TypecheckedPat) | MatchCtxt UniType UniType | ArithSeqCtxt [Expr Id TypecheckedPat] | CCallCtxt QuickString [Expr Id TypecheckedPat] deriving () +data UnifyErrInfo = DataConMisMatch UniType UniType | UniConMisMatch UniType UniType | TypeRec TyVar UniType | UnifyListMisMatch [UniType] [UniType] deriving () +data Unique +data UniqueSupply +divideDoublePrimId :: Id +divideFloatPrimId :: Id +divideIntPrimId :: Id +divideIntegerPrimId :: Id +doublePrim2FloatPrimId :: Id +doublePrim2IntPrimId :: Id +doublePrimArithOpTy :: UniType +doublePrimRelOpTy :: UniType +doublePrimTy :: UniType +doublePrimTyCon :: TyCon +doublePrimTyConU :: Int +doublePrimUnaryOpTy :: UniType +duplicateLocal :: Id -> Unique -> Id +duplicateTyVar :: TyVar -> Unique -> TyVar +eRROR_ID :: Id +eqCharPrimId :: Id +eqDoublePrimId :: Id +eqFloatPrimId :: Id +eqIntPrimBoolId :: Id +eqIntPrimId :: Id +eqIntegerPrimId :: Id +errorTy :: UniType +expandTySyn :: UniType -> UniType +extractTyVarsFromTy :: UniType -> [TyVar] +extractTyVarsFromTys :: [UniType] -> [TyVar] +firstTupleUniqueInt :: Int +floatPrim2DoublePrimId :: Id +floatPrim2IntPrimId :: Id +floatPrimArithOpTy :: UniType +floatPrimRelOpTy :: UniType +floatPrimTy :: UniType +floatPrimTyCon :: TyCon +floatPrimTyConU :: Int +floatPrimUnaryOpTy :: UniType +frcId :: Bool -> Id -> Int +frcUniType :: UniType -> Int +funResultTy :: UniType -> UniType +geCharPrimId :: Id +geDoublePrimId :: Id +geFloatPrimId :: Id +geIntPrimId :: Id +geIntegerPrimId :: Id +genInstantiateTy :: UniqueSupply -> [(TyVar, UniType)] -> UniType -> (UniqueSupply, UniType) +genInstantiateTyUS :: (Env TyVar UniType) -> UniType -> UniqueSupply -> (UniqueSupply, UniType) +getClassName :: Class -> Name +getClassOps :: Class -> [(QuickString, UniType)] +getClassSig :: Class -> (TyVar, [(Class, UniType)], [(QuickString, UniType)]) +getClassThetaType :: Class -> [(Class, UniType)] +getConstructedTyTycon :: UniType -> TyCon +getDataConDeps :: Id -> [TyCon] +getDataConFamily :: Id -> [Id] +getDataConSig :: Id -> ([TyVar], [(Class, UniType)], [UniType], TyCon) +getDataConTag :: Id -> Int +getDataConTyCon :: Id -> TyCon +getDictClass :: Id -> Class +getDictClassType :: Id -> (Class, UniType) +getDictTyVar :: Id -> TyVar +getDictType :: Id -> UniType +getIdAnns :: Id -> Annotations +getIdBoundTyVars :: Id -> [TyVar] +getIdCLabelInfo :: Id -> CLabelInfo +getIdKind :: Id -> PrimitiveKind +getIdName :: Id -> Name +getIdQuickString :: Id -> QuickString +getIdSourceTypes :: Id -> [UniType] +getIdTargetType :: Id -> UniType +getIdTauType :: Id -> UniType +getIdUnfolding :: Id -> Labda (CoreExpr Id Id) +getIdUniType :: Id -> UniType +getLocalUnique :: Id -> Unique +getMentionedTyCons :: TyCon -> [TyCon] +getQuickStringStr :: QuickString -> [Char] +getReferredToTyCons :: UniType -> [TyCon] +getTauType :: UniType -> UniType +getTyConArity :: TyCon -> Int +getTyConDataCons :: TyCon -> [Id] +getTyConName :: TyCon -> Name +getTyConTyVars :: TyCon -> [TyVar] +getTyVar :: UniType -> TyVar +getTyVarMaybe :: UniType -> Labda TyVar +getUniDataTyCon :: UniType -> TyCon +getUnique :: UniqueSupply -> (UniqueSupply, Unique) +getUniques :: Int -> UniqueSupply -> (UniqueSupply, [Unique]) +glueTyArgs :: [UniType] -> UniType -> UniType +gtCharPrimId :: Id +gtDoublePrimId :: Id +gtFloatPrimId :: Id +gtIntPrimId :: Id +gtIntegerPrimId :: Id +iMPOSSIBLE_UNIQUE :: Unique +idxStringPrimId :: Id +initUS :: a -> (a -> (b, c)) -> (b, c) +instance AbsSynParam Id +instance AbsSynParam Name +instance AbsSynParam QuickString +instance Eq CLabelInfo +instance Eq Class +instance Eq Id +instance Eq Name +instance Eq PrimitiveKind +instance Eq QuickString +instance Eq TyCon +instance Eq TyVar +instance Eq UniType +instance Eq Unique +instance Ord Id +instance Ord Name +instance Ord QuickString +instance Ord TyCon +instance Ord TyVar +instance Ord Unique +instance Outputable Annotations +instance Outputable CLabelInfo +instance Outputable Class +instance Outputable ConFamilySize +instance Outputable Id +instance Outputable Name +instance Outputable PrimitiveKind +instance Outputable QuickString +instance Outputable TyCon +instance Outputable TyVar +instance Outputable UniType +instance Outputable Unique +instance Text Id +instance Text Unique +instantiateTauTy :: [(TyVar, UniType)] -> UniType -> UniType +instantiateThetaTy :: [(TyVar, UniType)] -> [(Class, UniType)] -> [(Class, UniType)] +instantiateTy :: [(TyVar, UniType)] -> UniType -> UniType +intPrim2DoublePrimId :: Id +intPrim2FloatPrimId :: Id +intPrim2IntegerPrimId :: Id +intPrimArithOpTy :: UniType +intPrimRelOpTy :: UniType +intPrimTy :: UniType +intPrimTyCon :: TyCon +intPrimTyConU :: Int +intPrimUnaryOpTy :: UniType +integerPrim2IntPrimId :: Id +integerPrimArithOpTy :: UniType +integerPrimRelOpTy :: UniType +integerPrimTy :: UniType +integerPrimTyCon :: TyCon +integerPrimTyConU :: Int +integerPrimUnaryOpTy :: UniType +ioPrimTy :: UniType +ioPrimTyCon :: TyCon +ioPrimTyConU :: Int +isAbstractTyConData :: TyCon -> Bool +isFunType :: UniType -> Bool +isGlobalId :: Id -> Bool +isTyConBuiltIn :: TyCon -> Bool +isTyConData :: TyCon -> Bool +isUnboxedType :: UniType -> Bool +kindFromType :: UniType -> PrimitiveKind +leCharPrimId :: Id +leDoublePrimId :: Id +leFloatPrimId :: Id +leIntPrimId :: Id +leIntegerPrimId :: Id +listMaybeErrs :: [MaybeErr a b] -> MaybeErr [a] [b] +ltCharPrimId :: Id +ltDoublePrimId :: Id +ltFloatPrimId :: Id +ltIntPrimId :: Id +ltIntegerPrimId :: Id +matchList :: Subst -> [UniType] -> [UniType] -> MaybeErr Subst UnifyErrInfo +matchTys :: Subst -> UniType -> UniType -> MaybeErr Subst UnifyErrInfo +minusDoublePrimId :: Id +minusFloatPrimId :: Id +minusIntPrimId :: Id +minusIntegerPrimId :: Id +mkClass :: Unique -> Name -> TyVar -> [(Class, UniType)] -> [(QuickString, UniType)] -> Class +mkClassBottom :: QuickString -> QuickString -> Annotations -> Class +mkDataCon :: Name -> UniType -> Id +mkDataTy :: TyCon -> [UniType] -> UniType +mkDataTyConBottom :: QuickString -> QuickString -> Annotations -> Int -> TyCon +mkDictFunId :: Class -> TyCon -> UniType -> Id +mkDictFunType :: [TyVar] -> [(Class, UniType)] -> Class -> UniType -> UniType +mkDictTy :: Class -> UniType -> UniType +mkForallTy :: [TyVar] -> UniType -> UniType +mkImported :: Name -> UniType -> (Labda (CoreExpr Id Id)) -> Id +mkInternalDataCon :: Name -> Int -> [TyVar] -> [(Class, UniType)] -> [UniType] -> TyCon -> Id +mkLocal :: Name -> Unique -> UniType -> Id +mkNamedLocal :: QuickString -> Unique -> UniType -> Annotations -> Id +mkQuickString :: [Char] -> QuickString +mkRenamedLocal :: Name -> Unique -> UniType -> Id +mkSigmaTy :: [TyVar] -> [(Class, UniType)] -> UniType -> UniType +mkSynTy :: TyCon -> [UniType] -> UniType -> UniType +mkSynTyConBottom :: QuickString -> QuickString -> Annotations -> Int -> TyCon +mkSysLocal :: [Char] -> Unique -> UniType -> Annotations -> Id +mkSysTyVar :: Unique -> TyVar +mkTUPLE_ID :: Int -> Id +mkTemplateLocals :: [UniType] -> [Id] +mkTupleTy :: [UniType] -> UniType +mkTupleTyCon :: Int -> TyCon +mkTupleTyConAndId :: Int -> (TyCon, Id) +mkTyConBuiltIn :: Name -> Unique -> Int -> TyCon +mkTyConData :: Name -> Unique -> Int -> [TyVar] -> Int -> [Id] -> TyCon +mkTyConSynonym :: Name -> Unique -> Int -> [TyVar] -> UniType -> TyCon +mkTyVarTy :: TyVar -> UniType +mkUnique :: Int -> Unique +mkUniqueSupply :: Int -> UniqueSupply +mkUserTyVar :: Unique -> QuickString -> TyVar +nanoCoreGVE :: GVE +nanoCoreTCE :: TCE +neCharPrimId :: Id +neDoublePrimId :: Id +neFloatPrimId :: Id +neIntPrimId :: Id +neIntegerPrimId :: Id +negateDoublePrimId :: Id +negateFloatPrimId :: Id +negateIntPrimId :: Id +negateIntegerPrimId :: Id +noFail :: (Labda a) -> [Char] -> a +ordPrimId :: Id +pRELUDE :: [Char] +pRELUDE_BUILTIN :: [Char] +pRELUDE_BUILTIN_Char :: ([Char], [Char]) +pRELUDE_BUILTIN_Double :: ([Char], [Char]) +pRELUDE_BUILTIN_Float :: ([Char], [Char]) +pRELUDE_BUILTIN_Int :: ([Char], [Char]) +pRELUDE_BUILTIN_Integer :: ([Char], [Char]) +pRELUDE_BUILTIN_List :: ([Char], [Char]) +pRELUDE_BUILTIN_Tuple0 :: ([Char], [Char]) +pRELUDE_BUILTIN_Tuple2 :: ([Char], [Char]) +pRELUDE_CORE :: [Char] +pRELUDE_CORE_Bool :: ([Char], [Char]) +pRELUDE_CORE_Enum :: ([Char], [Char]) +pRELUDE_CORE_Eq :: ([Char], [Char]) +pRELUDE_CORE_Fractional :: ([Char], [Char]) +pRELUDE_CORE_Integral :: ([Char], [Char]) +pRELUDE_CORE_Num :: ([Char], [Char]) +pRELUDE_CORE_Ord :: ([Char], [Char]) +pRELUDE_CORE_Real :: ([Char], [Char]) +pRELUDE_RATIO :: [Char] +pRELUDE_RATIO_Ratio :: ([Char], [Char]) +pRELUDE_TEXT :: [Char] +pRELUDE_TEXT_Text :: ([Char], [Char]) +packStringPrimId :: Id +pcAnns :: Annotations +pcBasicArithBinOp :: [Char] -> UniType -> Id -> Id -> Id +pcBasicArithUnaryOp :: [Char] -> UniType -> Id -> Id -> Id +pcBasicRelBinOp :: [Char] -> UniType -> Id -> Id -> Id +pcBasicRelBinOpInnerCase :: Id -> Id -> Id -> CoreExpr Id Id +pcBuiltinTyCon :: Int -> [Char] -> [Char] -> Int -> TyCon +pcDataCon :: [Char] -> [Char] -> UniType -> Id +pcDataTyCon :: Int -> [Char] -> [Char] -> Int -> [TyVar] -> [Id] -> TyCon +pcDictFunName :: ([Char], [Char]) -> ([Char], [Char]) -> Name +pcDictSelectorName :: [Char] -> [Char] -> Name +pcExternalName :: [Char] -> [Char] -> Name +pcGlobal :: [Char] -> [Char] -> UniType -> Id +pcInstance :: ([Char], [Char]) -> ([Char], [Char]) -> UniType -> Id +pcMethod :: Name -> [Char] -> UniType -> Id +pcPrim :: [Char] -> UniType -> PrimitiveOp -> Id +pcPrimPredicate :: [Char] -> UniType -> Id -> Id +plusDoublePrimId :: Id +plusFloatPrimId :: Id +plusIntPrimId :: Id +plusIntegerPrimId :: Id +pprParendUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep +pprUniType :: PprStyle -> UniType -> Int -> Bool -> PrettyRep +remIntPrimId :: Id +remIntegerPrimId :: Id +removeTyConDataCons :: TyCon -> TyCon +returnUS :: a -> UniqueSupply -> (UniqueSupply, a) +sourceTypes :: UniType -> [UniType] +splitMultiType :: UniType -> ([[TyVar]], [[(Class, UniType)]], UniType) +splitThetaType :: UniType -> (Class, UniType) +splitTyArgs :: UniType -> ([UniType], UniType) +splitType :: UniType -> ([TyVar], [(Class, UniType)], UniType) +stringPrimTy :: UniType +stringPrimTyCon :: TyCon +stringPrimTyConU :: Int +targetType :: UniType -> UniType +thenUS :: (UniqueSupply -> (UniqueSupply, a)) -> (a -> UniqueSupply -> (UniqueSupply, b)) -> UniqueSupply -> (UniqueSupply, b) +thenUSs :: [UniqueSupply -> (UniqueSupply, a)] -> UniqueSupply -> (UniqueSupply, [a]) +timesDoublePrimId :: Id +timesFloatPrimId :: Id +timesIntPrimId :: Id +timesIntegerPrimId :: Id +tuple0TyCon :: TyCon +tuple2TyCon :: TyCon +tyVarOrTyCon :: UniType -> TyVarOrTyCon +type Arity = Int +type ClassName = QuickString +type ClassOp = (QuickString, UniType) +type ClassOps = [(QuickString, UniType)] +type ConName = QuickString +type ConTag = Int +type DictFun = Id +type DictVar = Id +type ModuleName = QuickString +type RhoType = UniType +type SigmaType = UniType +type TauType = UniType +type ThetaType = [(Class, UniType)] +type TyConName = QuickString +type TyVarName = QuickString +type USap a = UniqueSupply -> (UniqueSupply, a) +type VarName = QuickString +typeWithOneDataCon :: UniType -> Bool +uniformSCCs :: [[TyCon]] -> [Bool] +unifyList :: Subst -> [UniType] -> [UniType] -> MaybeErr Subst UnifyErrInfo +unifyTys :: Subst -> UniType -> UniType -> MaybeErr Subst UnifyErrInfo +verifyTauTy :: UniType -> UniType +zeroTy :: UniType +zeroTyCon :: TyCon +zeroTyConU :: Int diff --git a/ghc/compiler/tests/ccall/Jmakefile b/ghc/compiler/tests/ccall/Jmakefile new file mode 100644 index 0000000000..1327782ccf --- /dev/null +++ b/ghc/compiler/tests/ccall/Jmakefile @@ -0,0 +1,21 @@ +runtests:: + @echo '###############################################################' + @echo '# Validation tests for the ccall desugaring, etc. #' + @echo '###############################################################' + +/* NB These tests are still in a state of flux... don't believe errors + they report. In fact, these aren't really very good tests at + all... */ + +/* Flags used when testing typechecker and desugaring */ +DS_FLAGS= -fglasgow-exts -noC -dcore-lint -ddump-tc -ddump-ds + +RunStdTest(cc001,$(GHC), $(DS_FLAGS) cc001.hs -o2 cc001.stderr) +RunStdTest(cc002,$(GHC), $(DS_FLAGS) cc002.hs -o2 cc002.stderr) +RunStdTest(cc003,$(GHC), $(DS_FLAGS) cc003.hs -x1 -o2 cc003.stderr) +RunStdTest(cc004,$(GHC), $(DS_FLAGS) cc004.hs -o2 cc004.stderr) + +/* Flags used when testing code generation */ +CG_FLAGS= -fglasgow-exts -via-C -dcore-lint -ddump-stg -ddump-flatC + + diff --git a/ghc/compiler/tests/ccall/cc001.hs b/ghc/compiler/tests/ccall/cc001.hs new file mode 100644 index 0000000000..8c37355ca3 --- /dev/null +++ b/ghc/compiler/tests/ccall/cc001.hs @@ -0,0 +1,25 @@ +--!!! cc001 -- ccall with standard boxed arguments and results + +module Test where + +import PreludeGlaIO + +-- simple functions + +a :: PrimIO Int +a = _ccall_ a + +b :: Int -> PrimIO Int +b x = _ccall_ b x + +c :: Int -> Char -> Float -> Double -> PrimIO Float +c x1 x2 x3 x4 = _ccall_ c x1 x2 x3 x4 + +-- simple monadic code + +d = a `thenPrimIO` \ x -> + b x `thenPrimIO` \ y -> + c y 'f' 1.0 2.0 + + + diff --git a/ghc/compiler/tests/ccall/cc001.stderr b/ghc/compiler/tests/ccall/cc001.stderr new file mode 100644 index 0000000000..ab13745029 --- /dev/null +++ b/ghc/compiler/tests/ccall/cc001.stderr @@ -0,0 +1,188 @@ +Typechecked: +lit.t444 = D# 2.0000000000000000## +lit.t443 = F# 1.0000000000000000# +AbsBinds [] [] [(a.t439, Test.a{-r79-})] + {- nonrec -} + a.t439 :: IoWorld -> (Int, IoWorld) + a.t439 + = ccall a [Int] +{- nonrec -} +{- nonrec -} +AbsBinds [] [] [(b.t440, Test.b{-r80-})] + {- nonrec -} + b.t440 :: Int -> IoWorld -> (Int, IoWorld) + b.t440 + x.r212 = ccall b [Int, Int] x.r212 +{- nonrec -} +{- nonrec -} +AbsBinds [] [] [(c.t441, Test.c{-r81-})] + {- nonrec -} + c.t441 :: Int -> Char -> Float -> Double -> IoWorld -> (Float, IoWorld) + c.t441 + x1.r213 x2.r214 x3.r215 x4.r216 + = ccall c [Float, Int, Char, Float, Double] + x1.r213 x2.r214 x3.r215 x4.r216 +{- nonrec -} +{- nonrec -} +AbsBinds [] [] [(d.t442, Test.d{-r82-})] + {- nonrec -} + d.t442 :: IoWorld -> (Float, IoWorld) + d.t442 + = (thenIO{-r102-} [Int, Float]) + Test.a{-r79-} + (\ x.r217 -> (thenIO{-r102-} [Int, Float]) + (Test.b{-r80-} x.r217) + (\ y.r218 -> Test.c{-r81-} + y.r218 'f' lit.t443 lit.t444)) +{- nonrec -} +{- nonrec -} +Desugared: +{- plain CoRec -} +lit.t444 :: Double +_NI_ +lit.t444 = (\ tpl.d0# -> D#! tpl.d0#) 2.0000000000000000## +lit.t443 :: Float +_NI_ +lit.t443 = (\ tpl.d1# -> F#! tpl.d1#) 1.0000000000000000# +Test.a{-r79-} :: IoWorld -> (Int, IoWorld) +_NI_ +Test.a{-r79-} = + \ ds.d2 -> + case + (case + (case ds.d2 of { + IoWorld ds.d3# -> ds.d3# + }) + of { + a.d8# -> ( _CCALL_ a [] Int# )! a.d8# + }) + of { + IntPrimAndIoWorld ds.d4# ds.d5# -> + let { + a.d6 :: Int + _NI_ + a.d6 = I#! ds.d4# } in + let { + a.d7 :: IoWorld + _NI_ + a.d7 = IoWorld! ds.d5# + } in Tup2! Int IoWorld a.d6 a.d7 + } +Test.b{-r80-} :: Int -> IoWorld -> (Int, IoWorld) +_NI_ +Test.b{-r80-} = + \ x.r212 ds.d9 -> + case + (case + (case ds.d9 of { + IoWorld ds.d10# -> ds.d10# + }) + of { + a.d16# -> + case + (case x.r212 of { + I# ds.d11# -> ds.d11# + }) + of { + a.d17# -> ( _CCALL_ b [Int#] Int# )! a.d16# a.d17# + } + }) + of { + IntPrimAndIoWorld ds.d12# ds.d13# -> + let { + a.d14 :: Int + _NI_ + a.d14 = I#! ds.d12# } in + let { + a.d15 :: IoWorld + _NI_ + a.d15 = IoWorld! ds.d13# + } in Tup2! Int IoWorld a.d14 a.d15 + } +Test.c{-r81-} :: Int -> Char -> Float -> Double -> IoWorld -> (Float, IoWorld) +_NI_ +Test.c{-r81-} = + \ x1.r213 x2.r214 x3.r215 x4.r216 ds.d18 -> + case + (case + (case ds.d18 of { + IoWorld ds.d19# -> ds.d19# + }) + of { + a.d28# -> + case + (case x1.r213 of { + I# ds.d20# -> ds.d20# + }) + of { + a.d29# -> + case + (case x2.r214 of { + C# ds.d21# -> ds.d21# + }) + of { + a.d30# -> + case + (case x3.r215 of { + F# ds.d22# -> ds.d22# + }) + of { + a.d31# -> + case + (case x4.r216 of { + D# ds.d23# -> ds.d23# + }) + of { + a.d32# -> + ( _CCALL_ c [Int#, + Char#, + Float#, + Double#] Float# )! + a.d28# + a.d29# + a.d30# + a.d31# + a.d32# + } + } + } + } + }) + of { + FloatPrimAndIoWorld ds.d24# ds.d25# -> + let { + a.d26 :: Float + _NI_ + a.d26 = F#! ds.d24# } in + let { + a.d27 :: IoWorld + _NI_ + a.d27 = IoWorld! ds.d25# + } in Tup2! Float IoWorld a.d26 a.d27 + } +Test.d{-r82-} :: IoWorld -> (Float, IoWorld) +_NI_ +Test.d{-r82-} = + let { + a.d36 :: Int -> IoWorld -> (Float, IoWorld) + _NI_ + a.d36 = + \ x.r217 -> + let { + a.d35 :: Int -> IoWorld -> (Float, IoWorld) + _NI_ + a.d35 = + \ y.r218 -> + (let { + a.d33 :: Char + _NI_ + a.d33 = C#! 'f'# + } in Test.c{-r81-} y.r218 a.d33) lit.t443 lit.t444 + } in + (let { + a.d34 :: IoWorld -> (Int, IoWorld) + _NI_ + a.d34 = Test.b{-r80-} x.r217 + } in ((thenIO{-r102-} Int) Float) a.d34) a.d35 + } in ((thenIO{-r102-} Int) Float) Test.a{-r79-} a.d36 +{- end plain CoRec -} diff --git a/ghc/compiler/tests/ccall/cc002.hs b/ghc/compiler/tests/ccall/cc002.hs new file mode 100644 index 0000000000..3a4b66d1d7 --- /dev/null +++ b/ghc/compiler/tests/ccall/cc002.hs @@ -0,0 +1,21 @@ +--!!! cc002 -- ccall with non-standard boxed arguments and results + +module Test where + +import PreludeGlaIO + +-- Test returning results + +a :: PrimIO _MallocPtr +a = _ccall_ a + +b :: PrimIO _StablePtr +b = _ccall_ b + +-- Test taking arguments + +c :: _MallocPtr -> PrimIO Int +c x = _ccall_ c x + +d :: _StablePtr -> PrimIO Int +d x = _ccall_ d x diff --git a/ghc/compiler/tests/ccall/cc002.stderr b/ghc/compiler/tests/ccall/cc002.stderr new file mode 100644 index 0000000000..2f097cff48 --- /dev/null +++ b/ghc/compiler/tests/ccall/cc002.stderr @@ -0,0 +1,140 @@ +Typechecked: +AbsBinds [] [] [(a.t439, Test.a{-r79-})] + {- nonrec -} + a.t439 :: IoWorld -> (CHeapPtr, IoWorld) + a.t439 + = ccall a [CHeapPtr] +{- nonrec -} +{- nonrec -} +AbsBinds [] [] [(b.t440, Test.b{-r80-})] + {- nonrec -} + b.t440 :: IoWorld -> (StablePtr, IoWorld) + b.t440 + = ccall b [StablePtr] +{- nonrec -} +{- nonrec -} +AbsBinds [] [] [(c.t441, Test.c{-r81-})] + {- nonrec -} + c.t441 :: CHeapPtr -> IoWorld -> (Int, IoWorld) + c.t441 + x.r211 = ccall c [Int, CHeapPtr] x.r211 +{- nonrec -} +{- nonrec -} +AbsBinds [] [] [(d.t442, Test.d{-r82-})] + {- nonrec -} + d.t442 :: StablePtr -> IoWorld -> (Int, IoWorld) + d.t442 + x.r212 = ccall d [Int, StablePtr] x.r212 +{- nonrec -} +{- nonrec -} +Desugared: +Test.a{-r79-} :: IoWorld -> (CHeapPtr, IoWorld) +_NI_ +Test.a{-r79-} = + \ ds.d0 -> + case + (case + (case ds.d0 of { + IoWorld ds.d1# -> ds.d1# + }) + of { + a.d6# -> ( _CCALL_ a [] CHeapPtr# )! a.d6# + }) + of { + CHPPrimAndIoWorld ds.d2# ds.d3# -> + let { + a.d4 :: CHeapPtr + _NI_ + a.d4 = CHP#! ds.d2# } in + let { + a.d5 :: IoWorld + _NI_ + a.d5 = IoWorld! ds.d3# + } in Tup2! CHeapPtr IoWorld a.d4 a.d5 + } +Test.b{-r80-} :: IoWorld -> (StablePtr, IoWorld) +_NI_ +Test.b{-r80-} = + \ ds.d7 -> + case + (case + (case ds.d7 of { + IoWorld ds.d8# -> ds.d8# + }) + of { + a.d13# -> ( _CCALL_ b [] StablePtr# )! a.d13# + }) + of { + SPPrimAndIoWorld ds.d9# ds.d10# -> + let { + a.d11 :: StablePtr + _NI_ + a.d11 = StablePtr#! ds.d9# } in + let { + a.d12 :: IoWorld + _NI_ + a.d12 = IoWorld! ds.d10# + } in Tup2! StablePtr IoWorld a.d11 a.d12 + } +Test.c{-r81-} :: CHeapPtr -> IoWorld -> (Int, IoWorld) +_NI_ +Test.c{-r81-} = + \ x.r211 ds.d14 -> + case + (case + (case ds.d14 of { + IoWorld ds.d15# -> ds.d15# + }) + of { + a.d21# -> + case + (case x.r211 of { + CHP# ds.d16# -> ds.d16# + }) + of { + a.d22# -> ( _CCALL_ c [CHeapPtr#] Int# )! a.d21# a.d22# + } + }) + of { + IntPrimAndIoWorld ds.d17# ds.d18# -> + let { + a.d19 :: Int + _NI_ + a.d19 = I#! ds.d17# } in + let { + a.d20 :: IoWorld + _NI_ + a.d20 = IoWorld! ds.d18# + } in Tup2! Int IoWorld a.d19 a.d20 + } +Test.d{-r82-} :: StablePtr -> IoWorld -> (Int, IoWorld) +_NI_ +Test.d{-r82-} = + \ x.r212 ds.d23 -> + case + (case + (case ds.d23 of { + IoWorld ds.d24# -> ds.d24# + }) + of { + a.d30# -> + case + (case x.r212 of { + StablePtr# ds.d25# -> ds.d25# + }) + of { + a.d31# -> ( _CCALL_ d [StablePtr#] Int# )! a.d30# a.d31# + } + }) + of { + IntPrimAndIoWorld ds.d26# ds.d27# -> + let { + a.d28 :: Int + _NI_ + a.d28 = I#! ds.d26# } in + let { + a.d29 :: IoWorld + _NI_ + a.d29 = IoWorld! ds.d27# + } in Tup2! Int IoWorld a.d28 a.d29 + } diff --git a/ghc/compiler/tests/ccall/cc003.hs b/ghc/compiler/tests/ccall/cc003.hs new file mode 100644 index 0000000000..5b8bd822e2 --- /dev/null +++ b/ghc/compiler/tests/ccall/cc003.hs @@ -0,0 +1,8 @@ +--!!! cc003 -- ccall with unresolved polymorphism (should fail) +module Test where + +import PreludeGlaIO + +fubar :: PrimIO Int +fubar = ccall f `seqPrimIO` ccall b + --^ result type of f "lost" (never gets generalised) diff --git a/ghc/compiler/tests/ccall/cc003.stderr b/ghc/compiler/tests/ccall/cc003.stderr new file mode 100644 index 0000000000..4b2772f3ce --- /dev/null +++ b/ghc/compiler/tests/ccall/cc003.stderr @@ -0,0 +1,15 @@ +Typechecked: +AbsBinds [] [] [(fubar.t439, Main.fubar{-r79-})] + {- nonrec -} + fubar.t439 :: IoWorld -> (Int, IoWorld) + fubar.t439 + = (thenIO_{-r99-} [bpv83, Int]) (ccall f [bpv83] ) (ccall b [Int] ) +{- nonrec -} +{- nonrec -} +Desugared: + +Fail: panic! (the `impossible' happened): + getBoxedPrimTypeInfo: bpv83 + +Please report it as a compiler bug to glasgow-haskell-bugs@dcs.glasgow.ac.uk. + diff --git a/ghc/compiler/tests/ccall/cc004.hs b/ghc/compiler/tests/ccall/cc004.hs new file mode 100644 index 0000000000..7ad0ceda16 --- /dev/null +++ b/ghc/compiler/tests/ccall/cc004.hs @@ -0,0 +1,29 @@ +--!!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables. +module Test where + +import PreludeGlaIO + +-- Since I messed up the handling of polymorphism originally, I'll +-- explicitly test code with UserSysTyVar (ie an explicit polymorphic +-- signature) + +foo = _ccall_ f `thenADR` \ a -> returnPrimIO (a + 1) + where + thenADR :: PrimIO a -> (a -> PrimIO b) -> PrimIO b + m `thenADR` k = \ s -> case m s of + (a,t) -> k a t + +-- and with a PolySysTyVar (ie no explicit signature) + +bar = _ccall_ f `thenADR` \ a -> returnPrimIO (a + 1) + where + -- thenADR :: PrimIO a -> (a -> PrimIO b) -> PrimIO b + m `thenADR` k = \ s -> case m s of + (a,t) -> k a t + +-- and with a type synonym + +type INT = Int +barfu :: PrimIO INT +barfu = _ccall_ b + diff --git a/ghc/compiler/tests/ccall/cc004.stderr b/ghc/compiler/tests/ccall/cc004.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/ccall/cc004.stderr diff --git a/ghc/compiler/tests/deSugar/Jmakefile b/ghc/compiler/tests/deSugar/Jmakefile new file mode 100644 index 0000000000..e513463ada --- /dev/null +++ b/ghc/compiler/tests/deSugar/Jmakefile @@ -0,0 +1,54 @@ +#define IHaveSubdirs + +SUBDIRS = cvh-ds-unboxed + +runtests:: + @echo '###############################################################' + @echo '# Validation tests for the desugarer. #' + @echo '###############################################################' + +FLAGS=-noC -ddump-ds -dcore-lint + +RunStdTest(ds001,$(GHC), $(FLAGS) ds001.hs -o2 ds001.stderr) +RunStdTest(ds002,$(GHC), $(FLAGS) ds002.hs -o2 ds002.stderr) +RunStdTest(ds003,$(GHC), $(FLAGS) ds003.hs -o2 ds003.stderr) +RunStdTest(ds004,$(GHC), $(FLAGS) ds004.hs -o2 ds004.stderr) +RunStdTest(ds005,$(GHC), $(FLAGS) ds005.hs -o2 ds005.stderr) +RunStdTest(ds006,$(GHC), $(FLAGS) ds006.hs -o2 ds006.stderr) +RunStdTest(ds007,$(GHC), $(FLAGS) ds007.hs -o2 ds007.stderr) +RunStdTest(ds008,$(GHC), $(FLAGS) ds008.hs -o2 ds008.stderr) +RunStdTest(ds009,$(GHC), $(FLAGS) ds009.hs -o2 ds009.stderr) +RunStdTest(ds010,$(GHC), $(FLAGS) ds010.hs -o2 ds010.stderr) +RunStdTest(ds011,$(GHC), $(FLAGS) ds011.hs -o2 ds011.stderr) +RunStdTest(ds012,$(GHC), $(FLAGS) ds012.hs -o2 ds012.stderr) +RunStdTest(ds013,$(GHC), $(FLAGS) ds013.hs -o2 ds013.stderr) + +RunStdTest(ds014,$(GHC), $(FLAGS) ds014.hs -o2 ds014.stderr) +AsPartOfTest(ds014,@echo 'ds014a -- some things that should NOT go through -- not done yet') + +RunStdTest(ds015,$(GHC), $(FLAGS) ds015.hs -o2 ds015.stderr) +RunStdTest(ds016,$(GHC), $(FLAGS) ds016.hs -o2 ds016.stderr) +RunStdTest(ds017,$(GHC), $(FLAGS) ds017.hs -o2 ds017.stderr) +RunStdTest(ds018,$(GHC), $(FLAGS) ds018.hs -o2 ds018.stderr) +RunStdTest(ds019,$(GHC), $(FLAGS) ds019.hs -o2 ds019.stderr) +RunStdTest(ds020,$(GHC), $(FLAGS) ds020.hs -o2 ds020.stderr) +RunStdTest(ds021,$(GHC), $(FLAGS) ds021.hs -o2 ds021.stderr) +RunStdTest(ds022,$(GHC), $(FLAGS) ds022.hs -o2 ds022.stderr) +RunStdTest(ds023,$(GHC), $(FLAGS) ds023.hs -o2 ds023.stderr) +RunStdTest(ds024,$(GHC), $(FLAGS) ds024.hs -o2 ds024.stderr) +RunStdTest(ds025,$(GHC), $(FLAGS) ds025.hs -o2 ds025.stderr) +RunStdTest(ds026,$(GHC), $(FLAGS) ds026.hs -o2 ds026.stderr) +RunStdTest(ds027,$(GHC), $(FLAGS) ds027.hs -o2 ds027.stderr) +RunStdTest(ds028,$(GHC), $(FLAGS) ds028.hs -o2 ds028.stderr) +RunStdTest(ds029,$(GHC), $(FLAGS) ds029.hs -o2 ds029.stderr) +RunStdTest(ds030,$(GHC), $(FLAGS) ds030.hs -dppr-all -o2 ds030.stderr) +RunStdTest(ds031,$(GHC), $(FLAGS) ds031.hs -o2 ds031.stderr) +RunStdTest(ds032,$(GHC), $(FLAGS) ds032.hs -o2 ds032.stderr) +RunStdTest(ds033,$(GHC), $(FLAGS) ds033.hs -o2 ds033.stderr) +RunStdTest(ds034,$(GHC), $(FLAGS) ds034.hs -o2 ds034.stderr) +RunStdTest(ds035,$(GHC), -fglasgow-exts $(FLAGS) ds035.hs -o2 ds035.stderr) +RunStdTest(ds036,$(GHC), $(FLAGS) ds036.hs -o2 ds036.stderr) +RunStdTest(ds037,$(GHC), $(FLAGS) ds037.hs -o2 ds037.stderr) +RunStdTest(ds038,$(GHC), $(FLAGS) ds038.hs -o2 ds038.stderr) +RunStdTest(ds039,$(GHC), $(FLAGS) -dppr-all ds039.hs -o2 ds039.stderr) +RunStdTest(ds040,$(GHC), $(FLAGS) ds040.hs -o2 ds040.stderr) diff --git a/ghc/compiler/tests/deSugar/cvh-ds-unboxed/Jmakefile b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/Jmakefile new file mode 100644 index 0000000000..a418eb62a3 --- /dev/null +++ b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/Jmakefile @@ -0,0 +1,3 @@ +FLAGS=-noC -ddump-ds -fglasgow-exts + +RunStdTest(cvh-unbox1,$(GHC),$(FLAGS) Life2.lhs -o2 cvh-unbox1.stderr) diff --git a/ghc/compiler/tests/deSugar/cvh-ds-unboxed/Life2.lhs b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/Life2.lhs new file mode 100644 index 0000000000..30de1a3782 --- /dev/null +++ b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/Life2.lhs @@ -0,0 +1,39 @@ +\section{Life2} + +\begin{code} +module Life2 (life2) where +import UTypes +import UCopy (copy_FI) + +life2 itLimit boardSize + = (fBStr firstBoard) ++ (fBStr secondBoard) + where {- ... -} + +\end{code} + +\begin{code} + fBStr :: FI -> String + fBStr FIN = [] + +{- OK + firstBoard :: FI + firstBoard = copy_FI boardSize (case 0 of + (MkInt x) -> x) +-} + +{- not happy about this -} + + firstBoard = copy_FI boardSize u0 + u0 = unBoxInt 0 + unBoxInt (MkInt x) = x +{- end of not happy -} + +{- not happy with this either! -} + + secondBoard = copy_FI boardSize u1 + + (MkInt u1) = 0 +{- end of second not happy -} +\end{code} + + diff --git a/ghc/compiler/tests/deSugar/cvh-ds-unboxed/UCopy.hi b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/UCopy.hi new file mode 100644 index 0000000000..314de4e6de --- /dev/null +++ b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/UCopy.hi @@ -0,0 +1,9 @@ +interface UCopy where +import UTypes(F3I(..), FC(..), FI(..), LI(..), SC(..), SI(..)) +copy_FI :: Int -> IntPrim -> FI {-# ARITY _ = 2 #-} +data F3I = F3IN | F3I1 IntPrim IntPrim IntPrim | F3I2 IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim | F3I3 IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim | F3I4 IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim | F3I5 IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim F3I +data FC = FCN | FC1 Char# | FC2 Char# Char# | FC3 Char# Char# Char# | FC4 Char# Char# Char# Char# | FC5 Char# Char# Char# Char# Char# FC +data FI = FIN | FI1 IntPrim | FI2 IntPrim IntPrim | FI3 IntPrim IntPrim IntPrim | FI4 IntPrim IntPrim IntPrim IntPrim | FI5 IntPrim IntPrim IntPrim IntPrim IntPrim FI +data LI = LIN | LI1 IntPrim LI +data SC = SCN | SC1 Char# SC | SC2 Char# Char# SC | SC3 Char# Char# Char# SC | SC4 Char# Char# Char# Char# SC | SC5 Char# Char# Char# Char# Char# SC +data SI = SIN | SI1 IntPrim SI | SI2 IntPrim IntPrim SI | SI3 IntPrim IntPrim IntPrim SI | SI4 IntPrim IntPrim IntPrim IntPrim SI | SI5 IntPrim IntPrim IntPrim IntPrim IntPrim SI diff --git a/ghc/compiler/tests/deSugar/cvh-ds-unboxed/UTypes.hi b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/UTypes.hi new file mode 100644 index 0000000000..896a29cead --- /dev/null +++ b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/UTypes.hi @@ -0,0 +1,7 @@ +interface UTypes where +data F3I = F3IN | F3I1 IntPrim IntPrim IntPrim | F3I2 IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim | F3I3 IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim | F3I4 IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim | F3I5 IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim IntPrim F3I +data FC = FCN | FC1 Char# | FC2 Char# Char# | FC3 Char# Char# Char# | FC4 Char# Char# Char# Char# | FC5 Char# Char# Char# Char# Char# FC +data FI = FIN | FI1 IntPrim | FI2 IntPrim IntPrim | FI3 IntPrim IntPrim IntPrim | FI4 IntPrim IntPrim IntPrim IntPrim | FI5 IntPrim IntPrim IntPrim IntPrim IntPrim FI +data LI = LIN | LI1 IntPrim LI +data SC = SCN | SC1 Char# SC | SC2 Char# Char# SC | SC3 Char# Char# Char# SC | SC4 Char# Char# Char# Char# SC | SC5 Char# Char# Char# Char# Char# SC +data SI = SIN | SI1 IntPrim SI | SI2 IntPrim IntPrim SI | SI3 IntPrim IntPrim IntPrim SI | SI4 IntPrim IntPrim IntPrim IntPrim SI | SI5 IntPrim IntPrim IntPrim IntPrim IntPrim SI diff --git a/ghc/compiler/tests/deSugar/cvh-ds-unboxed/cvh-unbox1.stderr b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/cvh-unbox1.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deSugar/cvh-ds-unboxed/cvh-unbox1.stderr diff --git a/ghc/compiler/tests/deSugar/ds-wildcard.hs b/ghc/compiler/tests/deSugar/ds-wildcard.hs new file mode 100644 index 0000000000..24c5b3b91b --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds-wildcard.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +x@_ = x diff --git a/ghc/compiler/tests/deSugar/ds001.hs b/ghc/compiler/tests/deSugar/ds001.hs new file mode 100644 index 0000000000..0358f2022e --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds001.hs @@ -0,0 +1,25 @@ +--!!! ds001 -- simple function and pattern bindings +-- +-- this tests ultra-simple function and pattern bindings (no patterns) + +module Test where + +-- simple function bindings + +f x = x + +g x y z = f z + +j w x y z = g w x z + +h x y = f y + where + f a b = a + +-- simple pattern bindings + +a = b + +b = f + +c = c diff --git a/ghc/compiler/tests/deSugar/ds001.stderr b/ghc/compiler/tests/deSugar/ds001.stderr new file mode 100644 index 0000000000..6282a3e5cc --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds001.stderr @@ -0,0 +1,23 @@ +Desugared: +Test.f :: for all d. d -> d +Test.f = /\ o95 -> \ x.129 -> x.129 +Test.g :: for all d, e, f. d -> e -> f -> f +Test.g = /\ o98 o99 t101 -> \ x.130 y.131 z.132 -> (Test.f t101) z.132 +Test.j :: for all d, e, f, g. d -> e -> f -> g -> g +Test.j = + /\ t108 t109 o106 t110 -> \ w.133 x.134 y.135 z.136 -> + (((Test.g t108) t109) t110) w.133 x.134 z.136 +Test.h :: for all d, e, f. d -> f -> e -> f +Test.h = + /\ o113 t119 t120 -> \ x.139 y.140 -> + let f.145 = /\ o141 o142 -> \ a.143 b.144 -> a.143 + in ((f.145 t119) t120) y.140 +Test.b :: for all d. d -> d +Test.b = /\ t123 -> Test.f t123 +Test.a :: for all d. d -> d +Test.a = /\ t126 -> Test.b t126 +{- plain CoRec -} +Test.c :: for all d. d +Test.c = /\ t127 -> Test.c t127 +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds002.hs b/ghc/compiler/tests/deSugar/ds002.hs new file mode 100644 index 0000000000..d754636596 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds002.hs @@ -0,0 +1,16 @@ +--!!! ds002 -- overlapping equations and guards +-- +-- this tests "overlapping" variables and guards + +module Test where + +f x = x +f y = y +f z = z + +g x y z | True = f z + | True = f z + | True = f z +g x y z | True = f z + | True = f z + | True = f z diff --git a/ghc/compiler/tests/deSugar/ds002.stderr b/ghc/compiler/tests/deSugar/ds002.stderr new file mode 100644 index 0000000000..4cd3d62ead --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds002.stderr @@ -0,0 +1,12 @@ +Desugared: +Test.f :: for all d. d -> d +Test.f = /\ o88 -> \ x.104 -> x.104 +Test.g :: for all d, e, f. d -> e -> f -> f +Test.g = + /\ o97 o98 t102 -> \ x.106 y.107 z.108 -> + let + fail.109 = + (error t102) + "\"ds002.hs\", line 16: pattern-matching failure [function binding]\n"S + in (Test.f t102) z.108 + diff --git a/ghc/compiler/tests/deSugar/ds003.hs b/ghc/compiler/tests/deSugar/ds003.hs new file mode 100644 index 0000000000..f68346ded1 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds003.hs @@ -0,0 +1,8 @@ +--!!! ds003 -- list, tuple, lazy, as patterns +-- +module Test where + +f [] y True = [] +f x a@(y,ys) ~z = [] +f (x:x1:x2:x3) ~(y,ys) z = [] +f x y True = [] diff --git a/ghc/compiler/tests/deSugar/ds003.stderr b/ghc/compiler/tests/deSugar/ds003.stderr new file mode 100644 index 0000000000..da843e7124 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds003.stderr @@ -0,0 +1,61 @@ +Desugared: +Test.f :: for all d, e, f, g. [d] -> (e, f) -> Bool -> [g] +Test.f = + /\ t106 o107 o108 t113 -> \ ds.122 y.123 ds.124 -> + let + fail.125 = + (error [t113]) + "\"ds003.hs\", line 8: pattern-matching failure [function binding]\n"S in + let + fail.149 = + let + fail.142 = + let + fail.128 = + case ds.124 of { + True -> + let y.126 = y.123 in + let x.127 = ds.122 in Nil! t113 + _ -> fail.125 + } + in + case ds.122 of { + (:) x.129 ds.130 -> + case ds.130 of { + (:) x1.131 ds.132 -> + case ds.132 of { + (:) x2.133 x3.134 -> + let z.135 = ds.124 in + let + y.138 = + case y.123 of { + MkTuple2 y.136 ys.137 -> y.136 + } in + let + ys.141 = + case y.123 of { + MkTuple2 y.139 ys.140 -> ys.140 + } + in Nil! t113 + _ -> fail.128 + } + _ -> fail.128 + } + _ -> fail.128 + } + in + case y.123 of { + MkTuple2 y.143 ys.144 -> + let z.146 = let z.145 = ds.124 in z.145 in + let a.147 = y.123 in let x.148 = ds.122 in Nil! t113 + } + in + case ds.122 of { + Nil -> + case ds.124 of { + True -> Nil! t113 + _ -> fail.149 + } + _ -> fail.149 + } + diff --git a/ghc/compiler/tests/deSugar/ds004.hs b/ghc/compiler/tests/deSugar/ds004.hs new file mode 100644 index 0000000000..ef9d0b40d3 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds004.hs @@ -0,0 +1,9 @@ +--!!! ds004 -- nodups from SLPJ p 79 +-- +module Test where + +-- SLPJ, p 79 +nodups [] = [] +nodups [x] = [x] +nodups (y:x:xs) | y == x = nodups (x:xs) + | True = y : nodups (x:xs) diff --git a/ghc/compiler/tests/deSugar/ds004.stderr b/ghc/compiler/tests/deSugar/ds004.stderr new file mode 100644 index 0000000000..5890e923b5 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds004.stderr @@ -0,0 +1,31 @@ +Desugared: +{- plain CoRec -} +Test.nodups :: for all d. <Eq d> -> [d] -> [d] +Test.nodups = + /\ t95 -> \ dict.90 ds.103 -> + let + fail.104 = + (error [t95]) + "\"ds004.hs\", line 9: pattern-matching failure [function binding]\n"S + in + case ds.103 of { + Nil -> Nil! t95 + (:) x.105 ds.106 -> + case ds.106 of { + Nil -> :! t95 x.105 (Nil! t95) + (:) x.107 xs.108 -> + let y.109 = x.105 + in + case ((== t95) dict.90 y.109 x.107) of { + True -> + (Test.nodups t95) dict.90 ((: t95) x.107 xs.108) + False -> + (: t95) + y.109 + ((Test.nodups t95) + dict.90 ((: t95) x.107 xs.108)) + } + } + } +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds005.hs b/ghc/compiler/tests/deSugar/ds005.hs new file mode 100644 index 0000000000..505d500e3f --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds005.hs @@ -0,0 +1,15 @@ +--!!! ds005 -- mappairs from SLPJ Ch 5' +-- +-- this simply tests a "typical" example + +module MapPairs where + +-- from SLPJ, p 78 +mappairs f [] ys = [] +mappairs f (x:xs) [] = [] +mappairs f (x:xs) (y:ys) = f x y : mappairs f xs ys + +-- from p 80 +mappairs' f [] ys = [] +mappairs' f x [] = [] +mappairs' f (x:xs) (y:ys) = f x y : mappairs' f xs ys diff --git a/ghc/compiler/tests/deSugar/ds005.stderr b/ghc/compiler/tests/deSugar/ds005.stderr new file mode 100644 index 0000000000..84c0664ddd --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds005.stderr @@ -0,0 +1,65 @@ +Desugared: +{- plain CoRec -} +MapPairs.mappairs :: for all d, e, f. (d -> e -> f) -> [d] -> [e] -> [f] +MapPairs.mappairs = + /\ t109 t112 t105 -> \ f.146 ds.147 ys.148 -> + let + fail.149 = + (error [t105]) + "\"ds005.hs\", line 10: pattern-matching failure [function binding]\n"S + in + case ds.147 of { + Nil -> Nil! t105 + (:) x.150 xs.151 -> + case ys.148 of { + Nil -> let f.152 = f.146 in Nil! t105 + (:) y.153 ys.154 -> + let xs.155 = xs.151 in + let x.156 = x.150 in + let f.157 = f.146 + in + (: t105) + (f.157 x.156 y.153) + ((((MapPairs.mappairs t109) t112) t105) + f.157 xs.155 ys.154) + } + } +{- end plain CoRec -} +{- plain CoRec -} +MapPairs.mappairs' :: for all d, e, f. (d -> e -> f) -> [d] -> [e] -> [f] +MapPairs.mappairs' = + /\ t133 t136 t129 -> \ f.162 ds.163 ys.164 -> + let + fail.165 = + (error [t129]) + "\"ds005.hs\", line 15: pattern-matching failure [function binding]\n"S in + let + fail.174 = + let + fail.171 = + case ds.163 of { + (:) x.166 xs.167 -> + case ys.164 of { + (:) y.168 ys.169 -> + let f.170 = f.162 + in + (: t129) + (f.170 x.166 y.168) + ((((MapPairs.mappairs' t133) t136) t129) + f.170 xs.167 ys.169) + _ -> fail.165 + } + _ -> fail.165 + } + in + case ys.164 of { + Nil -> let x.172 = ds.163 in let f.173 = f.162 in Nil! t129 + _ -> fail.171 + } + in + case ds.163 of { + Nil -> Nil! t129 + _ -> fail.174 + } +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds006.hs b/ghc/compiler/tests/deSugar/ds006.hs new file mode 100644 index 0000000000..6df589e215 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds006.hs @@ -0,0 +1,6 @@ +--!!! ds006 -- v | True = v+1 | False = v (dead code elim) +-- +module Test where + +v | True = v + 1 + | False = v diff --git a/ghc/compiler/tests/deSugar/ds006.stderr b/ghc/compiler/tests/deSugar/ds006.stderr new file mode 100644 index 0000000000..0db25c87ea --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds006.stderr @@ -0,0 +1,19 @@ +Desugared: +Test.v :: for all d. <Num d> -> d +Test.v = + /\ t78 -> \ dict.79 -> + let dict.77 = dict.79 + in + let + {- CoRec -} + v.75 = + let + fail.81 = + (error t78) + "\"ds006.hs\", line 6: pattern-matching failure [function binding]\n"S + in + (+ t78) + dict.77 v.75 ((fromInteger t78) dict.79 (MkInteger! 1##)) + {- end CoRec -} + in v.75 + diff --git a/ghc/compiler/tests/deSugar/ds007.hs b/ghc/compiler/tests/deSugar/ds007.hs new file mode 100644 index 0000000000..5b2b752e93 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds007.hs @@ -0,0 +1,6 @@ +--!!! ds007 -- simple local bindings + +module ShouldSucceed where + +w = a where a = y + y = [] diff --git a/ghc/compiler/tests/deSugar/ds007.stderr b/ghc/compiler/tests/deSugar/ds007.stderr new file mode 100644 index 0000000000..fad21b77c9 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds007.stderr @@ -0,0 +1,7 @@ +Desugared: +ShouldSucceed.w :: for all d. [d] +ShouldSucceed.w = + /\ t84 -> + let y.86 = /\ t85 -> Nil! t85 in + let a.88 = /\ t87 -> y.86 t87 in a.88 t84 + diff --git a/ghc/compiler/tests/deSugar/ds008.hs b/ghc/compiler/tests/deSugar/ds008.hs new file mode 100644 index 0000000000..1264d13d8f --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds008.hs @@ -0,0 +1,11 @@ +--!!! ds008 -- free tyvars on RHSs +-- +-- these tests involve way-cool TyApps + +module Test where + +f x = [] + +g x = (f [],[],[],[]) + +h x = g (1::Int) diff --git a/ghc/compiler/tests/deSugar/ds008.stderr b/ghc/compiler/tests/deSugar/ds008.stderr new file mode 100644 index 0000000000..240c4774f4 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds008.stderr @@ -0,0 +1,21 @@ +Desugared: +Test.f :: for all d, e. d -> [e] +Test.f = /\ o81 t82 -> \ x.102 -> Nil! t82 +Test.g :: for all d, e, f, g, h. d -> ([e], [f], [g], [h]) +Test.g = + /\ o85 t87 t89 t90 t91 -> \ x.103 -> + MkTuple4! + [t87] + [t89] + [t90] + [t91] + (((Test.f [t88]) t87) (Nil! t88)) + (Nil! t89) + (Nil! t90) + (Nil! t91) +Test.h :: for all d, e, f, g, h. d -> ([e], [f], [g], [h]) +Test.h = + /\ o94 t96 t97 t98 t99 -> \ x.104 -> + (((((Test.g Int) t96) t97) t98) t99) + (let dict.105 = dfun.Num.Int in MkInt! 1#) + diff --git a/ghc/compiler/tests/deSugar/ds009.hs b/ghc/compiler/tests/deSugar/ds009.hs new file mode 100644 index 0000000000..370b6290db --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds009.hs @@ -0,0 +1,13 @@ +--!!! ds009 -- simple list comprehensions + +module SimpleListComp where + +f xs = [ x | x <- xs ] + +g xs ys zs = [ (x,y,z) | x <- xs, y <- ys, z <- zs, True ] + +h xs ys = [ [x,y] | x <- xs, y <- ys, False ] + +i xs = [ x | all@(x,y) <- xs, all == ([],[]) ] + +j xs = [ (a,b) | (a,b,c,d) <- xs ] diff --git a/ghc/compiler/tests/deSugar/ds009.stderr b/ghc/compiler/tests/deSugar/ds009.stderr new file mode 100644 index 0000000000..a60a3dea83 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds009.stderr @@ -0,0 +1,150 @@ +Desugared: +SimpleListComp.f :: for all d. [d] -> [d] +SimpleListComp.f = + /\ t104 -> \ xs.145 -> + let + {- CoRec -} + ds.146 = + \ ds.147 -> + case ds.147 of { + Nil -> Nil t104 + (:) ds.148 ds.149 -> + let x.150 = ds.148 in (: t104) x.150 (ds.146 ds.149) + } + {- end CoRec -} + in ds.146 xs.145 +SimpleListComp.g :: for all d, e, f. [d] -> [e] -> [f] -> [(d, e, f)] +SimpleListComp.g = + /\ t110 t111 t112 -> \ xs.163 ys.164 zs.165 -> + let + {- CoRec -} + ds.166 = + \ ds.167 -> + case ds.167 of { + Nil -> Nil (t110, t111, t112) + (:) ds.168 ds.169 -> + let x.170 = ds.168 + in + let + {- CoRec -} + ds.171 = + \ ds.172 -> + case ds.172 of { + Nil -> ds.166 ds.169 + (:) ds.173 ds.174 -> + let y.175 = ds.173 + in + let + {- CoRec -} + ds.176 = + \ ds.177 -> + case ds.177 of { + Nil -> ds.171 ds.174 + (:) ds.178 ds.179 -> + let z.180 = ds.178 + in + (: (t110, + t111, + t112)) + (MkTuple3! + t110 + t111 + t112 + x.170 + y.175 + z.180) + (ds.176 ds.179) + } + {- end CoRec -} + in ds.176 zs.165 + } + {- end CoRec -} + in ds.171 ys.164 + } + {- end CoRec -} + in ds.166 xs.163 +SimpleListComp.h :: for all d. [d] -> [d] -> [[d]] +SimpleListComp.h = + /\ t118 -> \ xs.189 ys.190 -> + let + {- CoRec -} + ds.191 = + \ ds.192 -> + case ds.192 of { + Nil -> Nil [t118] + (:) ds.193 ds.194 -> + let x.195 = ds.193 + in + let + {- CoRec -} + ds.196 = + \ ds.197 -> + case ds.197 of { + Nil -> ds.191 ds.194 + (:) ds.198 ds.199 -> + let y.200 = ds.198 in ds.196 ds.199 + } + {- end CoRec -} + in ds.196 ys.190 + } + {- end CoRec -} + in ds.191 xs.189 +SimpleListComp.i :: for all d, e. <Eq d> -> <Eq e> -> [([e], [d])] -> [[e]] +SimpleListComp.i = + /\ t128 t127 -> \ dict.133 dict.132 -> + let dict.130 = (dfun.Eq.List t127) dict.132 in + let dict.131 = (dfun.Eq.List t128) dict.133 in + let dict.126 = ((dfun.Eq.Tuple2 [t127]) [t128]) dict.130 dict.131 in + let + i.120 = + \ xs.78 -> + let + {- CoRec -} + ds.201 = + \ ds.202 -> + case ds.202 of { + Nil -> Nil [t127] + (:) ds.203 ds.204 -> + case ds.203 of { + MkTuple2 x.80 y.81 -> + let all.79 = ds.203 + in + case + ((== ([t127], [t128])) + dict.126 + all.79 + (MkTuple2! + [t127] + [t128] + (Nil! t127) + (Nil! t128))) + of { + True -> + (: [t127]) x.80 (ds.201 ds.204) + False -> ds.201 ds.204 + } + } + } + {- end CoRec -} + in ds.201 xs.78 + in i.120 +SimpleListComp.j :: for all d, e, f, g. [(f, g, d, e)] -> [(f, g)] +SimpleListComp.j = + /\ t139 t140 t137 t138 -> \ xs.210 -> + let + {- CoRec -} + ds.211 = + \ ds.212 -> + case ds.212 of { + Nil -> Nil (t137, t138) + (:) ds.213 ds.214 -> + case ds.213 of { + MkTuple4 a.215 b.216 c.217 d.218 -> + (: (t137, t138)) + (MkTuple2! t137 t138 a.215 b.216) + (ds.211 ds.214) + } + } + {- end CoRec -} + in ds.211 xs.210 + diff --git a/ghc/compiler/tests/deSugar/ds010.hs b/ghc/compiler/tests/deSugar/ds010.hs new file mode 100644 index 0000000000..a49c09c03f --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds010.hs @@ -0,0 +1,15 @@ +--!!! ds010 -- deeply-nested list comprehensions + +module Test where + +z = [ (a,b,c,d,e,f,g,h,i,j) | a <- "12", + b <- "12", + c <- "12", + d <- "12", + e <- "12", + f <- "12", + g <- "12", + h <- "12", + i <- "12", + j <- "12" + ] diff --git a/ghc/compiler/tests/deSugar/ds010.stderr b/ghc/compiler/tests/deSugar/ds010.stderr new file mode 100644 index 0000000000..cfc1caedb6 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds010.stderr @@ -0,0 +1,228 @@ +Desugared: +Test.z :: [(Char, Char, Char, Char, Char, Char, Char, Char, Char, Char)] +Test.z = + let + {- CoRec -} + ds.136 = + \ ds.137 -> + case ds.137 of { + Nil -> + Nil (Char, + Char, + Char, + Char, + Char, + Char, + Char, + Char, + Char, + Char) + (:) ds.138 ds.139 -> + let a.140 = ds.138 + in + let + {- CoRec -} + ds.141 = + \ ds.142 -> + case ds.142 of { + Nil -> ds.136 ds.139 + (:) ds.143 ds.144 -> + let b.145 = ds.143 + in + let + {- CoRec -} + ds.146 = + \ ds.147 -> + case ds.147 of { + Nil -> ds.141 ds.144 + (:) ds.148 ds.149 -> + let c.150 = ds.148 + in + let + {- CoRec -} + ds.151 = + \ ds.152 -> + case + ds.152 + of { + Nil -> + ds.146 + ds.149 + (:) ds.153 + ds.154 -> + let + d.155 = + ds.153 + in + let + {- CoRec -} + ds.156 = + \ ds.157 -> + case + ds.157 + of { + Nil -> + ds.151 + ds.154 + (:) ds.158 + ds.159 -> + let + e.160 = + ds.158 + in + let + {- CoRec -} + ds.161 = + \ ds.162 -> + case + ds.162 + of { + Nil -> + ds.156 + ds.159 + (:) ds.163 + ds.164 -> + let + f.165 = + ds.163 + in + let + {- CoRec -} + ds.166 = + \ ds.167 -> + case + ds.167 + of { + Nil -> + ds.161 + ds.164 + (:) ds.168 + ds.169 -> + let + g.170 = + ds.168 + in + let + {- CoRec -} + ds.171 = + \ ds.172 -> + case + ds.172 + of { + Nil -> + ds.166 + ds.169 + (:) ds.173 + ds.174 -> + let + h.175 = + ds.173 + in + let + {- CoRec -} + ds.176 = + \ ds.177 -> + case + ds.177 + of { + Nil -> + ds.171 + ds.174 + (:) ds.178 + ds.179 -> + let + i.180 = + ds.178 + in + let + {- CoRec -} + ds.181 = + \ ds.182 -> + case + ds.182 + of { + Nil -> + ds.176 + ds.179 + (:) ds.183 + ds.184 -> + let + j.185 = + ds.183 + in + (: (Char, + Char, + Char, + Char, + Char, + Char, + Char, + Char, + Char, + Char)) + (MkTuple10! + Char + Char + Char + Char + Char + Char + Char + Char + Char + Char + a.140 + b.145 + c.150 + d.155 + e.160 + f.165 + g.170 + h.175 + i.180 + j.185) + (ds.181 + ds.184) + } + {- end CoRec -} + in + ds.181 + "12"S + } + {- end CoRec -} + in + ds.176 + "12"S + } + {- end CoRec -} + in + ds.171 + "12"S + } + {- end CoRec -} + in + ds.166 + "12"S + } + {- end CoRec -} + in + ds.161 + "12"S + } + {- end CoRec -} + in + ds.156 + "12"S + } + {- end CoRec -} + in ds.151 "12"S + } + {- end CoRec -} + in ds.146 "12"S + } + {- end CoRec -} + in ds.141 "12"S + } + {- end CoRec -} + in ds.136 "12"S + diff --git a/ghc/compiler/tests/deSugar/ds011.hs b/ghc/compiler/tests/deSugar/ds011.hs new file mode 100644 index 0000000000..8b12d9371f --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds011.hs @@ -0,0 +1,11 @@ +--!!! ds011 -- uses of "error" + +module Tests where + +f = error [] + +g = error "" + +h = error "\"" + +i = error "foo" diff --git a/ghc/compiler/tests/deSugar/ds011.stderr b/ghc/compiler/tests/deSugar/ds011.stderr new file mode 100644 index 0000000000..2535d80951 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds011.stderr @@ -0,0 +1,10 @@ +Desugared: +Tests.f :: for all d. d +Tests.f = /\ t79 -> (error t79) (Nil! Char) +Tests.g :: for all d. d +Tests.g = /\ t83 -> (error t83) (Nil! Char) +Tests.h :: for all d. d +Tests.h = /\ t86 -> (error t86) "\""S +Tests.i :: for all d. d +Tests.i = /\ t89 -> (error t89) "foo"S + diff --git a/ghc/compiler/tests/deSugar/ds012.hs b/ghc/compiler/tests/deSugar/ds012.hs new file mode 100644 index 0000000000..390db5817d --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds012.hs @@ -0,0 +1,10 @@ +--!!! ds012 -- simple Integer arithmetic +-- +module Tests where + +f x = 1 + 2 - 3 + 4 * 5 + +g x = x + (f x) + +h x = 111111111111111111111111111111111111111111111111111111111111 + + 222222222222222222222222222222222222222222222222222222222222 diff --git a/ghc/compiler/tests/deSugar/ds012.stderr b/ghc/compiler/tests/deSugar/ds012.stderr new file mode 100644 index 0000000000..93c198c630 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds012.stderr @@ -0,0 +1,58 @@ +Desugared: +Tests.f :: for all d, e. <Num e> -> d -> e +Tests.f = + /\ o81 t82 -> \ dict.101 -> + let dict.99 = dict.101 in + let dict.97 = dict.99 in + let dict.94 = dict.97 in + let dict.91 = dict.94 in + let dict.89 = dict.91 in + let dict.87 = dict.89 in + let dict.85 = dict.87 in + let dict.83 = dict.85 in + let + f.80 = + \ x.63 -> + (+ t82) + dict.83 + ((- t82) + dict.85 + ((+ t82) + dict.87 + ((fromInteger t82) dict.89 (MkInteger! 1##)) + ((fromInteger t82) dict.91 (MkInteger! 2##))) + ((fromInteger t82) dict.94 (MkInteger! 3##))) + ((* t82) + dict.97 + ((fromInteger t82) dict.99 (MkInteger! 4##)) + ((fromInteger t82) dict.101 (MkInteger! 5##))) + in f.80 +Tests.g :: for all d. <Num d> -> d -> d +Tests.g = + /\ t110 -> \ dict.111 -> + let dict.108 = dict.111 in + let + g.105 = + \ x.64 -> + (+ t110) dict.108 x.64 (((Tests.f t110) t110) dict.111 x.64) + in g.105 +Tests.h :: for all d, e. <Num e> -> d -> e +Tests.h = + /\ o115 t120 -> \ dict.121 -> + let dict.119 = dict.121 in + let dict.117 = dict.119 in + let + h.114 = + \ x.65 -> + (+ t120) + dict.117 + ((fromInteger t120) + dict.119 + (MkInteger! + 111111111111111111111111111111111111111111111111111111111111##)) + ((fromInteger t120) + dict.121 + (MkInteger! + 222222222222222222222222222222222222222222222222222222222222##)) + in h.114 + diff --git a/ghc/compiler/tests/deSugar/ds013.hs b/ghc/compiler/tests/deSugar/ds013.hs new file mode 100644 index 0000000000..9b5b4b3454 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds013.hs @@ -0,0 +1,23 @@ +--!!! ds013 -- simple Rational arithmetic + +module Tests where + +f = 1.5 + 2.0 - 3.14159265 + 4.2 * 5.111111111111111111111111111 + +g :: Float +g = 1.5 + 2.0 - 3.14159265 + 4.2 * 5.111111111111111111111111111 + +h :: Double +h = 1.5 + 2.0 - 3.14159265 + 4.2 * 5.111111111111111111111111111 + +{- later +g x = x + (f x) + +h x = 1.0e1000000000 + 1.0e1000000000 + +i x = 1.0e-1000000000 + 1.0e-1000000000 + +j x = 1111111111.222222222222222e333333333333333 + * 4444444444.555555555555555e-66666666666666 +-} + diff --git a/ghc/compiler/tests/deSugar/ds013.stderr b/ghc/compiler/tests/deSugar/ds013.stderr new file mode 100644 index 0000000000..3cca8d33c3 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds013.stderr @@ -0,0 +1,89 @@ +Desugared: +Tests.f :: for all d. <Fractional d> -> d +Tests.f = + /\ t78 -> \ dict.97 -> + let dict.95 = dict.97 in + let dict.90 = dict.95 in + let dict.87 = dict.90 in + let dict.85 = dict.87 in + let dict.93 = (sdsel.Fractional.Num t78) dict.85 in + let dict.83 = dict.93 in + let dict.81 = dict.83 in + let dict.79 = dict.81 in + let + f.77 = + (+ t78) + dict.79 + ((- t78) + dict.81 + ((+ t78) + dict.83 + ((fromRational t78) + dict.85 (MkDouble! 1.5000000000000000##)) + ((fromRational t78) + dict.87 (MkDouble! 2.0000000000000000##))) + ((fromRational t78) + dict.90 (MkDouble! 3.1415926500000002##))) + ((* t78) + dict.93 + ((fromRational t78) + dict.95 (MkDouble! 4.2000000000000002##)) + ((fromRational t78) + dict.97 (MkDouble! 5.1111111111111107##))) + in f.77 +dict.103 :: <Num Float> +dict.103 = dfun.Num.Float +dict.105 :: <Num Float> +dict.105 = dfun.Num.Float +dict.107 :: <Num Float> +dict.107 = dfun.Num.Float +dict.109 :: <Fractional Float> +dict.109 = dfun.Fractional.Float +dict.111 :: <Fractional Float> +dict.111 = dfun.Fractional.Float +dict.114 :: <Fractional Float> +dict.114 = dfun.Fractional.Float +dict.117 :: <Num Float> +dict.117 = dfun.Num.Float +dict.119 :: <Fractional Float> +dict.119 = dfun.Fractional.Float +dict.121 :: <Fractional Float> +dict.121 = dfun.Fractional.Float +Tests.g :: Float +Tests.g = + plusFloat + (minusFloat + (plusFloat + (MkFloat! 1.5000000000000000#) (MkFloat! 2.0000000000000000#)) + (MkFloat! 3.1415926500000002#)) + (timesFloat + (MkFloat! 4.2000000000000002#) (MkFloat! 5.1111111111111107#)) +dict.127 :: <Num Double> +dict.127 = dfun.Num.Double +dict.129 :: <Num Double> +dict.129 = dfun.Num.Double +dict.131 :: <Num Double> +dict.131 = dfun.Num.Double +dict.133 :: <Fractional Double> +dict.133 = dfun.Fractional.Double +dict.135 :: <Fractional Double> +dict.135 = dfun.Fractional.Double +dict.138 :: <Fractional Double> +dict.138 = dfun.Fractional.Double +dict.141 :: <Num Double> +dict.141 = dfun.Num.Double +dict.143 :: <Fractional Double> +dict.143 = dfun.Fractional.Double +dict.145 :: <Fractional Double> +dict.145 = dfun.Fractional.Double +Tests.h :: Double +Tests.h = + plusDouble + (minusDouble + (plusDouble + (MkDouble! 1.5000000000000000##) + (MkDouble! 2.0000000000000000##)) + (MkDouble! 3.1415926500000002##)) + (timesDouble + (MkDouble! 4.2000000000000002##) (MkDouble! 5.1111111111111107##)) + diff --git a/ghc/compiler/tests/deSugar/ds014.hs b/ghc/compiler/tests/deSugar/ds014.hs new file mode 100644 index 0000000000..cf1ccb183b --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds014.hs @@ -0,0 +1,76 @@ +--!!! ds014 -- character and string literals +--!!! really should add ALL weird forms... + +module Tests where + +a = 'a' +b = "b" +c = a:b +d = b ++ b + +b1 = "" -- examples from the Haskell report +b2 = "\&" -- the same thing +b3 = "\SO\&H" ++ "\137\&9" + +a000 = '\NUL' +a001 = '\SOH' +a002 = '\STX' +a003 = '\ETX' +a004 = '\EOT' +a005 = '\ENQ' +a006 = '\ACK' +a007 = '\BEL' +a010 = '\BS' +a011 = '\HT' +a012 = '\LF' +a013 = '\VT' +a014 = '\FF' +a015 = '\CR' +a016 = '\SO' +a017 = '\SI' +a020 = '\DLE' +a021 = '\DC1' +a022 = '\DC2' +a023 = '\DC3' +a024 = '\DC4' +a025 = '\NAK' +a026 = '\SYN' +a027 = '\ETB' +a030 = '\CAN' +a031 = '\EM' +a032 = '\SUB' +a033 = '\ESC' +a034 = '\FS' +a035 = '\GS' +a036 = '\RS' +a037 = '\US' +a040 = '\SP' +a042 = '"' +a047 = '\'' +a134 = '\\' +a177 = '\DEL' + +ascii = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK\BEL\ + \\BS\HT\LF\VT\FF\CR\SO\SI\ + \\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\ + \\CAN\EM\SUB\ESC\FS\GS\RS\US\ + \\SP!\"#$%&'\ + \()*+,-./\ + \01234567\ + \89:;<=>?\ + \@ABCDEFG\ + \HIJKLMNO\ + \PQRSTUVW\ + \XYZ[\\]^_\ + \`abcdefg\ + \hijklmno\ + \pqrstuvw\ + \xyz{|}~\DEL" + +na200 = '\o200' +na250 = '\o250' +na300 = '\o300' +na350 = '\o350' +na377 = '\o377' + +eightbit = "\o200\o250\o300\o350\o377" diff --git a/ghc/compiler/tests/deSugar/ds014.stderr b/ghc/compiler/tests/deSugar/ds014.stderr new file mode 100644 index 0000000000..e151c0a6be --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds014.stderr @@ -0,0 +1,105 @@ +Desugared: +Tests.a :: Char +Tests.a = MkChar! 'a'# +Tests.b :: [Char] +Tests.b = "b"S +Tests.c :: [Char] +Tests.c = (: Char) Tests.a Tests.b +Tests.d :: [Char] +Tests.d = (++ Char) Tests.b Tests.b +Tests.b1 :: [Char] +Tests.b1 = Nil! Char +Tests.b2 :: [Char] +Tests.b2 = Nil! Char +Tests.b3 :: [Char] +Tests.b3 = (++ Char) "\SO\&H"S "\137\&9"S +Tests.a000 :: Char +Tests.a000 = MkChar! '\NUL'# +Tests.a001 :: Char +Tests.a001 = MkChar! '\SOH'# +Tests.a002 :: Char +Tests.a002 = MkChar! '\STX'# +Tests.a003 :: Char +Tests.a003 = MkChar! '\ETX'# +Tests.a004 :: Char +Tests.a004 = MkChar! '\EOT'# +Tests.a005 :: Char +Tests.a005 = MkChar! '\ENQ'# +Tests.a006 :: Char +Tests.a006 = MkChar! '\ACK'# +Tests.a007 :: Char +Tests.a007 = MkChar! '\a'# +Tests.a010 :: Char +Tests.a010 = MkChar! '\b'# +Tests.a011 :: Char +Tests.a011 = MkChar! '\t'# +Tests.a012 :: Char +Tests.a012 = MkChar! '\n'# +Tests.a013 :: Char +Tests.a013 = MkChar! '\v'# +Tests.a014 :: Char +Tests.a014 = MkChar! '\f'# +Tests.a015 :: Char +Tests.a015 = MkChar! '\r'# +Tests.a016 :: Char +Tests.a016 = MkChar! '\SO'# +Tests.a017 :: Char +Tests.a017 = MkChar! '\SI'# +Tests.a020 :: Char +Tests.a020 = MkChar! '\DLE'# +Tests.a021 :: Char +Tests.a021 = MkChar! '\DC1'# +Tests.a022 :: Char +Tests.a022 = MkChar! '\DC2'# +Tests.a023 :: Char +Tests.a023 = MkChar! '\DC3'# +Tests.a024 :: Char +Tests.a024 = MkChar! '\DC4'# +Tests.a025 :: Char +Tests.a025 = MkChar! '\NAK'# +Tests.a026 :: Char +Tests.a026 = MkChar! '\SYN'# +Tests.a027 :: Char +Tests.a027 = MkChar! '\ETB'# +Tests.a030 :: Char +Tests.a030 = MkChar! '\CAN'# +Tests.a031 :: Char +Tests.a031 = MkChar! '\EM'# +Tests.a032 :: Char +Tests.a032 = MkChar! '\SUB'# +Tests.a033 :: Char +Tests.a033 = MkChar! '\ESC'# +Tests.a034 :: Char +Tests.a034 = MkChar! '\FS'# +Tests.a035 :: Char +Tests.a035 = MkChar! '\GS'# +Tests.a036 :: Char +Tests.a036 = MkChar! '\RS'# +Tests.a037 :: Char +Tests.a037 = MkChar! '\US'# +Tests.a040 :: Char +Tests.a040 = MkChar! ' '# +Tests.a042 :: Char +Tests.a042 = MkChar! '"'# +Tests.a047 :: Char +Tests.a047 = MkChar! '\''# +Tests.a134 :: Char +Tests.a134 = MkChar! '\\'# +Tests.a177 :: Char +Tests.a177 = MkChar! '\DEL'# +Tests.ascii :: [Char] +Tests.ascii = + "\NUL\SOH\STX\ETX\EOT\ENQ\ACK\a\b\t\n\v\f\r\SO\SI\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\EM\SUB\ESC\FS\GS\RS\US !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL"S +Tests.na200 :: Char +Tests.na200 = MkChar! '\128'# +Tests.na250 :: Char +Tests.na250 = MkChar! '¨'# +Tests.na300 :: Char +Tests.na300 = MkChar! 'À'# +Tests.na350 :: Char +Tests.na350 = MkChar! 'è'# +Tests.na377 :: Char +Tests.na377 = MkChar! 'ÿ'# +Tests.eightbit :: [Char] +Tests.eightbit = "\128¨Àèÿ"S + diff --git a/ghc/compiler/tests/deSugar/ds014a.hs b/ghc/compiler/tests/deSugar/ds014a.hs new file mode 100644 index 0000000000..8ed88c0ea0 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds014a.hs @@ -0,0 +1,4 @@ +module Tests where + +-- this char is forbidden +c = '\&' diff --git a/ghc/compiler/tests/deSugar/ds015.hs b/ghc/compiler/tests/deSugar/ds015.hs new file mode 100644 index 0000000000..5c2164ecbc --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds015.hs @@ -0,0 +1,9 @@ +--!!! ds015 -- lambdas +-- +module Tests where + +f x = ( \ x -> x ) x + +g x y = ( \ x y -> y x ) ( \ x -> x ) x + +h x y = ( \ (x:xs) -> x ) x diff --git a/ghc/compiler/tests/deSugar/ds015.stderr b/ghc/compiler/tests/deSugar/ds015.stderr new file mode 100644 index 0000000000..a9ede5872c --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds015.stderr @@ -0,0 +1,21 @@ +Desugared: +Tests.f :: for all d. d -> d +Tests.f = /\ o89 -> \ x.106 -> (\ x.107 -> x.107) x.106 +Tests.g :: for all d, e, f. ((d -> d) -> f) -> e -> f +Tests.g = + /\ o98 o94 o97 -> \ x.108 y.109 -> + (\ x.110 y.111 -> y.111 x.110) (\ x.112 -> x.112) x.108 +Tests.h :: for all d, e. [e] -> d -> e +Tests.h = + /\ o102 t105 -> \ x.115 y.116 -> + (\ ds.117 -> + let + fail.118 = + (error t105) + "\"ds015.hs\", line 9: pattern-matching failed in lambda\n"S + in + case ds.117 of { + (:) x.119 xs.120 -> x.119 + _ -> fail.118 + }) x.115 + diff --git a/ghc/compiler/tests/deSugar/ds016.hs b/ghc/compiler/tests/deSugar/ds016.hs new file mode 100644 index 0000000000..57e0053538 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds016.hs @@ -0,0 +1,15 @@ +--!!! ds016 -- case expressions +-- +module Tests where + +f x y z = + case ( x ++ x ++ x ++ x ++ x ) of + [] -> [] + [a] -> error "2" + [a,b,c] -> + case ( (y,z,y,z) ) of +-- (True, _, False, _) | True == False -> z +-- (True, _, False, _) | True == False -> z + _ -> z + + (a:bs) -> error "4" diff --git a/ghc/compiler/tests/deSugar/ds016.stderr b/ghc/compiler/tests/deSugar/ds016.stderr new file mode 100644 index 0000000000..31f7e7d635 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds016.stderr @@ -0,0 +1,47 @@ +Desugared: +Tests.f :: for all a, d, e. [a] -> d -> [e] -> [e] +Tests.f = + /\ a o86 t97 -> \ x.119 y.120 z.121 -> + let + ds.122 = + (++ a) x.119 ((++ a) x.119 ((++ a) x.119 ((++ a) x.119 x.119))) in + let + fail.123 = + (error [t97]) + "\"ds016.hs\", line 17: pattern-matching failed in case\n"S + in + case ds.122 of { + Nil -> Nil! t97 + (:) a.124 ds.125 -> + let + fail.128 = + let bs.126 = ds.125 in + let a.127 = a.124 in (error [t97]) "4"S + in + case ds.125 of { + Nil -> (error [t97]) "2"S + (:) b.129 ds.130 -> + case ds.130 of { + (:) c.131 ds.132 -> + case ds.132 of { + Nil -> + let a.133 = a.124 in + let + ds.134 = + MkTuple4! + o86 + [t97] + o86 + [t97] + y.120 + z.121 + y.120 + z.121 + in z.121 + _ -> fail.128 + } + _ -> fail.128 + } + } + } + diff --git a/ghc/compiler/tests/deSugar/ds017.hs b/ghc/compiler/tests/deSugar/ds017.hs new file mode 100644 index 0000000000..00f98848b3 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds017.hs @@ -0,0 +1,12 @@ +--!!! ds017 -- let expressions +-- +module Tests where + +f x y z + = let + a = x : [] + b = x : a + c = y (let d = (z, z) in d) + result = (c, b) + in + result diff --git a/ghc/compiler/tests/deSugar/ds017.stderr b/ghc/compiler/tests/deSugar/ds017.stderr new file mode 100644 index 0000000000..5b5a8fcd33 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds017.stderr @@ -0,0 +1,10 @@ +Desugared: +Tests.f :: for all d, e, f. f -> ((d, d) -> e) -> d -> (e, [f]) +Tests.f = + /\ o86 o96 t94 -> \ x.104 y.105 z.106 -> + let a.107 = (: t94) x.104 (Nil! t94) in + let b.108 = (: t94) x.104 a.107 in + let + c.110 = y.105 (let d.109 = MkTuple2! o86 o86 z.106 z.106 in d.109) in + let result.111 = MkTuple2! o96 [t94] c.110 b.108 in result.111 + diff --git a/ghc/compiler/tests/deSugar/ds018.hs b/ghc/compiler/tests/deSugar/ds018.hs new file mode 100644 index 0000000000..b5c428012e --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds018.hs @@ -0,0 +1,50 @@ +--!!! ds018 -- explicit lists and tuples +-- +module Tests where + +-- exprs + +f x y z = [x,y,z,x,y,z] +f2 x y = [] + +g1 x y = () +g x y z = (x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z) -- hey, we love big tuples + +-- pats + +fa [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] = x + +fb [] = [] + +ga (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z, + aa,ab,ac,ad,ae,af,ag,ah,ai,aj,ak,al,am, + an,ao,ap,aq,ar,as,at,au,av,aw,ax,ay,az) = x + +gb () x = x +gb2 () = () + +-- need to think of some better ones... diff --git a/ghc/compiler/tests/deSugar/ds018.stderr b/ghc/compiler/tests/deSugar/ds018.stderr new file mode 100644 index 0000000000..8f8863b342 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds018.stderr @@ -0,0 +1,911 @@ +Desugared: +Tests.f :: for all d. d -> d -> d -> [d] +Tests.f = + /\ o175 -> \ x.282 y.283 z.284 -> + :! o175 + x.282 + (:! o175 + y.283 + (:! o175 + z.284 + (:! o175 x.282 (:! o175 y.283 (:! o175 z.284 (Nil! o175)))))) +Tests.f2 :: for all d, e, f. d -> e -> [f] +Tests.f2 = /\ o178 o179 t180 -> \ x.285 y.286 -> Nil! t180 +Tests.g1 :: for all d, e. d -> e -> () +Tests.g1 = /\ o183 o184 -> \ x.287 y.288 -> MkTuple0 +Tests.g :: + for all d, e, f. + d + -> e + -> f + -> (d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f, + d, + e, + f) +Tests.g = + /\ o187 o188 o189 -> \ x.289 y.290 z.291 -> + MkTuple150! + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + o187 + o188 + o189 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 + x.289 + y.290 + z.291 +Tests.fa :: for all d. [d] -> d +Tests.fa = + /\ t218 -> \ ds.320 -> + let + fail.321 = + (error t218) + "\"ds018.hs\", line 39: pattern-matching failure [function binding]\n"S + in + case ds.320 of { + (:) a.322 ds.323 -> + case ds.323 of { + (:) b.324 ds.325 -> + case ds.325 of { + (:) c.326 ds.327 -> + case ds.327 of { + (:) d.328 ds.329 -> + case ds.329 of { + (:) e.330 ds.331 -> + case ds.331 of { + (:) f.332 ds.333 -> + case ds.333 of { + (:) g.334 ds.335 -> + case ds.335 of { + (:) h.336 ds.337 -> + case ds.337 of { + (:) i.338 ds.339 -> + case ds.339 of { + (:) j.340 + ds.341 -> + case + ds.341 + of { + (:) k.342 + ds.343 -> + case + ds.343 + of { + (:) l.344 + ds.345 -> + case + ds.345 + of { + (:) m.346 + ds.347 -> + case + ds.347 + of { + (:) n.348 + ds.349 -> + case + ds.349 + of { + (:) o.350 + ds.351 -> + case + ds.351 + of { + (:) p.352 + ds.353 -> + case + ds.353 + of { + (:) q.354 + ds.355 -> + case + ds.355 + of { + (:) r.356 + ds.357 -> + case + ds.357 + of { + (:) s.358 + ds.359 -> + case + ds.359 + of { + (:) t.360 + ds.361 -> + case + ds.361 + of { + (:) u.362 + ds.363 -> + case + ds.363 + of { + (:) v.364 + ds.365 -> + case + ds.365 + of { + (:) w.366 + ds.367 -> + case + ds.367 + of { + (:) x.368 + ds.369 -> + case + ds.369 + of { + (:) y.370 + ds.371 -> + case + ds.371 + of { + (:) z.372 + ds.373 -> + case + ds.373 + of { + Nil -> + x.368 + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> + fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } + _ -> fail.321 + } +Tests.fb :: for all d, e. [d] -> [e] +Tests.fb = + /\ t221 t222 -> \ ds.376 -> + let + fail.377 = + (error [t222]) + "\"ds018.hs\", line 41: pattern-matching failure [function binding]\n"S + in + case ds.376 of { + Nil -> Nil! t222 + _ -> fail.377 + } +Tests.ga :: + for all d, + e, + f, + g, + h, + i, + j, + k, + l, + m, + n, + o, + p, + q, + r, + s, + t, + u, + v, + w, + x, + y, + z0, + z1, + z2, + z3, + z4, + z5, + z6, + z7, + z8, + z9, + z10, + z11, + z12, + z13, + z14, + z15, + z16, + z17, + z18, + z19, + z20, + z21, + z22, + z23, + z24, + z25, + z26, + z27, + z28, + z29. + (d, + e, + f, + g, + h, + i, + j, + k, + l, + m, + n, + o, + p, + q, + r, + s, + t, + u, + v, + w, + x, + y, + z0, + z29, + z1, + z2, + z3, + z4, + z5, + z6, + z7, + z8, + z9, + z10, + z11, + z12, + z13, + z14, + z15, + z16, + z17, + z18, + z19, + z20, + z21, + z22, + z23, + z24, + z25, + z26, + z27, + z28) + -> z29 +Tests.ga = + /\ o225 + o226 + o227 + o228 + o229 + o230 + o231 + o232 + o233 + o234 + o235 + o236 + o237 + o238 + o239 + o240 + o241 + o242 + o243 + o244 + o245 + o246 + o247 + o249 + o250 + o251 + o252 + o253 + o254 + o255 + o256 + o257 + o258 + o259 + o260 + o261 + o262 + o263 + o264 + o265 + o266 + o267 + o268 + o269 + o270 + o271 + o272 + o273 + o274 + o275 + o276 + o248 -> \ ds.380 -> + let + fail.381 = + (error o248) + "\"ds018.hs\", line 45: pattern-matching failure [function binding]\n"S + in + case ds.380 of { + MkTuple52 a.382 + b.383 + c.384 + d.385 + e.386 + f.387 + g.388 + h.389 + i.390 + j.391 + k.392 + l.393 + m.394 + n.395 + o.396 + p.397 + q.398 + r.399 + s.400 + t.401 + u.402 + v.403 + w.404 + x.405 + y.406 + z.407 + aa.408 + ab.409 + ac.410 + ad.411 + ae.412 + af.413 + ag.414 + ah.415 + ai.416 + aj.417 + ak.418 + al.419 + am.420 + an.421 + ao.422 + ap.423 + aq.424 + ar.425 + as.426 + at.427 + au.428 + av.429 + aw.430 + ax.431 + ay.432 + az.433 -> x.405 + } +Tests.gb :: for all d. () -> d -> d +Tests.gb = + /\ o279 -> \ ds.436 x.437 -> + let + fail.438 = + (error o279) + "\"ds018.hs\", line 47: pattern-matching failure [function binding]\n"S + in + case ds.436 of { + MkTuple0 -> x.437 + } +Tests.gb2 :: () -> () +Tests.gb2 = + \ ds.441 -> + let + fail.442 = + (error ()) + "\"ds018.hs\", line 48: pattern-matching failure [function binding]\n"S + in + case ds.441 of { + MkTuple0 -> MkTuple0 + } + diff --git a/ghc/compiler/tests/deSugar/ds019.hs b/ghc/compiler/tests/deSugar/ds019.hs new file mode 100644 index 0000000000..32400ddec8 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds019.hs @@ -0,0 +1,8 @@ +--!!! ds019 -- mixed var and uni-constructor pats + +module Test where + +f (a,b,c) i o = [] +f d (j,k) p = [] +f (e,f,g) l q = [] +f h (m,n) r = [] diff --git a/ghc/compiler/tests/deSugar/ds019.stderr b/ghc/compiler/tests/deSugar/ds019.stderr new file mode 100644 index 0000000000..f0300f3ebf --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds019.stderr @@ -0,0 +1,34 @@ +Desugared: +Test.f :: for all d, e, f, g, h, i, j. (d, e, f) -> (g, h) -> i -> [j] +Test.f = + /\ o105 o106 o107 o112 o113 o114 t115 -> \ ds.121 i.122 o.123 -> + let + fail.124 = + (error [t115]) + "\"ds019.hs\", line 8: pattern-matching failure [function binding]\n"S in + let + fail.140 = + let + fail.135 = + let + fail.129 = + case i.122 of { + MkTuple2 m.125 n.126 -> + let r.127 = o.123 in + let h.128 = ds.121 in Nil! t115 + } + in + case ds.121 of { + MkTuple3 e.130 f.131 g.132 -> + let q.133 = o.123 in let l.134 = i.122 in Nil! t115 + } + in + case i.122 of { + MkTuple2 j.136 k.137 -> + let p.138 = o.123 in let d.139 = ds.121 in Nil! t115 + } + in + case ds.121 of { + MkTuple3 a.141 b.142 c.143 -> Nil! t115 + } + diff --git a/ghc/compiler/tests/deSugar/ds020.hs b/ghc/compiler/tests/deSugar/ds020.hs new file mode 100644 index 0000000000..ac6ea8dd4b --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds020.hs @@ -0,0 +1,52 @@ +--!!! ds020 -- lazy patterns (in detail) +-- +module Test where + +a ~([],[],[]) = [] +a ~(~[],~[],~[]) = [] + +b ~(x:xs:ys) = [] +b ~(~x: ~xs: ~ys) = [] + +c ~x ~ _ ~11111 ~3.14159265 = x + +d 11 = 4 +d 12 = 3 +d ~(n+4) = 2 +d ~(n+43) = 1 +d ~(n+999) = 0 + +f ~(x@[]) = [] +f x@(~[]) = [] + +g ~(~(~(~([])))) = [] + +-- pattern bindings (implicitly lazy) + +([],[],[]) = ([],[],[]) +(~[],~[],~[]) = ([],[],[]) + +(x1: xs1: ys1) = [] +(~x: ~xs: ~ys) = [] + +(x2 : xs2: ys2) | eq2 = [] + | eq3 = [x2] + | eq4 = [x2] + | True = [] + where + eq2 = (2::Int) == (4::Int) + eq3 = (3::Int) == (3::Int) + eq4 = (4::Int) == (2::Int) + +(x3,y3) | x3 > 3 = (4, 5) + | x3 <= 3 = (2, 3) +-- above: x & y should both be \bottom. + +(x4,(y4,(z4,a4))) | eq2 = ('a',('a',('a','a'))) + | eq3 = ('b',('b',('b','b'))) + | eq4 = ('c',('c',('c','c'))) + | True = ('d',('d',('d','d'))) + where + eq2 = (2::Int) == (4::Int) + eq3 = (3::Int) == (3::Int) + eq4 = (4::Int) == (2::Int) diff --git a/ghc/compiler/tests/deSugar/ds020.stderr b/ghc/compiler/tests/deSugar/ds020.stderr new file mode 100644 index 0000000000..5c0371c9d7 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds020.stderr @@ -0,0 +1,464 @@ +Desugared: +Test.a :: for all d, e, f, g. ([d], [e], [f]) -> [g] +Test.a = /\ t118 t119 t120 t121 -> \ ds.314 -> Nil! t121 +Test.b :: for all d, e. [d] -> [e] +Test.b = + /\ t134 t135 -> \ ds.323 -> + let + x.328 = + case ds.323 of { + (:) x.324 ds.325 -> + case ds.325 of { + (:) xs.326 ys.327 -> x.324 + _ -> + (error Char) + "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } in + let + xs.333 = + case ds.323 of { + (:) x.329 ds.330 -> + case ds.330 of { + (:) xs.331 ys.332 -> xs.331 + _ -> + (error Char) + "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } in + let + ys.338 = + case ds.323 of { + (:) x.334 ds.335 -> + case ds.335 of { + (:) xs.336 ys.337 -> ys.337 + _ -> + (error Char) + "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + in Nil! t135 +Test.c :: for all d, e, f, g. <Fractional f> -> <Num e> -> g -> d -> e -> f -> g +Test.c = + /\ o139 t140 t143 o138 -> \ dict.144 dict.141 -> + let + dict.145 = (sdsel.Num.Eq t143) ((sdsel.Fractional.Num t143) dict.144) in + let dict.142 = (sdsel.Num.Eq t140) dict.141 in + let c.137 = \ x.87 ds.339 ds.340 ds.341 -> let x.87 = x.87 in x.87 + in c.137 +Test.d :: for all d, e. <Num e> -> <Ord d> -> <Num d> -> d -> e +Test.d = + /\ t171 t174 -> \ dict.175 dict.173 dict.172 -> + let dict.169 = dict.175 in + let dict.163 = dict.169 in + let dict.157 = dict.163 in + let dict.152 = dict.157 in + let dict.166 = dict.172 in + let dict.160 = dict.166 in + let dict.154 = dict.160 in + let dict.149 = dict.154 in + let dict.167 = dict.173 in + let dict.161 = dict.167 in + let dict.155 = (sdsel.Ord.Eq t171) dict.161 in + let dict.150 = dict.155 in + let + d.147 = + \ ds.344 -> + let + fail.345 = + (error t174) + "\"ds020.hs\", line 17: pattern-matching failure [function binding]\n"S in + let + fail.349 = + let + n.88 = + let + n.346 = + (fromInteger t171) dict.160 (MkInteger! 4##) + in + case + ((>= t171) + dict.161 + ds.344 + ((fromInteger t171) + dict.160 (MkInteger! 4##))) + of { + True -> + let + n.88 = + (- t171) + dict.160 + ds.344 + ((fromInteger t171) + dict.160 (MkInteger! 4##)) + in n.88 + False -> + (error Char) + "``impossible'' pattern-matching error!\n"S + } + in (fromInteger t174) dict.163 (MkInteger! 2##) + in + case + ((== t171) + dict.150 + ((fromInteger t171) dict.149 (MkInteger! 11##)) + ds.344) + of { + True -> (fromInteger t174) dict.152 (MkInteger! 4##) + False -> + case + ((== t171) + dict.155 + ((fromInteger t171) + dict.154 (MkInteger! 12##)) + ds.344) + of { + True -> (fromInteger t174) dict.157 (MkInteger! 3##) + False -> fail.349 + } + } + in d.147 +Test.f :: for all d, e. [d] -> [e] +Test.f = + /\ t182 t183 -> \ x.352 -> + let + x.353 = + case x.352 of { + Nil -> x.352 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + in Nil! t183 +Test.g :: for all d, e. [d] -> [e] +Test.g = /\ t186 t187 -> \ ds.356 -> Nil! t187 +ds.357 :: ([t191], [t192], [t193]) +ds.357 = MkTuple3! [t191] [t192] [t193] (Nil! t191) (Nil! t192) (Nil! t193) +ds.358 :: ([t197], [t198], [t199]) +ds.358 = MkTuple3! [t197] [t198] [t199] (Nil! t197) (Nil! t198) (Nil! t199) +ds.359 :: [t208] +ds.359 = /\ t208 -> Nil! t208 +Test.x1 :: for all d. d +Test.x1 = + /\ t208 -> + case ds.359 of { + (:) x1.363 ds.364 -> + case ds.364 of { + (:) xs1.365 ys1.366 -> x1.363 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +Test.xs1 :: for all d. d +Test.xs1 = + /\ t208 -> + case ds.359 of { + (:) x1.367 ds.368 -> + case ds.368 of { + (:) xs1.369 ys1.370 -> xs1.369 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +Test.ys1 :: for all d. [d] +Test.ys1 = + /\ t208 -> + case ds.359 of { + (:) x1.371 ds.372 -> + case ds.372 of { + (:) xs1.373 ys1.374 -> ys1.374 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +ds.375 :: [t217] +ds.375 = /\ t217 -> Nil! t217 +Test.x :: for all d. d +Test.x = + /\ t217 -> + case ds.375 of { + (:) x.379 ds.380 -> + case ds.380 of { + (:) xs.381 ys.382 -> + let ys.383 = ys.382 in + let xs.384 = xs.381 in let x.385 = x.379 in x.385 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +Test.xs :: for all d. d +Test.xs = + /\ t217 -> + case ds.375 of { + (:) x.386 ds.387 -> + case ds.387 of { + (:) xs.388 ys.389 -> + let ys.390 = ys.389 in + let xs.391 = xs.388 in let x.392 = x.386 in xs.391 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +Test.ys :: for all d. [d] +Test.ys = + /\ t217 -> + case ds.375 of { + (:) x.393 ds.394 -> + case ds.394 of { + (:) xs.395 ys.396 -> + let ys.397 = ys.396 in + let xs.398 = xs.395 in let x.399 = x.393 in ys.397 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +{- plain CoRec -} +ds.406 :: [t254] +ds.406 = + /\ t254 -> + let dict.410 = dfun.Eq.Int in + let + eq2.413 = + eqInt + (let dict.411 = dfun.Num.Int in MkInt! 2#) + (let dict.412 = dfun.Num.Int in MkInt! 4#) in + let dict.414 = dfun.Eq.Int in + let + eq3.417 = + eqInt + (let dict.415 = dfun.Num.Int in MkInt! 3#) + (let dict.416 = dfun.Num.Int in MkInt! 3#) in + let dict.418 = dfun.Eq.Int in + let + eq4.421 = + eqInt + (let dict.419 = dfun.Num.Int in MkInt! 4#) + (let dict.420 = dfun.Num.Int in MkInt! 2#) + in + case eq2.413 of { + True -> Nil! t254 + False -> + case eq3.417 of { + True -> :! t254 (Test.x2 t254) (Nil! t254) + False -> + case eq4.421 of { + True -> :! t254 (Test.x2 t254) (Nil! t254) + False -> Nil! t254 + } + } + } +Test.x2 :: for all d. d +Test.x2 = + /\ t254 -> + case ds.406 of { + (:) x2.422 ds.423 -> + case ds.423 of { + (:) xs2.424 ys2.425 -> x2.422 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +Test.xs2 :: for all d. d +Test.xs2 = + /\ t254 -> + case ds.406 of { + (:) x2.426 ds.427 -> + case ds.427 of { + (:) xs2.428 ys2.429 -> xs2.428 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +Test.ys2 :: for all d. [d] +Test.ys2 = + /\ t254 -> + case ds.406 of { + (:) x2.430 ds.431 -> + case ds.431 of { + (:) xs2.432 ys2.433 -> ys2.433 + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } + _ -> (error Char) "``impossible'' pattern-matching error!\n"S + } +{- end plain CoRec -} +ds.435 :: for all d, e. <Num e> -> <Ord d> -> <Num d> -> (d, e) +ds.435 = + /\ t273 t275 -> \ dict.276 dict.269 dict.274 -> + let dict.267 = dict.276 in + let dict.271 = dict.274 in + let dict.265 = dict.271 in + let dict.262 = dict.265 in + let dict.260 = dict.269 + in + let + {- CoRec -} + ds.434 = + case + ((> t273) + dict.260 + x3.257 + ((fromInteger t273) dict.262 (MkInteger! 3##))) + of { + True -> + MkTuple2! + t273 + t275 + ((fromInteger t273) dict.265 (MkInteger! 4##)) + ((fromInteger t275) dict.267 (MkInteger! 5##)) + False -> + case + ((<= t273) + dict.269 + x3.257 + ((fromInteger t273) dict.271 (MkInteger! 3##))) + of { + True -> + MkTuple2! + t273 + t275 + ((fromInteger t273) dict.274 (MkInteger! 2##)) + ((fromInteger t275) dict.276 (MkInteger! 3##)) + False -> + (error (t273, t275)) + "\"ds020.hs\", line 42: pattern-matching failure [pat binding]\n"S + } + } + x3.257 = + case ds.434 of { + MkTuple2 x3.257 y3.258 -> x3.257 + } + y3.258 = + case ds.434 of { + MkTuple2 x3.257 y3.258 -> y3.258 + } + {- end CoRec -} + in MkTuple2! t273 t275 x3.257 y3.258 +Test.x3 :: for all d, e. <Num e> -> <Ord d> -> <Num d> -> d +Test.x3 = + /\ t273 t275 -> \ dict.276 dict.269 dict.274 -> + case (((ds.435 t273) t275) dict.276 dict.269 dict.274) of { + MkTuple2 x3.257 y3.258 -> x3.257 + } +Test.y3 :: for all d, e. <Num e> -> <Ord d> -> <Num d> -> e +Test.y3 = + /\ t273 t275 -> \ dict.276 dict.269 dict.274 -> + case (((ds.435 t273) t275) dict.276 dict.269 dict.274) of { + MkTuple2 x3.257 y3.258 -> y3.258 + } +ds.442 :: (Char, (Char, (Char, Char))) +ds.442 = + let dict.451 = dfun.Eq.Int in + let + eq2.454 = + eqInt + (let dict.452 = dfun.Num.Int in MkInt! 2#) + (let dict.453 = dfun.Num.Int in MkInt! 4#) in + let dict.455 = dfun.Eq.Int in + let + eq3.458 = + eqInt + (let dict.456 = dfun.Num.Int in MkInt! 3#) + (let dict.457 = dfun.Num.Int in MkInt! 3#) in + let dict.459 = dfun.Eq.Int in + let + eq4.462 = + eqInt + (let dict.460 = dfun.Num.Int in MkInt! 4#) + (let dict.461 = dfun.Num.Int in MkInt! 2#) + in + case eq2.454 of { + True -> + MkTuple2! + Char + (Char, (Char, Char)) + (MkChar! 'a'#) + (MkTuple2! + Char + (Char, Char) + (MkChar! 'a'#) + (MkTuple2! Char Char (MkChar! 'a'#) (MkChar! 'a'#))) + False -> + case eq3.458 of { + True -> + MkTuple2! + Char + (Char, (Char, Char)) + (MkChar! 'b'#) + (MkTuple2! + Char + (Char, Char) + (MkChar! 'b'#) + (MkTuple2! Char Char (MkChar! 'b'#) (MkChar! 'b'#))) + False -> + case eq4.462 of { + True -> + MkTuple2! + Char + (Char, (Char, Char)) + (MkChar! 'c'#) + (MkTuple2! + Char + (Char, Char) + (MkChar! 'c'#) + (MkTuple2! + Char Char (MkChar! 'c'#) (MkChar! 'c'#))) + False -> + MkTuple2! + Char + (Char, (Char, Char)) + (MkChar! 'd'#) + (MkTuple2! + Char + (Char, Char) + (MkChar! 'd'#) + (MkTuple2! + Char Char (MkChar! 'd'#) (MkChar! 'd'#))) + } + } + } +Test.x4 :: Char +Test.x4 = + case ds.442 of { + MkTuple2 x4.463 ds.464 -> + case ds.464 of { + MkTuple2 y4.465 ds.466 -> + case ds.466 of { + MkTuple2 z4.467 a4.468 -> x4.463 + } + } + } +Test.y4 :: Char +Test.y4 = + case ds.442 of { + MkTuple2 x4.469 ds.470 -> + case ds.470 of { + MkTuple2 y4.471 ds.472 -> + case ds.472 of { + MkTuple2 z4.473 a4.474 -> y4.471 + } + } + } +Test.z4 :: Char +Test.z4 = + case ds.442 of { + MkTuple2 x4.475 ds.476 -> + case ds.476 of { + MkTuple2 y4.477 ds.478 -> + case ds.478 of { + MkTuple2 z4.479 a4.480 -> z4.479 + } + } + } +Test.a4 :: Char +Test.a4 = + case ds.442 of { + MkTuple2 x4.481 ds.482 -> + case ds.482 of { + MkTuple2 y4.483 ds.484 -> + case ds.484 of { + MkTuple2 z4.485 a4.486 -> a4.486 + } + } + } + diff --git a/ghc/compiler/tests/deSugar/ds021.hs b/ghc/compiler/tests/deSugar/ds021.hs new file mode 100644 index 0000000000..f7e93929ed --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds021.hs @@ -0,0 +1,8 @@ +--!!! ds021 -- hairier uses of guards + +module Test where + +f x y z | x == y = [] + | x /= z = [] + | True = [] + | False = [] diff --git a/ghc/compiler/tests/deSugar/ds021.stderr b/ghc/compiler/tests/deSugar/ds021.stderr new file mode 100644 index 0000000000..364d61bcc7 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds021.stderr @@ -0,0 +1,23 @@ +Desugared: +Test.f :: for all d, e. <Eq d> -> d -> d -> d -> [e] +Test.f = + /\ t86 t91 -> \ dict.87 -> + let dict.83 = dict.87 in + let + f.78 = + \ x.61 y.62 z.63 -> + let + fail.92 = + (error [t91]) + "\"ds021.hs\", line 8: pattern-matching failure [function binding]\n"S + in + case ((== t86) dict.83 x.61 y.62) of { + True -> Nil! t91 + False -> + case ((/= t86) dict.87 x.61 z.63) of { + True -> Nil! t91 + False -> Nil! t91 + } + } + in f.78 + diff --git a/ghc/compiler/tests/deSugar/ds022.hs b/ghc/compiler/tests/deSugar/ds022.hs new file mode 100644 index 0000000000..ce07e1941c --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds022.hs @@ -0,0 +1,32 @@ +--!!! ds022 -- literal patterns (wimp version) +-- +module Tests where + +f 1 1.1 = [] +f 2 2.2 = [] +f 3 3.3 = [] +f 4 4.4 = [] + +g 11111111111111111111111 1.11111111111111111 = [] +g 22222222222222222222222 2.22222222222222222 = [] +g 33333333333333333333333 3.33333333333333333 = [] +g 44444444444444444444444 4.44444444444444444 = [] + +h 'a' "" = [] +h '\'' "foo" = [] +h '"' ('b':'a':'r':[]) = [] +h '\o250' blob = [] + +i 1 1.1 = [] +i 2 2.2 = [] +i 1 0.011e2 = [] +i 2 2.20000 = [] + +{- +j one@1 oneone@1.1 + | ((fromFloat oneone) - (fromIntegral (fromInt one))) + /= (fromIntegral (fromInt 0)) = [] +j two@2 twotwo@2.2 + | ((fromFloat twotwo) * (fromIntegral (fromInt 2))) + == (fromIntegral (fromInt 4.4)) = [] +-} diff --git a/ghc/compiler/tests/deSugar/ds022.stderr b/ghc/compiler/tests/deSugar/ds022.stderr new file mode 100644 index 0000000000..cb1e587e24 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds022.stderr @@ -0,0 +1,368 @@ +Desugared: +Tests.f :: for all d, e, f. <Fractional e> -> <Num d> -> d -> e -> [f] +Tests.f = + /\ t101 t104 t107 -> \ dict.105 dict.102 -> + let dict.98 = dict.105 in + let dict.91 = dict.98 in + let dict.84 = dict.91 in + let + dict.106 = (sdsel.Num.Eq t104) ((sdsel.Fractional.Num t104) dict.84) in + let dict.99 = dict.106 in + let dict.92 = dict.99 in + let dict.85 = dict.92 in + let dict.95 = dict.102 in + let dict.88 = dict.95 in + let dict.81 = dict.88 in + let dict.103 = (sdsel.Num.Eq t101) dict.81 in + let dict.96 = dict.103 in + let dict.89 = dict.96 in + let dict.82 = dict.89 in + let + f.79 = + \ ds.179 ds.180 -> + let + fail.181 = + (error [t107]) + "\"ds022.hs\", line 10: pattern-matching failure [function binding]\n"S + in + case + ((== t101) + dict.82 + ((fromInteger t101) dict.81 (MkInteger! 1##)) + ds.179) + of { + True -> + case + ((== t104) + dict.85 + ((fromRational t104) + dict.84 (MkDouble! 1.1000000000000001##)) + ds.180) + of { + True -> Nil! t107 + False -> fail.181 + } + False -> + case + ((== t101) + dict.89 + ((fromInteger t101) dict.88 (MkInteger! 2##)) + ds.179) + of { + True -> + case + ((== t104) + dict.92 + ((fromRational t104) + dict.91 + (MkDouble! 2.2000000000000002##)) + ds.180) + of { + True -> Nil! t107 + False -> fail.181 + } + False -> + case + ((== t101) + dict.96 + ((fromInteger t101) + dict.95 (MkInteger! 3##)) + ds.179) + of { + True -> + case + ((== t104) + dict.99 + ((fromRational t104) + dict.98 + (MkDouble! + 3.2999999999999998##)) + ds.180) + of { + True -> Nil! t107 + False -> fail.181 + } + False -> + case + ((== t101) + dict.103 + ((fromInteger t101) + dict.102 (MkInteger! 4##)) + ds.179) + of { + True -> + case + ((== t104) + dict.106 + ((fromRational t104) + dict.105 + (MkDouble! + 4.4000000000000004##)) + ds.180) + of { + True -> Nil! t107 + False -> fail.181 + } + False -> fail.181 + } + } + } + } + in f.79 +Tests.g :: for all d, e, f. <Fractional e> -> <Num d> -> d -> e -> [f] +Tests.g = + /\ t131 t134 t137 -> \ dict.135 dict.132 -> + let dict.128 = dict.135 in + let dict.121 = dict.128 in + let dict.114 = dict.121 in + let + dict.136 = (sdsel.Num.Eq t134) ((sdsel.Fractional.Num t134) dict.114) in + let dict.129 = dict.136 in + let dict.122 = dict.129 in + let dict.115 = dict.122 in + let dict.125 = dict.132 in + let dict.118 = dict.125 in + let dict.111 = dict.118 in + let dict.133 = (sdsel.Num.Eq t131) dict.111 in + let dict.126 = dict.133 in + let dict.119 = dict.126 in + let dict.112 = dict.119 in + let + g.109 = + \ ds.183 ds.184 -> + let + fail.185 = + (error [t137]) + "\"ds022.hs\", line 15: pattern-matching failure [function binding]\n"S + in + case + ((== t131) + dict.112 + ((fromInteger t131) + dict.111 + (MkInteger! 11111111111111111111111##)) + ds.183) + of { + True -> + case + ((== t134) + dict.115 + ((fromRational t134) + dict.114 + (MkDouble! 1.1111111111111112##)) + ds.184) + of { + True -> Nil! t137 + False -> fail.185 + } + False -> + case + ((== t131) + dict.119 + ((fromInteger t131) + dict.118 + (MkInteger! 22222222222222222222222##)) + ds.183) + of { + True -> + case + ((== t134) + dict.122 + ((fromRational t134) + dict.121 + (MkDouble! 2.2222222222222223##)) + ds.184) + of { + True -> Nil! t137 + False -> fail.185 + } + False -> + case + ((== t131) + dict.126 + ((fromInteger t131) + dict.125 + (MkInteger! + 33333333333333333333333##)) + ds.183) + of { + True -> + case + ((== t134) + dict.129 + ((fromRational t134) + dict.128 + (MkDouble! + 3.3333333333333335##)) + ds.184) + of { + True -> Nil! t137 + False -> fail.185 + } + False -> + case + ((== t131) + dict.133 + ((fromInteger t131) + dict.132 + (MkInteger! + 44444444444444444444444##)) + ds.183) + of { + True -> + case + ((== t134) + dict.136 + ((fromRational t134) + dict.135 + (MkDouble! + 4.4444444444444446##)) + ds.184) + of { + True -> Nil! t137 + False -> fail.185 + } + False -> fail.185 + } + } + } + } + in g.109 +Tests.h :: for all d. Char -> [Char] -> [d] +Tests.h = + /\ t148 -> \ ds.200 ds.201 -> + let + fail.202 = + (error [t148]) + "\"ds022.hs\", line 20: pattern-matching failure [function binding]\n"S + in + case ds.200 of { + MkChar ds.203 -> + case ds.203 of { + 'a'# -> + case (eqString (Nil! Char) ds.201) of { + True -> Nil! t148 + False -> fail.202 + } + '\''# -> + case (eqString "foo"S ds.201) of { + True -> Nil! t148 + False -> fail.202 + } + '"'# -> + case ds.201 of { + (:) ds.204 ds.205 -> + case ds.204 of { + MkChar ds.206 -> + case ds.206 of { + 'b'# -> + case ds.205 of { + (:) ds.207 ds.208 -> + case ds.207 of { + MkChar ds.209 -> + case ds.209 of { + 'a'# -> + case ds.208 of { + (:) ds.210 ds.211 -> + case ds.210 of { + MkChar ds.212 -> + case + ds.212 + of { + 'r'# -> + case + ds.211 + of { + Nil -> + Nil! t148 + _ -> + fail.202 + } + _ -> + fail.202 + } + } + _ -> fail.202 + } + _ -> fail.202 + } + } + _ -> fail.202 + } + _ -> fail.202 + } + } + _ -> fail.202 + } + '¨'# -> let blob.213 = ds.201 in Nil! t148 + _ -> fail.202 + } + } +Tests.i :: for all d, e, f. <Fractional e> -> <Num d> -> d -> e -> [f] +Tests.i = + /\ t172 t175 t178 -> \ dict.176 dict.173 -> + let dict.169 = dict.176 in + let dict.162 = dict.169 in + let dict.155 = dict.162 in + let + dict.177 = (sdsel.Num.Eq t175) ((sdsel.Fractional.Num t175) dict.155) in + let dict.170 = dict.177 in + let dict.163 = dict.170 in + let dict.156 = dict.163 in + let dict.166 = dict.173 in + let dict.159 = dict.166 in + let dict.152 = dict.159 in + let dict.174 = (sdsel.Num.Eq t172) dict.152 in + let dict.167 = dict.174 in + let dict.160 = dict.167 in + let dict.153 = dict.160 in + let + i.150 = + \ ds.214 ds.215 -> + let + fail.216 = + (error [t178]) + "\"ds022.hs\", line 25: pattern-matching failure [function binding]\n"S + in + case + ((== t172) + dict.153 + ((fromInteger t172) dict.152 (MkInteger! 1##)) + ds.214) + of { + True -> + case + ((== t175) + dict.156 + ((fromRational t175) + dict.155 + (MkDouble! 1.1000000000000001##)) + ds.215) + of { + True -> Nil! t178 + False -> fail.216 + } + False -> + case + ((== t172) + dict.160 + ((fromInteger t172) dict.159 (MkInteger! 2##)) + ds.214) + of { + True -> + case + ((== t175) + dict.163 + ((fromRational t175) + dict.162 + (MkDouble! 2.2000000000000002##)) + ds.215) + of { + True -> Nil! t178 + False -> fail.216 + } + False -> fail.216 + } + } + in i.150 + diff --git a/ghc/compiler/tests/deSugar/ds023.hs b/ghc/compiler/tests/deSugar/ds023.hs new file mode 100644 index 0000000000..ecd6e137bf --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds023.hs @@ -0,0 +1,7 @@ +--!!! ds023 -- overloading eg from section 9.2 +-- +module Tests where + +f x = g (x == x) x +g b x = abs (f x) +--g b x = (f x) + (f x) diff --git a/ghc/compiler/tests/deSugar/ds023.stderr b/ghc/compiler/tests/deSugar/ds023.stderr new file mode 100644 index 0000000000..fd3aaec1ff --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds023.stderr @@ -0,0 +1,12 @@ +Desugared: +{- plain CoRec -} +Tests.f :: for all d, e. <Num e> -> <Eq d> -> d -> e +Tests.f = + /\ t83 t90 -> \ dict.91 dict.84 x.93 -> + ((Tests.g t83) t90) dict.91 dict.84 ((== t83) dict.84 x.93 x.93) x.93 +Tests.g :: for all d, e. <Num e> -> <Eq d> -> Bool -> d -> e +Tests.g = + /\ t83 t90 -> \ dict.91 dict.84 b.94 x.95 -> + (abs t90) dict.91 (((Tests.f t83) t90) dict.91 dict.84 x.95) +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds024.hs b/ghc/compiler/tests/deSugar/ds024.hs new file mode 100644 index 0000000000..1e5f7ebe07 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds024.hs @@ -0,0 +1,8 @@ +--!!! ds024 -- correct types on ConPatOuts + +-- do all the right types get stuck on all the +-- Nils and Conses? + +f x = [[], []] + +g x = ([], [], []) diff --git a/ghc/compiler/tests/deSugar/ds024.stderr b/ghc/compiler/tests/deSugar/ds024.stderr new file mode 100644 index 0000000000..cb012f9ec8 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds024.stderr @@ -0,0 +1,10 @@ +Desugared: +Main.f :: for all d, e. d -> [[e]] +Main.f = + /\ o79 t81 -> \ x.88 -> + :! [t81] (Nil! t81) (:! [t81] (Nil! t81) (Nil! [t81])) +Main.g :: for all d, e, f, g. d -> ([e], [f], [g]) +Main.g = + /\ o84 t85 t86 t87 -> \ x.89 -> + MkTuple3! [t85] [t86] [t87] (Nil! t85) (Nil! t86) (Nil! t87) + diff --git a/ghc/compiler/tests/deSugar/ds025.hs b/ghc/compiler/tests/deSugar/ds025.hs new file mode 100644 index 0000000000..c28b16d5bf --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds025.hs @@ -0,0 +1,18 @@ +--!!! ds025 -- overloaded assoc -- AbsBinds + +module Util where + +ehead xs loc | null xs = error ("4"++loc) + | True = head xs + +assoc key lst loc + = if (null res) then error ("1"++loc++"2"++(show key)) + else (ehead res "3") + where res = [ val | (key',val) <- lst, key==key'] + +assocMaybe :: (Eq a) => a -> [(a,b)] -> Maybe b +assocMaybe key lst + = if (null res) then Nothing else (Just (head res)) + where res = [ val | (key',val) <- lst, key==key'] + +data Maybe a = Just a | Nothing deriving () diff --git a/ghc/compiler/tests/deSugar/ds025.stderr b/ghc/compiler/tests/deSugar/ds025.stderr new file mode 100644 index 0000000000..72e8c6776f --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds025.stderr @@ -0,0 +1,84 @@ +Desugared: +Util.ehead :: for all a. [a] -> [Char] -> a +Util.ehead = + /\ a -> \ xs.152 loc.153 -> + let + fail.154 = + (error a) + "\"ds025.hs\", line 8: pattern-matching failure [function binding]\n"S + in + case ((null a) xs.152) of { + True -> (error a) ((++ Char) "4"S loc.153) + False -> (head a) xs.152 + } +Util.assoc :: for all a, a. <Eq a> -> <Text a> -> a -> [(a, a)] -> [Char] -> a +Util.assoc = + /\ a a -> \ dict.120 dict.128 key.165 lst.166 loc.167 -> + let + res.174 = + let + {- CoRec -} + ds.168 = + \ ds.169 -> + case ds.169 of { + Nil -> Nil a + (:) ds.170 ds.171 -> + case ds.170 of { + MkTuple2 key'.172 val.173 -> + case ((== a) dict.120 key.165 key'.172) of { + True -> (: a) val.173 (ds.168 ds.171) + False -> ds.168 ds.171 + } + } + } + {- end CoRec -} + in ds.168 lst.166 + in + case ((null a) res.174) of { + True -> + (error a) + ((++ Char) + "1"S + ((++ Char) + loc.167 + ((++ Char) "2"S ((show a) dict.128 key.165)))) + False -> (Util.ehead a) res.174 "3"S + } +Util.assocMaybe :: for all a, b. <Eq a> -> a -> [(a, b)] -> Util.Maybe b +Util.assocMaybe = + /\ a b -> \ dict.150 -> + let dict.142 = dict.150 in + let + assocMaybe.134 = + \ key.80 lst.81 -> + let + res.82 = + let + {- CoRec -} + ds.179 = + \ ds.180 -> + case ds.180 of { + Nil -> Nil b + (:) ds.181 ds.182 -> + case ds.181 of { + MkTuple2 key'.183 val.184 -> + case + ((== a) + dict.142 key.80 key'.183) + of { + True -> + (: b) + val.184 (ds.179 ds.182) + False -> ds.179 ds.182 + } + } + } + {- end CoRec -} + in ds.179 lst.81 + in + case ((null b) res.82) of { + True -> Util.Nothing b + False -> (Util.Just b) ((head b) res.82) + } + in assocMaybe.134 + diff --git a/ghc/compiler/tests/deSugar/ds026.hs b/ghc/compiler/tests/deSugar/ds026.hs new file mode 100644 index 0000000000..2f9faa7303 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds026.hs @@ -0,0 +1,12 @@ +--!!! ds026 -- classes -- incl. polymorphic method + +class Foo a where + op :: a -> a + +class Foo a => Boo a where + op1 :: a -> a + +class Boo a => Noo a where + op2 :: (Eq b) => a -> b -> a + +f x y = op (op2 x y) diff --git a/ghc/compiler/tests/deSugar/ds026.stderr b/ghc/compiler/tests/deSugar/ds026.stderr new file mode 100644 index 0000000000..bb52796ea0 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds026.stderr @@ -0,0 +1,49 @@ +Desugared: +defm.Main.Boo.op1 :: for all a. <Main.Boo a> -> a -> a +defm.Main.Boo.op1 = /\ a -> (error (a -> a)) "No default method for \"op1\"\n"S +Main.Boo.op1 :: for all a. <Main.Boo a> -> a -> a +Main.Boo.op1 = + /\ a -> \ ds.113 -> + case ds.113 of { + MkTuple2 dict.84 op1.83 -> op1.83 + } +sdsel.Main.Boo.Main.Foo :: for all a. <Main.Boo a> -> <Main.Foo a> +sdsel.Main.Boo.Main.Foo = + /\ a -> \ ds.114 -> + case ds.114 of { + MkTuple2 dict.87 op1.86 -> dict.87 + } +defm.Main.Foo.op :: for all a. <Main.Foo a> -> a -> a +defm.Main.Foo.op = /\ a -> (error (a -> a)) "No default method for \"op\"\n"S +Main.Foo.op :: for all a. <Main.Foo a> -> a -> a +Main.Foo.op = /\ a -> \ op.90 -> op.90 +defm.Main.Noo.op2 :: for all a, b. <Main.Noo a> -> <Eq b> -> a -> b -> a +defm.Main.Noo.op2 = + /\ a b -> \ dict.102 -> + (error (a -> b -> a)) "No default method for \"op2\"\n"S +Main.Noo.op2 :: for all a, b. <Main.Noo a> -> <Eq b> -> a -> b -> a +Main.Noo.op2 = + /\ a b -> \ ds.115 -> + case ds.115 of { + MkTuple2 dict.94 op2.93 -> op2.93 b + } +sdsel.Main.Noo.Main.Boo :: for all a. <Main.Noo a> -> <Main.Boo a> +sdsel.Main.Noo.Main.Boo = + /\ a -> \ ds.116 -> + case ds.116 of { + MkTuple2 dict.98 op2.97 -> dict.98 + } +Main.f :: for all b, a. <Eq b> -> <Main.Noo a> -> a -> b -> a +Main.f = + /\ b a -> \ dict.112 dict.111 -> + let + dict.108 = + (sdsel.Main.Boo.Main.Foo a) ((sdsel.Main.Noo.Main.Boo a) dict.111) in + let + f.104 = + \ x.68 y.69 -> + (Main.Foo.op a) + dict.108 + (((Main.Noo.op2 a) b) dict.111 dict.112 x.68 y.69) + in f.104 + diff --git a/ghc/compiler/tests/deSugar/ds027.hs b/ghc/compiler/tests/deSugar/ds027.hs new file mode 100644 index 0000000000..99a4d93ac2 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds027.hs @@ -0,0 +1,9 @@ +--!!! ds027 -- simple instances +-- +module Test where + +data Foo = Bar | Baz + +instance Eq Foo where + Bar == Baz = True + Bar /= Baz = False diff --git a/ghc/compiler/tests/deSugar/ds027.stderr b/ghc/compiler/tests/deSugar/ds027.stderr new file mode 100644 index 0000000000..0b5be11dc8 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds027.stderr @@ -0,0 +1,44 @@ +Desugared: +{- plain CoRec -} +dfun.Eq.Test.Foo :: <Eq Test.Foo> +dfun.Eq.Test.Foo = + let + ==.76 = + \ ds.83 ds.84 -> + let + fail.85 = + (error Bool) + "\"ds027.hs\", line 8: pattern-matching failure [function binding]\n"S + in + case ds.83 of { + Test.Bar -> + case ds.84 of { + Test.Baz -> True + _ -> fail.85 + } + _ -> fail.85 + } in + let + /=.77 = + \ ds.89 ds.90 -> + let + fail.91 = + (error Bool) + "\"ds027.hs\", line 9: pattern-matching failure [function binding]\n"S + in + case ds.89 of { + Test.Bar -> + case ds.90 of { + Test.Baz -> False + _ -> fail.91 + } + _ -> fail.91 + } + in + MkTuple2! + (Test.Foo -> Test.Foo -> Bool) + (Test.Foo -> Test.Foo -> Bool) + ==.76 + /=.77 +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds028.hs b/ghc/compiler/tests/deSugar/ds028.hs new file mode 100644 index 0000000000..728a0c89bc --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds028.hs @@ -0,0 +1,10 @@ +--!!! ds028: failable pats in top row + +-- when the first row of pats doesn't have convenient +-- variables to grab... + +mAp f [] = [] +mAp f (x:xs) = f x : mAp f xs + +True |||| _ = True +False |||| x = x diff --git a/ghc/compiler/tests/deSugar/ds028.stderr b/ghc/compiler/tests/deSugar/ds028.stderr new file mode 100644 index 0000000000..450f82f9c1 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds028.stderr @@ -0,0 +1,30 @@ +Desugared: +{- plain CoRec -} +Main.map :: for all d, e. (d -> e) -> [d] -> [e] +Main.map = + /\ t88 t84 -> \ f.100 ds.101 -> + let + fail.102 = + (error [t84]) + "\"ds028.hs\", line 7: pattern-matching failure [function binding]\n"S + in + case ds.101 of { + Nil -> Nil! t84 + (:) x.103 xs.104 -> + let f.105 = f.100 + in (: t84) (f.105 x.103) (((Main.map t88) t84) f.105 xs.104) + } +{- end plain CoRec -} +Main.|| :: Bool -> Bool -> Bool +Main.|| = + \ ds.109 ds.110 -> + let + fail.111 = + (error Bool) + "\"ds028.hs\", line 10: pattern-matching failure [function binding]\n"S + in + case ds.109 of { + True -> True + False -> let x.112 = ds.110 in x.112 + } + diff --git a/ghc/compiler/tests/deSugar/ds029.hs b/ghc/compiler/tests/deSugar/ds029.hs new file mode 100644 index 0000000000..fd9f583487 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds029.hs @@ -0,0 +1,9 @@ +--!!! ds029: pattern binding with guards (dubious but valid) +-- + +module Test where + +f x = y + where (y,z) | y < z = (0,1) + | y > z = (1,2) + | True = (2,3) diff --git a/ghc/compiler/tests/deSugar/ds029.stderr b/ghc/compiler/tests/deSugar/ds029.stderr new file mode 100644 index 0000000000..4f1da2b10c --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds029.stderr @@ -0,0 +1,70 @@ +Desugared: +Test.f :: for all d, e. <Ord e> -> <Num e> -> d -> e +Test.f = + /\ o79 t102 -> \ dict.103 dict.104 x.107 -> + let + ds.124 = + /\ t108 -> \ dict.109 dict.110 -> + let dict.111 = dict.110 in + let dict.112 = dict.111 in + let dict.113 = dict.112 in + let dict.114 = dict.113 in + let dict.115 = dict.114 in + let dict.116 = dict.109 + in + let + {- CoRec -} + ds.117 = + case ((< t108) dict.116 y.118 z.119) of { + True -> + MkTuple2! + t108 + t108 + ((fromInteger t108) + dict.115 (MkInteger! 0##)) + ((fromInteger t108) + dict.114 (MkInteger! 1##)) + False -> + case ((> t108) dict.109 y.118 z.119) of { + True -> + MkTuple2! + t108 + t108 + ((fromInteger t108) + dict.113 (MkInteger! 1##)) + ((fromInteger t108) + dict.112 (MkInteger! 2##)) + False -> + MkTuple2! + t108 + t108 + ((fromInteger t108) + dict.111 (MkInteger! 2##)) + ((fromInteger t108) + dict.110 (MkInteger! 3##)) + } + } + y.118 = + case ds.117 of { + MkTuple2 y.120 z.121 -> y.120 + } + z.119 = + case ds.117 of { + MkTuple2 y.122 z.123 -> z.123 + } + {- end CoRec -} + in MkTuple2! t108 t108 y.118 z.119 in + let + y.130 = + /\ t125 -> \ dict.126 dict.127 -> + case ((ds.124 t125) dict.126 dict.127) of { + MkTuple2 y.128 z.129 -> y.128 + } in + let + z.136 = + /\ t131 -> \ dict.132 dict.133 -> + case ((ds.124 t131) dict.132 dict.133) of { + MkTuple2 y.134 z.135 -> z.135 + } + in (y.130 t102) dict.103 dict.104 + diff --git a/ghc/compiler/tests/deSugar/ds030.hs b/ghc/compiler/tests/deSugar/ds030.hs new file mode 100644 index 0000000000..7abc4d82e0 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds030.hs @@ -0,0 +1,5 @@ +--!!! ds030: checks that types substituted into binders +-- +module Test where + +f x = case x of [] -> (3::Int) ; _ -> (4::Int) diff --git a/ghc/compiler/tests/deSugar/ds030.stderr b/ghc/compiler/tests/deSugar/ds030.stderr new file mode 100644 index 0000000000..7125ae64e0 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds030.stderr @@ -0,0 +1,31 @@ +Desugared: +Test.f :: for all d. [d] -> Int {- 0 MkInt deriving ( )-} = + /\ t78 -> \ x.88 :: [t78] -> + let ds.89 :: [t78] = x.88 :: [t78] in + let + fail.90 :: Int {- 0 MkInt deriving ( )-} = + ({-CoTyApp-} error :: for all a. + [Char {- 0 MkChar deriving ( )-}] -> a + Int {- 0 MkInt deriving ( )-}) + "\"ds030.hs\", line 5: pattern-matching failed in case\n"S in + let + fail.92 :: Int {- 0 MkInt deriving ( )-} = + let + dict.91 :: <Num {- Num -} <Num {- Num -} Int {- 0 MkInt deriving ( )-}>> = + dfun.Num.Int :: <Num {- Num -} Int {- 0 MkInt deriving ( )-}> + in + MkInt :: IntPrim{- StgInt -} -> Int {- 0 MkInt deriving ( )-}! + 4# + in + case ds.89 :: [t78] of { + [a] {- 1 a Nil, : deriving ( )-} + Nil :: for all a. [a] -> + let + dict.93 :: <Num {- Num -} <Num {- Num -} Int {- 0 MkInt deriving ( )-}>> = + dfun.Num.Int :: <Num {- Num -} Int {- 0 MkInt deriving ( )-}> + in + MkInt :: IntPrim{- StgInt -} -> Int {- 0 MkInt deriving ( )-}! + 3# + _ -> fail.92 :: Int {- 0 MkInt deriving ( )-} + } + diff --git a/ghc/compiler/tests/deSugar/ds031.hs b/ghc/compiler/tests/deSugar/ds031.hs new file mode 100644 index 0000000000..6454e08d03 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds031.hs @@ -0,0 +1,5 @@ +foldPair :: (a->a->a,b->b->b) -> (a,b) -> [(a,b)] -> (a,b) +foldPair fg ab [] = ab +foldPair fg@(f,g) ab ((a,b):abs) = (f a u,g b v) + where (u,v) = foldPair fg ab abs + diff --git a/ghc/compiler/tests/deSugar/ds031.stderr b/ghc/compiler/tests/deSugar/ds031.stderr new file mode 100644 index 0000000000..c282d34493 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds031.stderr @@ -0,0 +1,51 @@ +Desugared: +{- plain CoRec -} +Main.foldPair :: + for all a, b. (a -> a -> a, b -> b -> b) -> (a, b) -> [(a, b)] -> (a, b) +Main.foldPair = + /\ a b -> \ fg.122 ab.123 ds.124 -> + let + fail.125 = + (error (a, b)) + "\"ds031.hs\", line 4: pattern-matching failure [function binding]\n"S in + let + fail.141 = + case fg.122 of { + MkTuple2 f.126 g.127 -> + case ds.124 of { + (:) ds.128 abs.129 -> + case ds.128 of { + MkTuple2 a.130 b.131 -> + let ab.132 = ab.123 in + let fg.133 = fg.122 in + let + ds.134 = + ((Main.foldPair a) b) + fg.133 ab.132 abs.129 in + let + u.137 = + case ds.134 of { + MkTuple2 u.135 v.136 -> u.135 + } in + let + v.140 = + case ds.134 of { + MkTuple2 u.138 v.139 -> v.139 + } + in + MkTuple2! + a + b + (f.126 a.130 u.137) + (g.127 b.131 v.140) + } + _ -> fail.125 + } + } + in + case ds.124 of { + Nil -> ab.123 + _ -> fail.141 + } +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds032.hs b/ghc/compiler/tests/deSugar/ds032.hs new file mode 100644 index 0000000000..a1cda8468e --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds032.hs @@ -0,0 +1,14 @@ +--!!! recursive funs tangled in an AbsBind + +flatten :: Int -- Indentation + -> Bool -- True => just had a newline + -> Float -- Current seq to flatten + -> [(Int,Float)]-- Work list with indentation + -> String + +flatten n nlp 0.0 seqs = flattenS nlp seqs +flatten n nlp 1.0 seqs = flatten n nlp 1.1 ((n,1.2) : seqs) + +flattenS :: Bool -> [(Int, Float)] -> String +flattenS nlp [] = "" +flattenS nlp ((col,seq):seqs) = flatten col nlp seq seqs diff --git a/ghc/compiler/tests/deSugar/ds032.stderr b/ghc/compiler/tests/deSugar/ds032.stderr new file mode 100644 index 0000000000..e5faf99352 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds032.stderr @@ -0,0 +1,64 @@ +Desugared: +dict.93 :: <Fractional Float> +dict.93 = dfun.Fractional.Float +dict.94 :: <Eq Float> +dict.94 = dfun.Eq.Float +dict.101 :: <Fractional Float> +dict.101 = dfun.Fractional.Float +dict.102 :: <Eq Float> +dict.102 = dfun.Eq.Float +dict.107 :: <Fractional Float> +dict.107 = dfun.Fractional.Float +dict.111 :: <Fractional Float> +dict.111 = dfun.Fractional.Float +{- plain CoRec -} +Main.flatten :: Int -> Bool -> Float -> [(Int, Float)] -> [Char] +Main.flatten = + \ n.130 nlp.131 ds.132 seqs.133 -> + let + fail.134 = + (error [Char]) + "\"ds032.hs\", line 10: pattern-matching failure [function binding]\n"S + in + case (eqFloat (MkFloat! 0.0000000000000000#) ds.132) of { + True -> Main.flattenS nlp.131 seqs.133 + False -> + case (eqFloat (MkFloat! 1.0000000000000000#) ds.132) of { + True -> + let seqs.135 = seqs.133 in + let nlp.136 = nlp.131 in + let n.137 = n.130 + in + Main.flatten + n.137 + nlp.136 + (MkFloat! 1.1000000000000001#) + ((: (Int, Float)) + (MkTuple2! + Int + Float + n.137 + (MkFloat! 1.2000000000000000#)) + seqs.135) + False -> fail.134 + } + } +Main.flattenS :: Bool -> [(Int, Float)] -> [Char] +Main.flattenS = + \ nlp.138 ds.139 -> + let + fail.140 = + (error [Char]) + "\"ds032.hs\", line 14: pattern-matching failure [function binding]\n"S + in + case ds.139 of { + Nil -> Nil! Char + (:) ds.141 seqs.142 -> + case ds.141 of { + MkTuple2 col.143 seq.144 -> + let nlp.145 = nlp.138 + in Main.flatten col.143 nlp.145 seq.144 seqs.142 + } + } +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds033.hs b/ghc/compiler/tests/deSugar/ds033.hs new file mode 100644 index 0000000000..bdadb58bfe --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds033.hs @@ -0,0 +1,15 @@ +--!!! getting top-level dependencies right +-- +module Test where + +f1 x = g1 x +g1 y = y + +g2 y = y +f2 x = g2 x + +f3 x = g3 x +g3 y = f3 y + +g4 y = f4 y +f4 x = g4 x diff --git a/ghc/compiler/tests/deSugar/ds033.stderr b/ghc/compiler/tests/deSugar/ds033.stderr new file mode 100644 index 0000000000..9fe0d0c3ab --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds033.stderr @@ -0,0 +1,22 @@ +Desugared: +Test.g1 :: for all d. d -> d +Test.g1 = /\ o91 -> \ y.119 -> y.119 +Test.f1 :: for all d. d -> d +Test.f1 = /\ t95 -> \ x.120 -> (Test.g1 t95) x.120 +Test.g2 :: for all d. d -> d +Test.g2 = /\ o98 -> \ y.121 -> y.121 +Test.f2 :: for all d. d -> d +Test.f2 = /\ t102 -> \ x.122 -> (Test.g2 t102) x.122 +{- plain CoRec -} +Test.f3 :: for all d, e. d -> e +Test.f3 = /\ o109 o110 -> \ x.123 -> ((Test.g3 o109) o110) x.123 +Test.g3 :: for all d, e. d -> e +Test.g3 = /\ o109 o110 -> \ y.124 -> ((Test.f3 o109) o110) y.124 +{- end plain CoRec -} +{- plain CoRec -} +Test.g4 :: for all d, e. d -> e +Test.g4 = /\ o117 o118 -> \ y.125 -> ((Test.f4 o117) o118) y.125 +Test.f4 :: for all d, e. d -> e +Test.f4 = /\ o117 o118 -> \ x.126 -> ((Test.g4 o117) o118) x.126 +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds034.hs b/ghc/compiler/tests/deSugar/ds034.hs new file mode 100644 index 0000000000..d1f278608b --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds034.hs @@ -0,0 +1,11 @@ +--!!! mutually-recursive methods in an instance declaration +-- +module Test where + +class Foo a where + op1 :: a -> a + op2 :: a -> a + +instance Foo Int where + op1 x = op2 x + op2 y = op1 y diff --git a/ghc/compiler/tests/deSugar/ds034.stderr b/ghc/compiler/tests/deSugar/ds034.stderr new file mode 100644 index 0000000000..6ca09a5489 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds034.stderr @@ -0,0 +1,27 @@ +Desugared: +{- plain CoRec -} +defm.Test.Foo.op1 :: for all a. <Test.Foo a> -> a -> a +defm.Test.Foo.op1 = /\ a -> (error (a -> a)) "No default method for \"op1\"\n"S +defm.Test.Foo.op2 :: for all a. <Test.Foo a> -> a -> a +defm.Test.Foo.op2 = /\ a -> (error (a -> a)) "No default method for \"op2\"\n"S +Test.Foo.op1 :: for all a. <Test.Foo a> -> a -> a +Test.Foo.op1 = + /\ a -> \ ds.95 -> + case ds.95 of { + MkTuple2 op1.77 op2.78 -> op1.77 + } +Test.Foo.op2 :: for all a. <Test.Foo a> -> a -> a +Test.Foo.op2 = + /\ a -> \ ds.96 -> + case ds.96 of { + MkTuple2 op1.80 op2.81 -> op2.81 + } +dfun.Test.Foo.Int :: <Test.Foo Int> +dfun.Test.Foo.Int = + let dict.89 = dfun.Test.Foo.Int in + let op1.85 = \ x.97 -> (Test.Foo.op2 Int) dict.89 x.97 in + let dict.93 = dfun.Test.Foo.Int in + let op2.86 = \ y.98 -> (Test.Foo.op1 Int) dict.93 y.98 + in MkTuple2! (Int -> Int) (Int -> Int) op1.85 op2.86 +{- end plain CoRec -} + diff --git a/ghc/compiler/tests/deSugar/ds035.hs b/ghc/compiler/tests/deSugar/ds035.hs new file mode 100644 index 0000000000..5a29a0eb3b --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds035.hs @@ -0,0 +1,18 @@ +data CList = CNil | CCons Int# CList + +mk :: Int# -> CList +mk n = case (n ==# 0#) of + 0# -> CNil + _ -> CCons 1# (mk (n `minusInt#` 1#)) + +clen :: CList -> Int# +clen CNil = 0# +clen (CCons _ cl) = 1# +# (clen cl) + +main = case len4_twice of + 8# -> "bingo\n" + _ -> "oops\n" + where + list4 = mk 4# + len4 = clen list4 + len4_twice = len4 +# len4 diff --git a/ghc/compiler/tests/deSugar/ds035.stderr b/ghc/compiler/tests/deSugar/ds035.stderr new file mode 100644 index 0000000000..bf6c983ef2 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds035.stderr @@ -0,0 +1,5 @@ + +"ds035.hs", line 4: undefined value: minusIntPrim +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/deSugar/ds036.hs b/ghc/compiler/tests/deSugar/ds036.hs new file mode 100644 index 0000000000..fc30c077e3 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds036.hs @@ -0,0 +1,45 @@ +{- +From dmc@minster.york.ac.uk Tue Mar 10 17:15:20 1992 +Via: uk.ac.york.minster; Tue, 10 Mar 92 17:15:14 GMT +Message-Id: <swordfish.700247842@minster.york.ac.uk> +From: dmc@minster.york.ac.uk +To: partain +Date: 10 Mar 1992 17:17:21 GMT + +Will, + +I have just started using Haskell at York and have found a compilation +error in the code below which disappears when the last line is +commented out +-} + +module Test2 where + +--brack :: (Eq a) => a -> a -> [a] -> ([a],[a]) +--brack open close = brack' open close (1 :: Int) + +brack' :: (Eq a) => a -> a -> Int -> [a] -> ([a],[a]) +brack' open close 0 xs = ([],xs) +brack' open close (n+1) [] = ([],[]) +brack' open close (n+1) (h:t) | h == open = ([],[]) + +{- +Is this something I have done wrong or a fault with the compiler? + +Cheers +Dave + + +----------------------------------------------------------------------- +David Cattrall Telephone +44 904 432777 +Department of Computer Science +University of York JANET: dmc@uk.ac.york.minster +YORK Y01 5DD +United Kingdom UUNET: uucp!ukc!minster!dmc +----------------------------------------------------------------------- +-} + +-- and this was Kevin's idea, subsequently... + +kh (n+2) x | x > n = x * 2 +kh (x+1) (m+1) = m diff --git a/ghc/compiler/tests/deSugar/ds036.stderr b/ghc/compiler/tests/deSugar/ds036.stderr new file mode 100644 index 0000000000..3fa73eab9d --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds036.stderr @@ -0,0 +1,145 @@ +Desugared: +Test2.brack' :: for all a. <Eq a> -> a -> a -> Int -> [a] -> ([a], [a]) +Test2.brack' = + /\ a -> \ dict.124 -> + let dict.119 = dict.124 in + let dict.96 = dfun.Num.Int in + let dict.97 = dfun.Eq.Int in + let dict.104 = dfun.Num.Int in + let dict.105 = dfun.Ord.Int in + let dict.113 = dfun.Num.Int in + let dict.114 = dfun.Ord.Int in + let + brack'.92 = + \ open.64 close.63 ds.148 xs.65 -> + let + fail.149 = + (error ([a], [a])) + "\"ds036.hs\", line 24: pattern-matching failure [function binding]\n"S in + let + fail.151 = + let n.150 = MkInt! 1# + in + case (geInt ds.148 (MkInt! 1#)) of { + True -> + let n.67 = minusInt ds.148 (MkInt! 1#) + in + case xs.65 of { + Nil -> + let close.66 = close.63 in + let open.68 = open.64 + in MkTuple2! [a] [a] (Nil! a) (Nil! a) + (:) h.70 t.73 -> + let close.69 = close.63 in + let open.72 = open.64 + in + case + ((== a) dict.119 h.70 open.72) + of { + True -> + MkTuple2! + [a] [a] (Nil! a) (Nil! a) + False -> fail.149 + } + } + False -> fail.149 + } + in + case ds.148 of { + MkInt ds.152 -> + case ds.152 of { + 0# -> MkTuple2! [a] [a] (Nil! a) xs.65 + _ -> fail.151 + } + } + in brack'.92 +Test2.kh :: + for all d, e. <Ord e> -> <Num e> -> <Ord d> -> <Num d> -> d -> e -> e +Test2.kh = + /\ t141 t145 -> \ dict.147 dict.146 dict.143 dict.142 -> + let dict.138 = dict.146 in + let dict.136 = dict.138 in + let dict.133 = dict.147 in + let dict.129 = dict.142 in + let dict.130 = dict.143 in + let + kh.126 = + \ n.74 x.75 -> + let + fail.154 = + (error t145) + "\"ds036.hs\", line 45: pattern-matching failure [function binding]\n"S in + let n.157 = (fromInteger t141) dict.129 (MkInteger! 2##) + in + case + ((>= t141) + dict.130 + n.74 + ((fromInteger t141) dict.129 (MkInteger! 2##))) + of { + True -> + let + n.74 = + (- t141) + dict.129 + n.74 + ((fromInteger t141) + dict.129 (MkInteger! 2##)) + in + case ((> t145) dict.133 x.75 n.74) of { + True -> + (* t145) + dict.136 + x.75 + ((fromInteger t145) + dict.138 (MkInteger! 2##)) + False -> fail.154 + } + False -> + let + x.156 = (fromInteger t141) dict.142 (MkInteger! 1##) + in + case + ((>= t141) + dict.143 + n.74 + ((fromInteger t141) + dict.142 (MkInteger! 1##))) + of { + True -> + let + x.77 = + (- t141) + dict.142 + n.74 + ((fromInteger t141) + dict.142 (MkInteger! 1##)) in + let + m.155 = + (fromInteger t145) + dict.146 (MkInteger! 1##) + in + case + ((>= t145) + dict.147 + x.75 + ((fromInteger t145) + dict.146 (MkInteger! 1##))) + of { + True -> + let + m.76 = + (- t145) + dict.146 + x.75 + ((fromInteger t145) + dict.146 + (MkInteger! 1##)) + in m.76 + False -> fail.154 + } + False -> fail.154 + } + } + in kh.126 + diff --git a/ghc/compiler/tests/deSugar/ds037.hs b/ghc/compiler/tests/deSugar/ds037.hs new file mode 100644 index 0000000000..924df509e0 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds037.hs @@ -0,0 +1,4 @@ +--!!! AbsBinds with tyvars, no dictvars, but some dict binds +-- +f x y = (fst (g y x), x+(1::Int)) +g x y = (fst (f x y), y+(1::Int)) diff --git a/ghc/compiler/tests/deSugar/ds037.stderr b/ghc/compiler/tests/deSugar/ds037.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds037.stderr diff --git a/ghc/compiler/tests/deSugar/ds038.hs b/ghc/compiler/tests/deSugar/ds038.hs new file mode 100644 index 0000000000..ceffab1435 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds038.hs @@ -0,0 +1,7 @@ +--!!! Jon Hill reported a bug in desugaring this in 0.09 +--!!! (recursive with n+k patts) +-- +takeList :: Int -> [a] -> [a] +takeList 0 _ = [] +takeList (n+1) [] = [] +takeList (n+1) (x:xs) = x : takeList n xs diff --git a/ghc/compiler/tests/deSugar/ds038.stderr b/ghc/compiler/tests/deSugar/ds038.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds038.stderr diff --git a/ghc/compiler/tests/deSugar/ds039.hs b/ghc/compiler/tests/deSugar/ds039.hs new file mode 100644 index 0000000000..ad6c1bed07 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds039.hs @@ -0,0 +1,4 @@ +--!!! make sure correct type applications get put in +--!!! when (:) is saturated. + +f = (:) diff --git a/ghc/compiler/tests/deSugar/ds039.stderr b/ghc/compiler/tests/deSugar/ds039.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds039.stderr diff --git a/ghc/compiler/tests/deSugar/ds040.hs b/ghc/compiler/tests/deSugar/ds040.hs new file mode 100644 index 0000000000..d7fb6216e9 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds040.hs @@ -0,0 +1,13 @@ +--!!! Another bug in overloaded n+k patts +-- + +main _ = [AppendChan stdout (shows ((4::Int) ^^^^ (6::Int)) "\n")] + +(^^^^) :: (Num a, Integral b) => a -> b -> a +x ^^^^ 0 = 1 +x ^^^^ (n+1) = f x n x + where f _ 0 y = y + f x n y = g x n where + g x n | even n = g (x*x) (n `quot` 2) + | otherwise = f x (n-1) (x*y) +_ ^^^^ _ = error "(^^^^){Prelude}: negative exponent" diff --git a/ghc/compiler/tests/deSugar/ds040.stderr b/ghc/compiler/tests/deSugar/ds040.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deSugar/ds040.stderr diff --git a/ghc/compiler/tests/deriving/Jmakefile b/ghc/compiler/tests/deriving/Jmakefile new file mode 100644 index 0000000000..e676c5c14c --- /dev/null +++ b/ghc/compiler/tests/deriving/Jmakefile @@ -0,0 +1,9 @@ +TEST_FLAGS=-noC -ddump-tc -dcore-lint -hi + +RunStdTest(drv001,$(GHC),$(TEST_FLAGS) drv001.hs -o2 drv001.stderr) +RunStdTest(drv002,$(GHC),$(TEST_FLAGS) drv002.hs -o2 drv002.stderr) +RunStdTest(drv003,$(GHC),$(TEST_FLAGS) drv003.hs -o2 drv003.stderr) +RunStdTest(drv004,$(GHC),$(TEST_FLAGS) drv004.hs -o2 drv004.stderr) +RunStdTest(drv005,$(GHC),$(TEST_FLAGS) drv005.hs -o2 drv005.stderr) +RunStdTest(drv006,$(GHC),$(TEST_FLAGS) drv006.hs -o2 drv006.stderr) +RunStdTest(drv007,$(GHC),$(TEST_FLAGS) drv007.hs -o2 drv007.stderr) diff --git a/ghc/compiler/tests/deriving/drv001.hs b/ghc/compiler/tests/deriving/drv001.hs new file mode 100644 index 0000000000..707a05d9ba --- /dev/null +++ b/ghc/compiler/tests/deriving/drv001.hs @@ -0,0 +1,19 @@ +--!!! canonical weird example for "deriving" + +data X a b + = C1 (T a) + | C2 (Y b) + | C3 (X b a) + deriving Text + +data Y b + = D1 + | D2 (X Int b) + deriving Text + +data T a + = E1 + +instance Eq a => Text (T a) where + showsPrec = error "show" + readsPrec = error "read" diff --git a/ghc/compiler/tests/deriving/drv001.stderr b/ghc/compiler/tests/deriving/drv001.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv001.stderr diff --git a/ghc/compiler/tests/deriving/drv002.hs b/ghc/compiler/tests/deriving/drv002.hs new file mode 100644 index 0000000000..e8855f2600 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv002.hs @@ -0,0 +1,11 @@ +data Z a b + = C1 (T a) + | C2 (Z [a] [b]) + deriving Text + +data T a + = E1 + +instance Eq a => Text (T a) where + showsPrec = error "show" + readsPrec = error "read" diff --git a/ghc/compiler/tests/deriving/drv002.stderr b/ghc/compiler/tests/deriving/drv002.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv002.stderr diff --git a/ghc/compiler/tests/deriving/drv003.hs b/ghc/compiler/tests/deriving/drv003.hs new file mode 100644 index 0000000000..3da22bd9d0 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv003.hs @@ -0,0 +1,15 @@ +--!!! This is the example given in TcDeriv +-- +data T a b + = C1 (Foo a) (Bar b) + | C2 Int (T b a) + | C3 (T a a) + deriving Eq + +data Foo a = MkFoo Double a deriving () +instance (Eq a) => Eq (Foo a) + +data Bar a = MkBar Int Int deriving () +instance (Ping b) => Eq (Bar b) + +class Ping a diff --git a/ghc/compiler/tests/deriving/drv003.stderr b/ghc/compiler/tests/deriving/drv003.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv003.stderr diff --git a/ghc/compiler/tests/deriving/drv004.hs b/ghc/compiler/tests/deriving/drv004.hs new file mode 100644 index 0000000000..9863e3ae3d --- /dev/null +++ b/ghc/compiler/tests/deriving/drv004.hs @@ -0,0 +1,6 @@ +--!!! simple example of deriving Ord (and, implicitly, Eq) +-- +data Foo a b + = C1 a Int + | C2 b Double + deriving Ord diff --git a/ghc/compiler/tests/deriving/drv004.stderr b/ghc/compiler/tests/deriving/drv004.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv004.stderr diff --git a/ghc/compiler/tests/deriving/drv005.hs b/ghc/compiler/tests/deriving/drv005.hs new file mode 100644 index 0000000000..cef5fe6a5b --- /dev/null +++ b/ghc/compiler/tests/deriving/drv005.hs @@ -0,0 +1,4 @@ +--!!! simple example of deriving Enum +-- +data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8 + deriving Enum diff --git a/ghc/compiler/tests/deriving/drv005.stderr b/ghc/compiler/tests/deriving/drv005.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv005.stderr diff --git a/ghc/compiler/tests/deriving/drv006.hs b/ghc/compiler/tests/deriving/drv006.hs new file mode 100644 index 0000000000..a6d6d1c645 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv006.hs @@ -0,0 +1,6 @@ +--!!! simple examples of deriving Ix +-- +data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8 + deriving Ix + +data Bar a b = MkBar a Int b Integer a diff --git a/ghc/compiler/tests/deriving/drv006.stderr b/ghc/compiler/tests/deriving/drv006.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv006.stderr diff --git a/ghc/compiler/tests/deriving/drv007.hs b/ghc/compiler/tests/deriving/drv007.hs new file mode 100644 index 0000000000..c1bbab1bae --- /dev/null +++ b/ghc/compiler/tests/deriving/drv007.hs @@ -0,0 +1,3 @@ +--!!! buggy deriving with function type, reported by Sigbjorn Finne + +data Foo = Foo (Int -> Int) deriving Eq diff --git a/ghc/compiler/tests/deriving/drv007.stderr b/ghc/compiler/tests/deriving/drv007.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/deriving/drv007.stderr diff --git a/ghc/compiler/tests/printing/Jmakefile b/ghc/compiler/tests/printing/Jmakefile new file mode 100644 index 0000000000..86b4238a93 --- /dev/null +++ b/ghc/compiler/tests/printing/Jmakefile @@ -0,0 +1,9 @@ +runtests:: + @echo '###############################################################' + @echo '# Tests of printing facilities in the compiler. #' + @echo '###############################################################' + +RunStdTest(print001,$(GHC), -noC -hi Print001.hs -o2 Print001.stderr) +RunStdTest(print002,$(GHC), -noC -fno-implicit-prelude -dppr-user -ddump-rif2hs -ddump-tc -hi Print002.hs -o2 Print002.stderr) +RunStdTest(print003,$(GHC), -noC -hi Print003.hs -o2 Print003.stderr) +RunStdTest(print004,$(GHC), -noC -hi Print004.hs -o2 Print004.stderr) diff --git a/ghc/compiler/tests/printing/Print001.hs b/ghc/compiler/tests/printing/Print001.hs new file mode 100644 index 0000000000..efe63d4a91 --- /dev/null +++ b/ghc/compiler/tests/printing/Print001.hs @@ -0,0 +1,18 @@ +--!!! Print001.hs: printing of types (esp for interfaces) + +module Print001 where + +data Foo d e f = MkFoo [((d->Int)->d)->e] (d->e, e->e) () +data Bar a = BarNil + | BarCon (Foo a a a) (Bar a) + +mkFoo = MkFoo + +f :: Eq a => (a -> b -> c) -> (a -> b -> c) +f x = x + +f2 :: (Eq a, Ord a, Ix c) => (a -> b -> c) -> (a -> b -> c) +f2 x = x + +g :: Foo Int (a -> b) (a -> [(a, Double, Int)]) -> Float +g x = 2.0 diff --git a/ghc/compiler/tests/printing/Print001.stderr b/ghc/compiler/tests/printing/Print001.stderr new file mode 100644 index 0000000000..2cf5b134f6 --- /dev/null +++ b/ghc/compiler/tests/printing/Print001.stderr @@ -0,0 +1,10 @@ +=-=-=-=-=INTERFACE STARTS HERE=-=-=-=-= Print001 +interface Print001 where +f :: Eq a => (a -> b -> c) -> a -> b -> c {-# ARITY _ = 2 #-} +f2 :: (Eq a, Ord a, Ix c) => (a -> b -> c) -> a -> b -> c {-# ARITY _ = 4 #-} +g :: Foo Int (b -> a) (b -> [(b, Double, Int)]) -> Float {-# ARITY _ = 1 #-} +mkFoo :: [((a -> Int) -> a) -> b] -> (a -> b, b -> b) -> () -> Foo a b c {-# ARITY _ = 3 #-} +data Bar a = BarNil | BarCon (Foo a a a) (Bar a) +data Foo a b c = MkFoo [((a -> Int) -> a) -> b] (a -> b, b -> b) () +=-=-=-=-=INTERFACE STOPS HERE=-=-=-=-= + diff --git a/ghc/compiler/tests/printing/Print002.hs b/ghc/compiler/tests/printing/Print002.hs new file mode 100644 index 0000000000..458170a612 --- /dev/null +++ b/ghc/compiler/tests/printing/Print002.hs @@ -0,0 +1,40 @@ +--!!! Print002.hs: printing various entities in prefix/infix forms +--!!! (both in various syntaxes & in interfaces) + +module Print002 where + +-- type & data constructors + +data Foo a b c + = MkFoo1 a a + | (:##) b c + | b `MkFoo3` b + | c :*** c + deriving (Eq, Ord) + +-- classes and methods + +class Bar a where + meth1, (/////) :: a -> a -> Bool + meth2 :: a -> b -> Bool + +class (Bar a) => Bar2 a -- no methods + +-- regular values (and uses of the above) + +f1 x y = x `MkFoo1` y +x `f1a` y = MkFoo1 x y + +x `f2` y = (:##) x y +f2a x y = x :## y + +(....) x y = MkFoo3 x y +x ..... y = x `MkFoo3` y + +x <<<< y = x :*** y +(<<<<) x y = (:***) x y + +f3a x y = meth1 x y +f3b x y = x `meth1` y +f3c x y = (/////) x y +f3d x y = x ///// y diff --git a/ghc/compiler/tests/printing/Print002.stderr b/ghc/compiler/tests/printing/Print002.stderr new file mode 100644 index 0000000000..fac05efed5 --- /dev/null +++ b/ghc/compiler/tests/printing/Print002.stderr @@ -0,0 +1,272 @@ +Parsed, Haskellised: +module Print002 where +infixr 9 . +infixr 8 ^ +infixr 8 ^^ +infixr 3 && +infixr 2 || +infixr 0 $ +infixl 9 ! +infixl 9 // +infix 1 := +infix 6 :+ +infixr 8 ** +infixl 7 * +infixl 7 / +infixl 7 `quot` +infixl 7 `rem` +infixl 7 `div` +infixl 7 `mod` +infixl 6 + +infixl 6 - +infix 4 == +infix 4 /= +infix 4 < +infix 4 <= +infix 4 >= +infix 4 > +infixl 9 !! +infix 5 \\ +infix 4 `elem` +infix 4 `notElem` +infixl 7 % +data Foo a b c + = MkFoo1 a a + | (:##) b c + | MkFoo3 b b + | (:***) c c + deriving (Eq, Ord) +class Bar a where + meth1 :: a -> a -> Bool + ///// :: a -> a -> Bool + meth2 :: a -> b -> Bool +class Bar a => Bar2 a where +f1 x y = x `MkFoo1` y +f1a x y = MkFoo1 x y +f2 x y = (:##) x y +f2a x y = x :## y +(....) + x y = MkFoo3 x y +(.....) + x y = x `MkFoo3` y +(<<<<) + x y = x :*** y +(<<<<) + x y = (:***) x y +f3a x y = meth1 x y +f3b x y = x `meth1` y +f3c x y = (/////) x y +f3d x y = x ///// y + +Typechecked: +meth1 = meth1 +(/////) = (/////) +meth2 = meth2 +defm.Print002.Bar.meth1 = + (error) "No default method for \"Print002.Bar.defm.Print002.Bar.meth1\"\n" +defm.Print002.Bar.///// = + (error) "No default method for \"Print002.Bar.defm.Print002.Bar./////\"\n" +defm.Print002.Bar.meth2 = + (error) "No default method for \"Print002.Bar.defm.Print002.Bar.meth2\"\n" +sdsel.Print002.Bar2.Print002.Bar = d.Print002.Bar.t443 +AbsBinds +[a, b, c] +[d.Eq.t192, d.Eq.t193, d.Eq.t194] +[(d.Eq.t195, dfun.Eq.Print002.Foo)] + (d.Eq.t268, d.Eq.t192) + (==.t212, (==)) + (==.t209, (==.t212)) + (d.Eq.t269, d.Eq.t194) + (==.t229, (==)) + (d.Eq.t270, d.Eq.t193) + (==.t226, (==)) + (==.t246, (==.t226)) + (==.t243, (==.t226)) + (==.t263, (==.t229)) + (==.t260, (==.t229)) + d.Eq.t195 = ({-dict-} [] [==, /=]) + (==) :: Foo a b c -> Foo a b c -> Bool + (==) (MkFoo1 a1 a2) (MkFoo1 b1 b2) + = (a1 ==.t209 b1) && (a2 ==.t212 b2) + (==) (:## a1 a2) (:## b1 b2) + = (a1 ==.t226 b1) && (a2 ==.t229 b2) + (==) (MkFoo3 a1 a2) (MkFoo3 b1 b2) + = (a1 ==.t243 b1) && (a2 ==.t246 b2) + (==) (:*** a1 a2) (:*** b1 b2) + = (a1 ==.t260 b1) && (a2 ==.t263 b2) + (==) a b = False + (/=) = defm./= +AbsBinds +[a, b, c] +[d.Ord.t275, d.Ord.t276, d.Ord.t277, d.Eq.t274] +[(d.Ord.t278, dfun.Ord.Print002.Foo)] + (d.Ord.t425, d.Ord.t278) + (cmp3.t290, cmp3) + (cmp3.t295, cmp3.t290) + (cmp3.t300, cmp3.t290) + (cmp3.t305, cmp3.t290) + (d.Ord.t426, d.Ord.t425) + (cmp3.t310, cmp3) + (cmp3.t315, cmp3.t310) + (d.Ord.t422, d.Ord.t275) + (d.Ord.t423, d.Ord.t276) + (d.Ord.t424, d.Ord.t277) + d.Ord.t278 = ({-dict-} [d.Eq.t274] [<, <=, >=, >, max, min, cmp3]) + (<) :: Foo a b c -> Foo a b c -> Bool + (<) a b = cmp3.t290 True False False a b + (<=) :: Foo a b c -> Foo a b c -> Bool + (<=) a b = cmp3.t295 True True False a b + (>=) :: Foo a b c -> Foo a b c -> Bool + (>=) a b = cmp3.t300 False True True a b + (>) :: Foo a b c -> Foo a b c -> Bool + (>) a b = cmp3.t305 False False True a b + max :: Foo a b c -> Foo a b c -> Foo a b c + max a b = cmp3.t310 b a a a b + min :: Foo a b c -> Foo a b c -> Foo a b c + min a b = cmp3.t315 a a b a b + cmp3 = + let + AbsBinds [tt316] [] [(cmp3, cmp3)] + cmp3 :: tt316 -> tt316 -> tt316 -> Foo a b c -> Foo a b c -> tt316 + cmp3 lt eq gt a b + = case (con2tag.Foo) a of + a# -> case (con2tag.Foo) b of + b# -> if a# `eqInt` b# then + if a# `ltInt` b# then + lt + else + gt + else + cmp3eq.t48.t419 lt eq gt a b + where + AbsBinds + [a, b, c, tt400] + [d.Ord.t402, d.Ord.t404, d.Ord.t403] + [(cmp3eq, cmp3eq)] + (cmp3.t344, cmp3) + (cmp3.t341, cmp3.t344) + (cmp3.t363, cmp3) + (cmp3.t360, cmp3) + (cmp3.t382, cmp3.t360) + (cmp3.t379, cmp3.t360) + (cmp3.t401, cmp3.t363) + (cmp3.t398, cmp3.t363) + cmp3eq :: + tt400 + -> tt400 + -> tt400 + -> Foo a b c -> Foo a b c -> tt400 + cmp3eq + lt eq gt (MkFoo1 a1 a2) (MkFoo1 b1 b2) + = cmp3.t341 + lt + (cmp3.t344 lt eq gt a2 b2) + gt + a1 + b1 + cmp3eq + lt eq gt (:## a1 a2) (:## b1 b2) + = cmp3.t360 + lt + (cmp3.t363 lt eq gt a2 b2) + gt + a1 + b1 + cmp3eq + lt eq gt (MkFoo3 a1 a2) (MkFoo3 b1 b2) + = cmp3.t379 + lt + (cmp3.t382 lt eq gt a2 b2) + gt + a1 + b1 + cmp3eq + lt eq gt (:*** a1 a2) (:*** b1 b2) + = cmp3.t398 + lt + (cmp3.t401 lt eq gt a2 b2) + gt + a1 + b1 + cmp3eq.t48.t419 = cmp3eq + in cmp3 +AbsBinds [a, b, c] [] [(f1, f1)] + f1 :: a -> a -> Foo a b c + f1 x y = (MkFoo1) x y +AbsBinds [a, b, c] [] [(f1a, f1a)] + f1a :: a -> a -> Foo a b c + f1a x y = (MkFoo1) x y +AbsBinds [a, b, c] [] [(f2, f2)] + f2 :: b -> c -> Foo a b c + f2 x y = ((:##)) x y +AbsBinds [a, b, c] [] [(f2a, f2a)] + f2a :: b -> c -> Foo a b c + f2a x y = ((:##)) x y +AbsBinds [a, b, c] [] [(...., ....)] + (....) :: b -> b -> Foo a b c + (....) + x y = (MkFoo3) x y +AbsBinds [a, b, c] [] [(....., .....)] + (.....) :: b -> b -> Foo a b c + (.....) + x y = (MkFoo3) x y +AbsBinds [a, b, c] [] [(<<<<, <<<<)] + (<<<<) :: c -> c -> Foo a b c + (<<<<) + x y = ((:***)) x y + (<<<<) + x y = ((:***)) x y +AbsBinds [a] [d.Print002.Bar.t143] [(f3a, f3a)] + (Print002.Bar.meth1.t142, meth1) + f3a :: a -> a -> Bool + f3a x y = Print002.Bar.meth1.t142 x y +AbsBinds [a] [d.Print002.Bar.t151] [(f3b, f3b)] + (Print002.Bar.meth1.t149, meth1) + f3b :: a -> a -> Bool + f3b x y = x `Print002.Bar.meth1.t149` y +AbsBinds [a] [d.Print002.Bar.t158] [(f3c, f3c)] + (Print002.Bar./////.t157, (/////)) + f3c :: a -> a -> Bool + f3c x y = Print002.Bar./////.t157 x y +AbsBinds [a] [d.Print002.Bar.t166] [(f3d, f3d)] + (Print002.Bar./////.t164, (/////)) + f3d :: a -> a -> Bool + f3d x y = x `Print002.Bar./////.t164` y +AbsBinds [a, b, c] [] [(con2tag.Foo, con2tag.Foo)] + con2tag.Foo :: Foo a b c -> IntPrim + con2tag.Foo + (MkFoo1 _ _) + = 0# + con2tag.Foo + (:## _ _) + = 1# + con2tag.Foo + (MkFoo3 _ _) + = 2# + con2tag.Foo + (:*** _ _) + = 3# + +=-=-=-=-=INTERFACE STARTS HERE=-=-=-=-= Print002 +interface Print002 where +(....) :: b -> b -> Foo a b c {-# ARITY _ = 2 #-} +(.....) :: b -> b -> Foo a b c {-# ARITY _ = 2 #-} +(<<<<) :: c -> c -> Foo a b c {-# ARITY _ = 2 #-} +f1 :: a -> a -> Foo a b c {-# ARITY _ = 2 #-} +f1a :: a -> a -> Foo a b c {-# ARITY _ = 2 #-} +f2 :: b -> c -> Foo a b c {-# ARITY _ = 2 #-} +f2a :: b -> c -> Foo a b c {-# ARITY _ = 2 #-} +f3a :: Bar a => a -> a -> Bool {-# ARITY _ = 1 #-} +f3b :: Bar a => a -> a -> Bool {-# ARITY _ = 1 #-} +f3c :: Bar a => a -> a -> Bool {-# ARITY _ = 1 #-} +f3d :: Bar a => a -> a -> Bool {-# ARITY _ = 1 #-} +class Bar a where + meth1 :: a -> a -> Bool + (/////) :: a -> a -> Bool + meth2 :: a -> b -> Bool +class (Bar a) => Bar2 a +data Foo a b c = MkFoo1 a a | (:##) b c | MkFoo3 b b | (:***) c c +instance (Eq a, Eq b, Eq c) => Eq (Foo a b c) +instance (Ord a, Ord b, Ord c) => Ord (Foo a b c) +=-=-=-=-=INTERFACE STOPS HERE=-=-=-=-= + diff --git a/ghc/compiler/tests/printing/Print003.hs b/ghc/compiler/tests/printing/Print003.hs new file mode 100644 index 0000000000..e95bd0c78b --- /dev/null +++ b/ghc/compiler/tests/printing/Print003.hs @@ -0,0 +1,6 @@ +module Word where + +infixl 8 `bitLsh`, `bitRsh` + +class Bits a where + bitRsh, bitLsh :: a -> Int -> a diff --git a/ghc/compiler/tests/printing/Print003.stderr b/ghc/compiler/tests/printing/Print003.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/printing/Print003.stderr diff --git a/ghc/compiler/tests/printing/Print004.hs b/ghc/compiler/tests/printing/Print004.hs new file mode 100644 index 0000000000..2ea3a20737 --- /dev/null +++ b/ghc/compiler/tests/printing/Print004.hs @@ -0,0 +1,18 @@ +--!!! export a derived thingy which mentions an internal type +-- +{- from simonpj; who adds: + + It is NOT ENOUGH to put + + data OpaqueType deriving(Text) + + in the interface +-} + +module ExportOpaque( OpaqueType ) where + +data OpaqueType a = Con (FunnyInternalType a) deriving(Text) + +data FunnyInternalType a = Junk11 | Junk2 + +instance Ord a => Text (FunnyInternalType a) diff --git a/ghc/compiler/tests/printing/Print004.stderr b/ghc/compiler/tests/printing/Print004.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/printing/Print004.stderr diff --git a/ghc/compiler/tests/reader/Jmakefile b/ghc/compiler/tests/reader/Jmakefile new file mode 100644 index 0000000000..60e7f91282 --- /dev/null +++ b/ghc/compiler/tests/reader/Jmakefile @@ -0,0 +1,9 @@ +runtests:: + @echo '###############################################################' + @echo '# Validation tests for the reader in the compiler. #' + @echo '###############################################################' + +RunStdTest(read001,$(GHC), -noC -ddump-rif2hs read001.hs -o2 read001.stderr) +RunStdTest(read002,$(GHC), -noC -ddump-rif2hs read002.hs -o2 read002.stderr) +/* gap 003 */ +RunStdTest(read004,$(GHC), -noC -fno-implicit-prelude -ddump-rif2hs read004.hs -o2 read004.stderr) diff --git a/ghc/compiler/tests/reader/OneA.hi b/ghc/compiler/tests/reader/OneA.hi new file mode 100644 index 0000000000..42ed194929 --- /dev/null +++ b/ghc/compiler/tests/reader/OneA.hi @@ -0,0 +1,15 @@ +interface OneA where + +import OneB ( fB ) renaming ( fB to fBa ) + +type SynA = Float + +data DataAA +data (Ord a) => DataAB a = ConAB1 a | ConAB2 deriving Text + +class (Ord a) => ClassA a where + clsA :: a -> String + +instance ClassA Int + +fA :: a -> a diff --git a/ghc/compiler/tests/reader/OneB.hi b/ghc/compiler/tests/reader/OneB.hi new file mode 100644 index 0000000000..78f55eee16 --- /dev/null +++ b/ghc/compiler/tests/reader/OneB.hi @@ -0,0 +1,3 @@ +interface OneB where + +fB :: a -> a diff --git a/ghc/compiler/tests/reader/OneC.hi b/ghc/compiler/tests/reader/OneC.hi new file mode 100644 index 0000000000..ded63ccf9e --- /dev/null +++ b/ghc/compiler/tests/reader/OneC.hi @@ -0,0 +1,3 @@ +interface OneC where + +fC :: a -> a diff --git a/ghc/compiler/tests/reader/expr001.hs b/ghc/compiler/tests/reader/expr001.hs new file mode 100644 index 0000000000..49853a74cf --- /dev/null +++ b/ghc/compiler/tests/reader/expr001.hs @@ -0,0 +1,14 @@ +{- +From: Kevin Hammond <kh> +To: partain +Subject: Re: parsing problem w/ queens +Date: Wed, 9 Oct 91 17:31:46 BST + +OK, I've fixed that little problem by disallowing, +-} + +f x = x + if c then 1 else 2 +f x = x + 1::Int + +-- (the conditional/sig need to be parenthesised). If this is +-- problematic, let me know! diff --git a/ghc/compiler/tests/reader/read001.hs b/ghc/compiler/tests/reader/read001.hs new file mode 100644 index 0000000000..4a97768a78 --- /dev/null +++ b/ghc/compiler/tests/reader/read001.hs @@ -0,0 +1,113 @@ +-- this module supposedly includes one of each Haskell construct + +-- HsImpExp stuff + +module OneOfEverything ( + fixn, + FooData, + FooDataB(..), + FooDataC( .. ), + EqTree(EqLeaf, EqBranch), + EqClass(..), + OrdClass(orda, ordb), + OneC.. , + OneOfEverything.. + ) where + +import OneA renaming ( fA to renamedA ) +import OneB ( fB ) +import OneC hiding ( fC ) +import OneC hiding ( fC ) renaming ( fc to renamedC ) + +-- HsDecls stuff + +infix 6 `fixn` +infixl 7 +# +infixr 8 `fixr` + +fixn x y = x +fixl x y = x +fixr x y = x + +type Pair a b = (a, b) + +data FooData = FooCon Int + +data FooDataB = FooConB Double + +data (Eq a) => EqTree a = EqLeaf a | EqBranch (EqLeaf a) (EqLeaf a) + +class (Eq a) => EqClass a where + eqc :: a -> Char + eqc x = '?' + +class (Ord a) => OrdClass a where + orda :: a -> Char + ordb :: a -> Char + ordc :: a -> Char + +instance (Eq a) => EqClass (EqTree a) where + eqc x = 'a' + +default (Integer, Rational) + +-- HsBinds stuff + +singlebind x = x + +bindwith :: (OrdClass a, OrdClass b) => a -> b -> b +bindwith a b = b + +reca a = recb a +recb a = reca a + +(~(a,b,c)) | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null + +-- HsMatches stuff + +mat a b c d | foof a b = d + | foof a c = d + | foof b c = d + where + foof a b = a == b + +-- HsExpr stuff +expr a b c d + = a + + (:) a b + + (a : b) + + (1 - 'c' - "abc" - 1.293) + + ( \ x y z -> x ) 42 + + (9 *) + + (* 8) + + (case x of + [] | null x -> 99 + | otherwise -> 98 + | True -> 97 + where + null x = False + ) + + [ z | z <- c, isSpace z ] + + let y = foo + in y + + [1,2,3,4] + + (4,3,2,1) + + (4 :: Num a => a) + + (if 42 == 42.0 then 1 else 4) + + [1..] + + [2,4..] + + [3..5] + + [4,8..999] + +-- HsPat stuff +f _ x 1 1.93 'c' "dog" ~y z@(Foo a b) (c `Bar` d) [1,2] (3,4) (n+42) = y + +-- HsLit stuff -- done above + +-- HsTypes stuff +g :: (Num a, Eq b) => Foo a -> [b] -> (a,a,a) -> b +g x y z = head y diff --git a/ghc/compiler/tests/reader/read001.stderr b/ghc/compiler/tests/reader/read001.stderr new file mode 100644 index 0000000000..997116b7a5 --- /dev/null +++ b/ghc/compiler/tests/reader/read001.stderr @@ -0,0 +1,593 @@ +Parsed, Haskellised: +module OneOfEverything ( + fixn, + FooData, + FooDataB(..), + FooDataC(..), + EqTree(EqLeaf, EqBranch), + EqClass(..), + OrdClass(orda, ordb), + OneC.., + OneOfEverything.. + ) where +import Prelude {- + interface Prelude where + import PreludeBuiltin ( trace, Char ) + import PreludeCore ( Bool, String, ReadS, ShowS, Text ) + import PreludeRatio ( + %, numerator, denominator, approxRational ) + import PreludeComplex ( + realPart, + imagPart, + conjugate, + mkPolar, + cis, + polar, + magnitude, + phase ) + import PreludeList ( + head, + last, + tail, + init, + null, + \\, + genericLength, + length, + !!, + filter, + partition, + foldl1, + scanl, + scanl1, + foldr1, + scanr, + scanr1, + iterate, + repeat, + cycle, + take, + drop, + splitAt, + takeWhile, + dropWhile, + span, + break, + lines, + words, + unlines, + unwords, + nub, + reverse, + and, + or, + any, + all, + elem, + notElem, + sum, + product, + sums, + products, + maximum, + minimum, + concat, + transpose, + zip, + zip3, + zip4, + zip5, + zip6, + zip7, + zipWith, + zipWith3, + zipWith4, + zipWith5, + zipWith6, + zipWith7, + unzip, + unzip3, + unzip4, + unzip5, + unzip6, + unzip7 ) + import PreludeArray ( + array, + listArray, + !, + bounds, + indices, + elems, + assocs, + accumArray, + //, + accum, + amap, + ixmap ) + import PreludeText ( + reads, + shows, + show, + read, + showChar, + readLitChar, + showLitChar, + readSigned, + showSigned, + readDec, + showInt, + readFloat, + showFloat ) + import PreludeIO ( + stdin, + stdout, + stderr, + stdecho, + done, + readFile, + writeFile, + appendFile, + readBinFile, + writeBinFile, + appendBinFile, + deleteFile, + statusFile, + readChan, + appendChan, + readBinChan, + appendBinChan, + statusChan, + echo, + getArgs, + getProgName, + getEnv, + setEnv, + abort, + exit, + print, + prints, + interact ) + instance (Eq a, Eq b) => Eq (a, b) + instance (Ord a, Ord b) => Ord (a, b) + instance (Ix a, Ix b) => Ix (a, b) + instance (Text a, Text b) => Text (a, b) + instance (Binary a, Binary b) => Binary (a, b) + instance (Eq a, Eq b, Eq c) => Eq (a, b, c) + instance (Ord a, Ord b, Ord c) => Ord (a, b, c) + instance (Ix a, Ix b, Ix c) => Ix (a, b, c) + instance (Text a, Text b, Text c) => Text (a, b, c) + instance (Binary a, Binary b, Binary c) => Binary (a, b, c) + instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) + instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) + instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) + instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) + instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, + b, + c, + d) + ^ :: (Num b, Integral a) => b -> a -> b + ^^ :: (Fractional b, Integral a) => b -> a -> b + appendBin :: Bin -> Bin -> Bin + asTypeOf :: a -> a -> a + atan2 :: RealFloat a => a -> a -> a + chr :: Int -> Char + fromIntegral :: (Integral a, Num b) => a -> b + fromRealFrac :: (RealFrac a, Fractional b) => a -> b + gcd :: Integral a => a -> a -> a + isAlpha :: Char -> Bool + isAlphanum :: Char -> Bool + isAscii :: Char -> Bool + isControl :: Char -> Bool + isDigit :: Char -> Bool + isLower :: Char -> Bool + isNullBin :: Bin -> Bool + isPrint :: Char -> Bool + isSpace :: Char -> Bool + isUpper :: Char -> Bool + lcm :: Integral a => a -> a -> a + maxChar :: Char + maxInt :: Int + minChar :: Char + minInt :: Int + nullBin :: Bin + ord :: Char -> Int + subtract :: Num a => a -> a -> a + toLower :: Char -> Char + toUpper :: Char -> Char + until :: (a -> Bool) -> (a -> a) -> a -> a + trace :: String -> a -> a + % :: Integral a => a -> a -> Ratio a + numerator :: Integral a => Ratio a -> a + denominator :: Integral a => Ratio a -> a + approxRational :: RealFrac a => a -> a -> Rational + cis :: RealFloat a => a -> Complex a + conjugate :: RealFloat a => Complex a -> Complex a + imagPart :: RealFloat a => Complex a -> a + magnitude :: RealFloat a => Complex a -> a + mkPolar :: RealFloat a => a -> a -> Complex a + phase :: RealFloat a => Complex a -> a + polar :: RealFloat a => Complex a -> (a, a) + realPart :: RealFloat a => Complex a -> a + !! :: Integral a => [b] -> a -> b + \\ :: Eq a => [a] -> [a] -> [a] + all :: (a -> Bool) -> [a] -> Bool + and :: [Bool] -> Bool + any :: (a -> Bool) -> [a] -> Bool + break :: (a -> Bool) -> [a] -> ([a], [a]) + concat :: [[a]] -> [a] + cycle :: [a] -> [a] + drop :: Integral a => a -> [b] -> [b] + dropWhile :: (a -> Bool) -> [a] -> [a] + elem :: Eq a => a -> [a] -> Bool + filter :: (a -> Bool) -> [a] -> [a] + foldl1 :: (a -> a -> a) -> [a] -> a + foldr1 :: (a -> a -> a) -> [a] -> a + genericLength :: Num b => [a] -> b + head :: [a] -> a + init :: [a] -> [a] + iterate :: (a -> a) -> a -> [a] + last :: [a] -> a + length :: [a] -> Int + lines :: [Char] -> [[Char]] + maximum :: Ord a => [a] -> a + minimum :: Ord a => [a] -> a + notElem :: Eq a => a -> [a] -> Bool + nub :: Eq a => [a] -> [a] + null :: [a] -> Bool + or :: [Bool] -> Bool + partition :: (a -> Bool) -> [a] -> ([a], [a]) + product :: Num a => [a] -> a + products :: Num a => [a] -> [a] + repeat :: a -> [a] + reverse :: [a] -> [a] + scanl :: (b -> a -> b) -> b -> [a] -> [b] + scanl1 :: (a -> a -> a) -> [a] -> [a] + scanr :: (a -> b -> b) -> b -> [a] -> [b] + scanr1 :: (a -> a -> a) -> [a] -> [a] + span :: (a -> Bool) -> [a] -> ([a], [a]) + splitAt :: Integral a => a -> [b] -> ([b], [b]) + sum :: Num a => [a] -> a + sums :: Num a => [a] -> [a] + tail :: [a] -> [a] + take :: Integral a => a -> [b] -> [b] + takeWhile :: (a -> Bool) -> [a] -> [a] + transpose :: [[a]] -> [[a]] + unlines :: [[Char]] -> [Char] + unwords :: [[Char]] -> [Char] + unzip :: [(a, b)] -> ([a], [b]) + unzip3 :: [(a, b, c)] -> ([a], [b], [c]) + unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d]) + unzip5 :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e]) + unzip6 :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f]) + unzip7 :: + [(a, b, c, d, e, f, g)] + -> ([a], [b], [c], [d], [e], [f], [g]) + words :: [Char] -> [[Char]] + zip :: [a] -> [b] -> [(a, b)] + zip3 :: [a] -> [b] -> [c] -> [(a, b, c)] + zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)] + zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)] + zip6 :: + [a] + -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)] + zip7 :: + [a] + -> [b] + -> [c] + -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)] + zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] + zipWith4 :: + (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e] + zipWith5 :: + (a -> b -> c -> d -> e -> f) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] + zipWith6 :: + (a -> b -> c -> d -> e -> f -> g) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] + zipWith7 :: + (a -> b -> c -> d -> e -> f -> g -> h) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h] + ! :: Ix a => Array a b -> a -> b + // :: Ix a => Array a b -> [Assoc a b] -> Array a b + accum :: + Ix b => (c -> a -> c) + -> Array b c -> [Assoc b a] -> Array b c + accumArray :: + Ix b => (c -> a -> c) + -> c -> (b, b) -> [Assoc b a] -> Array b c + amap :: Ix b => (a -> c) -> Array b a -> Array b c + array :: Ix a => (a, a) -> [Assoc a b] -> Array a b + assocs :: Ix a => Array a b -> [Assoc a b] + bounds :: Ix b => Array b a -> (b, b) + elems :: Ix a => Array a b -> [b] + indices :: Ix b => Array b a -> [b] + ixmap :: + (Ix b, Ix a) => (b, b) -> (b -> a) -> Array a c -> Array b c + listArray :: Ix a => (a, a) -> [b] -> Array a b + read :: Text a => [Char] -> a + readDec :: Integral a => [Char] -> [(a, [Char])] + readFloat :: RealFloat a => [Char] -> [(a, [Char])] + readLitChar :: [Char] -> [(Char, [Char])] + readSigned :: + Real a => ([Char] -> [(a, [Char])]) + -> [Char] -> [(a, [Char])] + reads :: Text a => [Char] -> [(a, [Char])] + show :: Text a => a -> [Char] + showChar :: Char -> [Char] -> [Char] + showFloat :: RealFloat a => a -> [Char] -> [Char] + showInt :: Integral a => a -> [Char] -> [Char] + showLitChar :: Char -> [Char] -> [Char] + showSigned :: + Real a => (a -> [Char] -> [Char]) + -> Int -> a -> [Char] -> [Char] + shows :: Text a => a -> [Char] -> [Char] + abort :: IOError -> [Response] -> [Request] + appendBinChan :: + [Char] + -> Bin + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + appendBinFile :: + [Char] + -> Bin + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + appendChan :: + [Char] + -> [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + appendFile :: + [Char] + -> [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + binDispatch :: + (IOError -> [Response] -> a) + -> (Bin -> [Response] -> a) -> [Response] -> a + deleteFile :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + done :: [Response] -> [Request] + echo :: + Bool + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + exit :: IOError -> [Response] -> [Request] + getArgs :: + (IOError -> [Response] -> [Request]) + -> ([[Char]] -> [Response] -> [Request]) + -> [Response] -> [Request] + getEnv :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + getProgName :: + (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + interact :: ([Char] -> [Char]) -> [Response] -> [Request] + print :: Text a => a -> [Response] -> [Request] + prints :: Text a => a -> [Char] -> [Response] -> [Request] + readBinChan :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> (Bin -> [Response] -> [Request]) + -> [Response] -> [Request] + readBinFile :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> (Bin -> [Response] -> [Request]) + -> [Response] -> [Request] + readChan :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + readFile :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + setEnv :: + [Char] + -> [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + statusChan :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + statusFile :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + stdecho :: [Char] + stderr :: [Char] + stdin :: [Char] + stdout :: [Char] + strDispatch :: + (IOError -> [Response] -> a) + -> ([Char] -> [Response] -> a) -> [Response] -> a + strListDispatch :: + (IOError -> [Response] -> a) + -> ([[Char]] -> [Response] -> a) -> [Response] -> a + succDispatch :: + (IOError -> [Response] -> a) + -> ([Response] -> a) -> [Response] -> a + writeBinFile :: + [Char] + -> Bin + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + writeFile :: + [Char] + -> [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + -} +import OneA {- + interface OneA where + import OneB ( fB ) renaming (fB to fBa) + type SynA = Float + data DataAA + data Ord a => DataAB a + = ConAB1 a + | ConAB2 + deriving (Text) + class Ord a => ClassA a where + clsA :: a -> String + instance ClassA Int + fA :: a -> a + -} +renaming (fA to renamedA) +import OneB {- + interface OneB where + fB :: a -> a + -} + (fB) +import OneC {- + interface OneC where + fC :: a -> a + -} + hiding (fC) +import OneC {- + interface OneC where + fC :: a -> a + -} + hiding (fC) +renaming (fc to renamedC) +infixr 9 . +infixr 8 ^ +infixr 8 ^^ +infixr 3 && +infixr 2 || +infixr 0 $ +infixl 9 ! +infixl 9 // +infix 1 := +infix 6 :+ +infixr 8 ** +infixl 7 * +infixl 7 / +infixl 7 `quot` +infixl 7 `rem` +infixl 7 `div` +infixl 7 `mod` +infixl 6 + +infixl 6 - +infix 4 == +infix 4 /= +infix 4 < +infix 4 <= +infix 4 >= +infix 4 > +infixl 9 !! +infix 5 \\ +infix 4 `elem` +infix 4 `notElem` +infixl 7 % +infix 6 `fixn` +infixl 7 +# +infixr 8 `fixr` +type Pair a b = (a, b) +data FooData + = FooCon Int +data FooDataB + = FooConB Double +data Eq a => EqTree a + = EqLeaf a + | EqBranch (EqLeaf a) (EqLeaf a) +class Eq a => EqClass a where + eqc :: a -> Char + eqc x = '?' +class Ord a => OrdClass a where + orda :: a -> Char + ordb :: a -> Char + ordc :: a -> Char +instance Eq a => EqClass EqTree a where + eqc x = 'a' +default (Integer, Rational) +bindwith :: (OrdClass a, OrdClass b) => a -> b -> b +g :: (Num a, Eq b) => Foo a -> [b] -> (a, a, a) -> b +{- rec -} +fixn x y = x +fixl x y = x +fixr x y = x +singlebind + x = x +bindwith + a b = b +reca a = recb a +recb a = reca a +~(a, b, c) + | nullity b = a + | nullity c = a + | otherwise = a + where + {- rec -} + nullity = null +mat a b c d | foof a b = d + | foof a c = d + | foof b c = d + where + {- rec -} + foof a b = a == b +expr a b c d = ((((((((a + ((:) a b)) + (a : b)) + + (((1 - 'c') - "abc") - 1.2929999999999999)) + + ((\ x y z -> x) 42)) + + ((9 *))) + + ((* 8))) + + (case x of + [] | null x -> 99 + | otherwise -> 98 + | True -> 97 + where + {- rec -} + null x = False)) + + ([ z | z <- c, isSpace z ])) + + (let + {- rec -} + y = foo + in (((((((y + ([1, 2, 3, 4])) + ((4, 3, 2, 1))) + + ((4 :: Num a => a))) + + (if 42 == 42.000000000000000 then 1 else 4)) + + ([ 1 .. ])) + + ([ 2, 4 .. ])) + + ([ 3 .. 5 ])) + + ([ 4, 8 .. 999 ])) +f _ + x + 1 + 1.9299999999999999 + 'c' + "dog" + ~y + (z@(Foo a b)) + (c Bar d) + [1, 2] + (3, 4) + (n+42) = y +g x y z = head y + +Enter trace(0): +doRenamings:tossing them away +Exit trace(0) + +Unknown name in export list: FooDataC +"read001.hs", line 38: undefined type constructor: EqLeaf +"read001.hs", line 38: undefined type constructor: EqLeaf +"read001.hs", line 112: undefined type constructor: Foo +"read001.hs", line 95: undefined value: x +"read001.hs", line 95: undefined value: x +"read001.hs", line 95: undefined value: foo +"read001.hs", line 107: undefined value: Foo +"read001.hs", line 107: undefined value: Bar +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/reader/read002.hs b/ghc/compiler/tests/reader/read002.hs new file mode 100644 index 0000000000..9cc2153956 --- /dev/null +++ b/ghc/compiler/tests/reader/read002.hs @@ -0,0 +1,13 @@ +--!!! tests fixity reading and printing + +infixl 1 `f` +infixr 2 \\\ +infix 3 :==> +infix 4 `MkFoo` + +data Foo = MkFoo Int | Float :==> Double + +x `f` y = x + +(\\\) :: (Eq a) => [a] -> [a] -> [a] +(\\\) xs ys = xs diff --git a/ghc/compiler/tests/reader/read002.stderr b/ghc/compiler/tests/reader/read002.stderr new file mode 100644 index 0000000000..f8a86008aa --- /dev/null +++ b/ghc/compiler/tests/reader/read002.stderr @@ -0,0 +1,466 @@ +Parsed, Haskellised: +module Main where +import Prelude {- + interface Prelude where + import PreludeBuiltin ( trace, Char ) + import PreludeCore ( Bool, String, ReadS, ShowS, Text ) + import PreludeRatio ( + %, numerator, denominator, approxRational ) + import PreludeComplex ( + realPart, + imagPart, + conjugate, + mkPolar, + cis, + polar, + magnitude, + phase ) + import PreludeList ( + head, + last, + tail, + init, + null, + \\, + genericLength, + length, + !!, + filter, + partition, + foldl1, + scanl, + scanl1, + foldr1, + scanr, + scanr1, + iterate, + repeat, + cycle, + take, + drop, + splitAt, + takeWhile, + dropWhile, + span, + break, + lines, + words, + unlines, + unwords, + nub, + reverse, + and, + or, + any, + all, + elem, + notElem, + sum, + product, + sums, + products, + maximum, + minimum, + concat, + transpose, + zip, + zip3, + zip4, + zip5, + zip6, + zip7, + zipWith, + zipWith3, + zipWith4, + zipWith5, + zipWith6, + zipWith7, + unzip, + unzip3, + unzip4, + unzip5, + unzip6, + unzip7 ) + import PreludeArray ( + array, + listArray, + !, + bounds, + indices, + elems, + assocs, + accumArray, + //, + accum, + amap, + ixmap ) + import PreludeText ( + reads, + shows, + show, + read, + showChar, + readLitChar, + showLitChar, + readSigned, + showSigned, + readDec, + showInt, + readFloat, + showFloat ) + import PreludeIO ( + stdin, + stdout, + stderr, + stdecho, + done, + readFile, + writeFile, + appendFile, + readBinFile, + writeBinFile, + appendBinFile, + deleteFile, + statusFile, + readChan, + appendChan, + readBinChan, + appendBinChan, + statusChan, + echo, + getArgs, + getProgName, + getEnv, + setEnv, + abort, + exit, + print, + prints, + interact ) + instance (Eq a, Eq b) => Eq (a, b) + instance (Ord a, Ord b) => Ord (a, b) + instance (Ix a, Ix b) => Ix (a, b) + instance (Text a, Text b) => Text (a, b) + instance (Binary a, Binary b) => Binary (a, b) + instance (Eq a, Eq b, Eq c) => Eq (a, b, c) + instance (Ord a, Ord b, Ord c) => Ord (a, b, c) + instance (Ix a, Ix b, Ix c) => Ix (a, b, c) + instance (Text a, Text b, Text c) => Text (a, b, c) + instance (Binary a, Binary b, Binary c) => Binary (a, b, c) + instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) + instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) + instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) + instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) + instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, + b, + c, + d) + ^ :: (Num b, Integral a) => b -> a -> b + ^^ :: (Fractional b, Integral a) => b -> a -> b + appendBin :: Bin -> Bin -> Bin + asTypeOf :: a -> a -> a + atan2 :: RealFloat a => a -> a -> a + chr :: Int -> Char + fromIntegral :: (Integral a, Num b) => a -> b + fromRealFrac :: (RealFrac a, Fractional b) => a -> b + gcd :: Integral a => a -> a -> a + isAlpha :: Char -> Bool + isAlphanum :: Char -> Bool + isAscii :: Char -> Bool + isControl :: Char -> Bool + isDigit :: Char -> Bool + isLower :: Char -> Bool + isNullBin :: Bin -> Bool + isPrint :: Char -> Bool + isSpace :: Char -> Bool + isUpper :: Char -> Bool + lcm :: Integral a => a -> a -> a + maxChar :: Char + maxInt :: Int + minChar :: Char + minInt :: Int + nullBin :: Bin + ord :: Char -> Int + subtract :: Num a => a -> a -> a + toLower :: Char -> Char + toUpper :: Char -> Char + until :: (a -> Bool) -> (a -> a) -> a -> a + trace :: String -> a -> a + % :: Integral a => a -> a -> Ratio a + numerator :: Integral a => Ratio a -> a + denominator :: Integral a => Ratio a -> a + approxRational :: RealFrac a => a -> a -> Rational + cis :: RealFloat a => a -> Complex a + conjugate :: RealFloat a => Complex a -> Complex a + imagPart :: RealFloat a => Complex a -> a + magnitude :: RealFloat a => Complex a -> a + mkPolar :: RealFloat a => a -> a -> Complex a + phase :: RealFloat a => Complex a -> a + polar :: RealFloat a => Complex a -> (a, a) + realPart :: RealFloat a => Complex a -> a + !! :: Integral a => [b] -> a -> b + \\ :: Eq a => [a] -> [a] -> [a] + all :: (a -> Bool) -> [a] -> Bool + and :: [Bool] -> Bool + any :: (a -> Bool) -> [a] -> Bool + break :: (a -> Bool) -> [a] -> ([a], [a]) + concat :: [[a]] -> [a] + cycle :: [a] -> [a] + drop :: Integral a => a -> [b] -> [b] + dropWhile :: (a -> Bool) -> [a] -> [a] + elem :: Eq a => a -> [a] -> Bool + filter :: (a -> Bool) -> [a] -> [a] + foldl1 :: (a -> a -> a) -> [a] -> a + foldr1 :: (a -> a -> a) -> [a] -> a + genericLength :: Num b => [a] -> b + head :: [a] -> a + init :: [a] -> [a] + iterate :: (a -> a) -> a -> [a] + last :: [a] -> a + length :: [a] -> Int + lines :: [Char] -> [[Char]] + maximum :: Ord a => [a] -> a + minimum :: Ord a => [a] -> a + notElem :: Eq a => a -> [a] -> Bool + nub :: Eq a => [a] -> [a] + null :: [a] -> Bool + or :: [Bool] -> Bool + partition :: (a -> Bool) -> [a] -> ([a], [a]) + product :: Num a => [a] -> a + products :: Num a => [a] -> [a] + repeat :: a -> [a] + reverse :: [a] -> [a] + scanl :: (b -> a -> b) -> b -> [a] -> [b] + scanl1 :: (a -> a -> a) -> [a] -> [a] + scanr :: (a -> b -> b) -> b -> [a] -> [b] + scanr1 :: (a -> a -> a) -> [a] -> [a] + span :: (a -> Bool) -> [a] -> ([a], [a]) + splitAt :: Integral a => a -> [b] -> ([b], [b]) + sum :: Num a => [a] -> a + sums :: Num a => [a] -> [a] + tail :: [a] -> [a] + take :: Integral a => a -> [b] -> [b] + takeWhile :: (a -> Bool) -> [a] -> [a] + transpose :: [[a]] -> [[a]] + unlines :: [[Char]] -> [Char] + unwords :: [[Char]] -> [Char] + unzip :: [(a, b)] -> ([a], [b]) + unzip3 :: [(a, b, c)] -> ([a], [b], [c]) + unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d]) + unzip5 :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e]) + unzip6 :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f]) + unzip7 :: + [(a, b, c, d, e, f, g)] + -> ([a], [b], [c], [d], [e], [f], [g]) + words :: [Char] -> [[Char]] + zip :: [a] -> [b] -> [(a, b)] + zip3 :: [a] -> [b] -> [c] -> [(a, b, c)] + zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)] + zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)] + zip6 :: + [a] + -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)] + zip7 :: + [a] + -> [b] + -> [c] + -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)] + zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] + zipWith4 :: + (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e] + zipWith5 :: + (a -> b -> c -> d -> e -> f) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] + zipWith6 :: + (a -> b -> c -> d -> e -> f -> g) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] + zipWith7 :: + (a -> b -> c -> d -> e -> f -> g -> h) + -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h] + ! :: Ix a => Array a b -> a -> b + // :: Ix a => Array a b -> [Assoc a b] -> Array a b + accum :: + Ix b => (c -> a -> c) + -> Array b c -> [Assoc b a] -> Array b c + accumArray :: + Ix b => (c -> a -> c) + -> c -> (b, b) -> [Assoc b a] -> Array b c + amap :: Ix b => (a -> c) -> Array b a -> Array b c + array :: Ix a => (a, a) -> [Assoc a b] -> Array a b + assocs :: Ix a => Array a b -> [Assoc a b] + bounds :: Ix b => Array b a -> (b, b) + elems :: Ix a => Array a b -> [b] + indices :: Ix b => Array b a -> [b] + ixmap :: + (Ix b, Ix a) => (b, b) -> (b -> a) -> Array a c -> Array b c + listArray :: Ix a => (a, a) -> [b] -> Array a b + read :: Text a => [Char] -> a + readDec :: Integral a => [Char] -> [(a, [Char])] + readFloat :: RealFloat a => [Char] -> [(a, [Char])] + readLitChar :: [Char] -> [(Char, [Char])] + readSigned :: + Real a => ([Char] -> [(a, [Char])]) + -> [Char] -> [(a, [Char])] + reads :: Text a => [Char] -> [(a, [Char])] + show :: Text a => a -> [Char] + showChar :: Char -> [Char] -> [Char] + showFloat :: RealFloat a => a -> [Char] -> [Char] + showInt :: Integral a => a -> [Char] -> [Char] + showLitChar :: Char -> [Char] -> [Char] + showSigned :: + Real a => (a -> [Char] -> [Char]) + -> Int -> a -> [Char] -> [Char] + shows :: Text a => a -> [Char] -> [Char] + abort :: IOError -> [Response] -> [Request] + appendBinChan :: + [Char] + -> Bin + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + appendBinFile :: + [Char] + -> Bin + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + appendChan :: + [Char] + -> [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + appendFile :: + [Char] + -> [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + binDispatch :: + (IOError -> [Response] -> a) + -> (Bin -> [Response] -> a) -> [Response] -> a + deleteFile :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + done :: [Response] -> [Request] + echo :: + Bool + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + exit :: IOError -> [Response] -> [Request] + getArgs :: + (IOError -> [Response] -> [Request]) + -> ([[Char]] -> [Response] -> [Request]) + -> [Response] -> [Request] + getEnv :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + getProgName :: + (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + interact :: ([Char] -> [Char]) -> [Response] -> [Request] + print :: Text a => a -> [Response] -> [Request] + prints :: Text a => a -> [Char] -> [Response] -> [Request] + readBinChan :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> (Bin -> [Response] -> [Request]) + -> [Response] -> [Request] + readBinFile :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> (Bin -> [Response] -> [Request]) + -> [Response] -> [Request] + readChan :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + readFile :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + setEnv :: + [Char] + -> [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + statusChan :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + statusFile :: + [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Char] -> [Response] -> [Request]) + -> [Response] -> [Request] + stdecho :: [Char] + stderr :: [Char] + stdin :: [Char] + stdout :: [Char] + strDispatch :: + (IOError -> [Response] -> a) + -> ([Char] -> [Response] -> a) -> [Response] -> a + strListDispatch :: + (IOError -> [Response] -> a) + -> ([[Char]] -> [Response] -> a) -> [Response] -> a + succDispatch :: + (IOError -> [Response] -> a) + -> ([Response] -> a) -> [Response] -> a + writeBinFile :: + [Char] + -> Bin + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + writeFile :: + [Char] + -> [Char] + -> (IOError -> [Response] -> [Request]) + -> ([Response] -> [Request]) -> [Response] -> [Request] + -} +infixr 9 . +infixr 8 ^ +infixr 8 ^^ +infixr 3 && +infixr 2 || +infixr 0 $ +infixl 9 ! +infixl 9 // +infix 1 := +infix 6 :+ +infixr 8 ** +infixl 7 * +infixl 7 / +infixl 7 `quot` +infixl 7 `rem` +infixl 7 `div` +infixl 7 `mod` +infixl 6 + +infixl 6 - +infix 4 == +infix 4 /= +infix 4 < +infix 4 <= +infix 4 >= +infix 4 > +infixl 9 !! +infix 5 \\ +infix 4 `elem` +infix 4 `notElem` +infixl 7 % +infixl 1 `f` +infixr 2 \\\ +infix 3 :==> +infix 4 `MkFoo` +data Foo + = MkFoo Int + | (:==>) Float Double +\\\ :: Eq a => [a] -> [a] -> [a] +{- rec -} +f x y = x +(\\\) + xs ys = xs + diff --git a/ghc/compiler/tests/reader/read003.hs b/ghc/compiler/tests/reader/read003.hs new file mode 100644 index 0000000000..0bb8a24ccf --- /dev/null +++ b/ghc/compiler/tests/reader/read003.hs @@ -0,0 +1,5 @@ +~(a,b,c) | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null diff --git a/ghc/compiler/tests/reader/read004.hs b/ghc/compiler/tests/reader/read004.hs new file mode 100644 index 0000000000..77ab5a0268 --- /dev/null +++ b/ghc/compiler/tests/reader/read004.hs @@ -0,0 +1,43 @@ +--!!! string gaps +--!!! + +----------- + +main = appendChan stdout "\ + +\Some girls give me money\n\ + +\Some girls buy me clothes\n\ + +\..." + exit done + +----------- + +main2 = appendChan stdout "\ +\ \ +..." exit done + +----------- + +main3 = appendChan stdout "\ + +\Some girls give me money\n\ +-- and here is a comment +\Some girls buy me clothes\n\ + +\..." + exit done + +----------- + +main3 = appendChan stdout "\ +{- + and here is a nested {- comment -} +-} +\Some girls give me money\n\ + +\Some girls buy me clothes\n\ + +\..." + exit done diff --git a/ghc/compiler/tests/reader/read004.stderr b/ghc/compiler/tests/reader/read004.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/reader/read004.stderr diff --git a/ghc/compiler/tests/rename/Int10.hi b/ghc/compiler/tests/rename/Int10.hi new file mode 100644 index 0000000000..1d1439bd50 --- /dev/null +++ b/ghc/compiler/tests/rename/Int10.hi @@ -0,0 +1,21 @@ +interface Int10 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 diff --git a/ghc/compiler/tests/rename/Jmakefile b/ghc/compiler/tests/rename/Jmakefile new file mode 100644 index 0000000000..b018f9ddd6 --- /dev/null +++ b/ghc/compiler/tests/rename/Jmakefile @@ -0,0 +1,29 @@ +#define IHaveSubdirs + +SUBDIRS = bevan-bug-1 + +runtests:: + @echo '###############################################################' + @echo '# Validation tests for the renamer (incl dependency analysis) #' + @echo '###############################################################' + +TEST_FLAGS=/*-ddump-rn1 -ddump-rn2 -ddump-rn3*/ -ddump-rn4 + +RunStdTest(rn001,$(GHC), -noC $(TEST_FLAGS) rn001.hs -o2 rn001.stderr -x1) +RunStdTest(rn002,$(GHC), -noC $(TEST_FLAGS) rn002.hs -o2 rn002.stderr -x1) +RunStdTest(rn003,$(GHC), -noC $(TEST_FLAGS) rn003.hs -o2 rn003.stderr) +RunStdTest(rn004,$(GHC), -noC $(TEST_FLAGS) rn004.hs -o2 rn004.stderr -x1) +RunStdTest(rn005,$(GHC), -noC $(TEST_FLAGS) rn005.hs -o2 rn005.stderr) +RunStdTest(rn006,$(GHC), -noC $(TEST_FLAGS) rn006.hs -o2 rn006.stderr) +RunStdTest(rn007,$(GHC), -noC $(TEST_FLAGS) rn007.hs -o2 rn007.stderr -x1) +RunStdTest(rn008,$(GHC), -noC $(TEST_FLAGS) rn008.hs -o2 rn008.stderr -x1) +RunStdTest(rn009,$(GHC), -noC $(TEST_FLAGS) rn009.hs -o2 rn009.stderr) +RunStdTest(rn010,$(GHC), -noC $(TEST_FLAGS) rn010.hs -o2 rn010.stderr) +RunStdTest(rn011,$(GHC), -noC $(TEST_FLAGS) rn011.hs -o2 rn011.stderr) +RunStdTest(rn012,$(GHC), -noC $(TEST_FLAGS) rn012.hs -o2 rn012.stderr) +RunStdTest(rn013,$(GHC), -noC $(TEST_FLAGS) rn013.hs -o2 rn013.stderr) +RunStdTest(rn014,$(GHC), -noC $(TEST_FLAGS) rn014.hs -o2 rn014.stderr) +RunStdTest(rn015,$(GHC), -noC $(TEST_FLAGS) rn015.hs -o2 rn015.stderr -x1) +RunStdTest(rn016,$(GHC), -noC $(TEST_FLAGS) rn016.hs -o2 rn016.stderr) +XCOMM for rn017, the interface produced is what matters +RunStdTest(rn017,$(GHC), -noC $(TEST_FLAGS) -hi rn017.hs -o2 rn017.stderr) diff --git a/ghc/compiler/tests/rename/Rn016.hi b/ghc/compiler/tests/rename/Rn016.hi new file mode 100644 index 0000000000..b098b368a6 --- /dev/null +++ b/ghc/compiler/tests/rename/Rn016.hi @@ -0,0 +1,11 @@ +interface Rn016 where +import X(K) + +class K a where + op1 :: a -> a -> a + op2 :: Int -> a + +instance K Int +instance K Bool +instance K [a] + diff --git a/ghc/compiler/tests/rename/Rn017.hi b/ghc/compiler/tests/rename/Rn017.hi new file mode 100644 index 0000000000..f5a4264c04 --- /dev/null +++ b/ghc/compiler/tests/rename/Rn017.hi @@ -0,0 +1,8 @@ +interface Rn017 where +import Bar (a, b, Wibble(..)) +import Burf(Wobble) +a :: Int -> Int +b :: Int -> Int +c :: Int -> Int +data Wibble = MkWibble Wobble +data Wobble diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Jmakefile b/ghc/compiler/tests/rename/bevan-bug-1/Jmakefile new file mode 100644 index 0000000000..bdf38e714e --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Jmakefile @@ -0,0 +1,4 @@ +XCOMM a renamer bug sent in by Stephen Bevan; +XCOMM going as far as -ddump-tc guarantees that renaming was happy. + +RunStdTest(bevan-bug-1,$(GHC), -noC -ddump-tc Lexer_Ops.lhs -o2 bevan-bug-1.stderr) diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Lexeme.hi b/ghc/compiler/tests/rename/bevan-bug-1/Lexeme.hi new file mode 100644 index 0000000000..f98169aa7b --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Lexeme.hi @@ -0,0 +1,18 @@ +interface Lexeme where +import Oberon_Id(Oberon_Id) +import Oberon_Integer(Oberon_Integer) +import Oberon_Real(Oberon_Real) +import Oberon_String(Oberon_String) +import Symbol(Symbol) +show_lexeme :: Lexeme -> [Char] -> [Char] + {-# ARITY show_lexeme = 0 #-} +data Lexeme = Symbol_Lexeme Symbol | Id_Lexeme Oberon_Id | Int_Lexeme Oberon_Integer | Real_Lexeme Oberon_Real | Long_Real_Lexeme Oberon_Real | String_Lexeme Oberon_String | Char_Lexeme Oberon_Integer | Error_Lexeme Char | EOF_Lexeme | Unterminated_String_Lexeme | Unterminated_Comment_Lexeme | Malformed_Hex_Integer | Malformed_Real_Number +instance Eq Lexeme + {-# ARITY (==) = 2 #-} + {-# ARITY (/=) = 0 #-} +instance Text Lexeme + {-# ARITY readsPrec = 0 #-} + {-# ARITY showsPrec = 2 #-} + {-# ARITY readList = 0 #-} + {-# ARITY showList = 0 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Buffer.hi b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Buffer.hi new file mode 100644 index 0000000000..5764f49c91 --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Buffer.hi @@ -0,0 +1,13 @@ +interface Lexer_Buffer where +add :: Char -> Lexer_Buffer -> Lexer_Buffer + {-# ARITY add = 2 #-} +empty :: Lexer_Buffer + {-# ARITY empty = 0 #-} +flush :: Lexer_Buffer -> Lexer_Buffer + {-# ARITY flush = 1 #-} +len :: Lexer_Buffer -> Int + {-# ARITY len = 1 #-} +to_string :: Lexer_Buffer -> [Char] + {-# ARITY to_string = 1 #-} +data Lexer_Buffer + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Combinators.hi b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Combinators.hi new file mode 100644 index 0000000000..a554bbc605 --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Combinators.hi @@ -0,0 +1,11 @@ +interface Lexer_Combinators where +import Lexer_State(Lexer_State) +and_also :: (Lexer_State -> (b, Lexer_State)) -> (Lexer_State -> (a, Lexer_State)) -> Lexer_State -> (b, Lexer_State) + {-# ARITY and_also = 3 #-} +and_then :: (Lexer_State -> (a, Lexer_State)) -> (Lexer_State -> (b, Lexer_State)) -> Lexer_State -> (b, Lexer_State) + {-# ARITY and_then = 3 #-} +and_with :: (Lexer_State -> (a, Lexer_State)) -> (a -> Lexer_State -> (b, Lexer_State)) -> Lexer_State -> (b, Lexer_State) + {-# ARITY and_with = 3 #-} +return :: a -> Lexer_State -> (a, Lexer_State) + {-# ARITY return = 2 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Ops.lhs b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Ops.lhs new file mode 100644 index 0000000000..b36795712e --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Ops.lhs @@ -0,0 +1,97 @@ + $Id: Lexer_Ops.lhs,v 1.1 1996/01/08 20:17:58 partain Exp $ + +>module Lexer_Ops where + +>import Lexer_Buffer(Lexer_Buffer, add, empty, flush, len, to_string) +> renaming +> (add to add_char, empty to empty_buffer, to_string to buffer_to_string) + +>import Lexer_Combinators(and_with, return) + +>import Lexer_State +> (Lexer_State,Lexer_Action(..),i_buffer,i_source_pos,p_buffer,p_source_pos) + +>import Oberon_Id(Oberon_Id,from_string) renaming (from_string to string_to_id) + +>import Oberon_Integer +> (Oberon_Integer, from_decimal_string, from_hex_string, from_int) +> renaming +> ( from_decimal_string to decimal_string_to_int +> , from_hex_string to hex_string_to_int +> ) + +>import Oberon_Real(Oberon_Real, from_string) renaming +> (from_string to string_to_real) + +>import Oberon_String(Oberon_String, from_string) renaming +> (from_string to string_to_string) + +>import Lexer_Combinators(and_then) + +>import Source_Position(Source_Position, next_line, shift_column, start) +> renaming (start to start_position) + +>t_source_pos transformer = +> p_source_pos `and_with` \pos -> +> i_source_pos (transformer pos) + +>t_buffer transformer = +> p_buffer `and_with` \buff -> +> i_buffer (transformer buff) + + +>buffer_len :: Lexer_Action Int +>buffer_len = +> p_buffer `and_with` \buff -> +> return (len buff) + + +>decimal_to_int :: Lexer_Action Oberon_Integer +>decimal_to_int = +> p_buffer `and_with` \buff -> +> return (decimal_string_to_int (buffer_to_string buff)) + +>flush_buffer :: Lexer_Action () +>flush_buffer = t_buffer flush + +>hex_to_int :: Lexer_Action Oberon_Integer +>hex_to_int = +> p_buffer `and_with` \buff -> +> return (hex_string_to_int (buffer_to_string buff)) + +>move_input_column :: Int -> Lexer_Action () +>move_input_column dist = t_source_pos (flip shift_column dist) + +>next_input_line :: Lexer_Action () +>next_input_line = t_source_pos next_line + +>store_char :: Char -> Lexer_Action () +>store_char c = t_buffer (add_char c) + +>to_char :: Lexer_Action Oberon_Integer +>to_char = +> p_buffer `and_with` \buff -> +> return ((from_int . toInteger . ord . head . buffer_to_string) buff) + +Converts the string in the buffer into a character (actually an +integer since characters are represented as integers). The +pre-condition is that there is exactly one character in the buffer +when this is called. + + +>to_id :: Lexer_Action Oberon_Id +>to_id = +> p_buffer `and_with` \buff -> +> return (string_to_id (buffer_to_string buff)) + +>to_real :: Lexer_Action Oberon_Real +>to_real = +> p_buffer `and_with` \buff -> +> return (string_to_real (buffer_to_string buff)) + +>to_string :: Lexer_Action Oberon_String +>to_string = +> p_buffer `and_with` \buff -> +> return (string_to_string (buffer_to_string buff)) + +% eof diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Lexer_State.hi b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_State.hi new file mode 100644 index 0000000000..a06e093021 --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_State.hi @@ -0,0 +1,22 @@ +interface Lexer_State where +import Lexer_Buffer(Lexer_Buffer) +import Source_Position(Source_Position) +i_buffer :: Lexer_Buffer -> Lexer_State -> ((), Lexer_State) + {-# ARITY i_buffer = 2 #-} +i_input :: [Char] -> Lexer_State -> ((), Lexer_State) + {-# ARITY i_input = 2 #-} +i_source_pos :: Source_Position -> Lexer_State -> ((), Lexer_State) + {-# ARITY i_source_pos = 2 #-} +initial_state :: [Char] -> Lexer_State + {-# ARITY initial_state = 1 #-} +make :: [Char] -> Source_Position -> Lexer_Buffer -> Lexer_State + {-# ARITY make = 3 #-} +p_buffer :: Lexer_State -> (Lexer_Buffer, Lexer_State) + {-# ARITY p_buffer = 1 #-} +p_input :: Lexer_State -> ([Char], Lexer_State) + {-# ARITY p_input = 1 #-} +p_source_pos :: Lexer_State -> (Source_Position, Lexer_State) + {-# ARITY p_source_pos = 1 #-} +type Lexer_Action a = Lexer_State -> (a, Lexer_State) +data Lexer_State = Lexer_State [Char] Source_Position Lexer_Buffer + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Token.hi b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Token.hi new file mode 100644 index 0000000000..68dff3b5bb --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Lexer_Token.hi @@ -0,0 +1,16 @@ +interface Lexer_Token where +import Lexeme(Lexeme) +import Source_Position(Source_Position) +kind :: Token -> Lexeme + {-# ARITY kind = 1 #-} +make :: Source_Position -> Lexeme -> Token + {-# ARITY make = 2 #-} +position :: Token -> Source_Position + {-# ARITY position = 1 #-} +data Token = Token Lexeme Source_Position +instance Text Token + {-# ARITY readsPrec = 0 #-} + {-# ARITY showsPrec = 2 #-} + {-# ARITY readList = 0 #-} + {-# ARITY showList = 0 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Id.hi b/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Id.hi new file mode 100644 index 0000000000..18341f348a --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Id.hi @@ -0,0 +1,15 @@ +interface Oberon_Id where +from_string :: [Char] -> Oberon_Id + {-# ARITY from_string = 1 #-} +to_string :: Oberon_Id -> [Char] + {-# ARITY to_string = 1 #-} +data Oberon_Id +instance Eq Oberon_Id + {-# ARITY (==) = 2 #-} + {-# ARITY (/=) = 0 #-} +instance Text Oberon_Id + {-# ARITY readsPrec = 0 #-} + {-# ARITY showsPrec = 2 #-} + {-# ARITY readList = 0 #-} + {-# ARITY showList = 0 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Integer.hi b/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Integer.hi new file mode 100644 index 0000000000..ef0f1ec34a --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Integer.hi @@ -0,0 +1,21 @@ +interface Oberon_Integer where +from_decimal_string :: [Char] -> Oberon_Integer + {-# ARITY from_decimal_string = 1 #-} +from_hex_string :: [Char] -> Oberon_Integer + {-# ARITY from_hex_string = 1 #-} +from_int :: Integer -> Oberon_Integer + {-# ARITY from_int = 1 #-} +isHexDigit :: Char -> Bool + {-# ARITY isHexDigit = 1 #-} +is_short_int :: Oberon_Integer -> Bool + {-# ARITY is_short_int = 1 #-} +data Oberon_Integer +instance Eq Oberon_Integer + {-# ARITY (==) = 2 #-} + {-# ARITY (/=) = 0 #-} +instance Text Oberon_Integer + {-# ARITY readsPrec = 0 #-} + {-# ARITY showsPrec = 2 #-} + {-# ARITY readList = 0 #-} + {-# ARITY showList = 0 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Real.hi b/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Real.hi new file mode 100644 index 0000000000..35f3544b08 --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Oberon_Real.hi @@ -0,0 +1,13 @@ +interface Oberon_Real where +from_string :: [Char] -> Oberon_Real + {-# ARITY from_string = 0 #-} +data Oberon_Real +instance Eq Oberon_Real + {-# ARITY (==) = 2 #-} + {-# ARITY (/=) = 0 #-} +instance Text Oberon_Real + {-# ARITY readsPrec = 0 #-} + {-# ARITY showsPrec = 2 #-} + {-# ARITY readList = 0 #-} + {-# ARITY showList = 0 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Oberon_String.hi b/ghc/compiler/tests/rename/bevan-bug-1/Oberon_String.hi new file mode 100644 index 0000000000..fd1b17a64c --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Oberon_String.hi @@ -0,0 +1,13 @@ +interface Oberon_String where +from_string :: [Char] -> Oberon_String + {-# ARITY from_string = 1 #-} +data Oberon_String +instance Eq Oberon_String + {-# ARITY (==) = 2 #-} + {-# ARITY (/=) = 0 #-} +instance Text Oberon_String + {-# ARITY readsPrec = 0 #-} + {-# ARITY showsPrec = 2 #-} + {-# ARITY readList = 0 #-} + {-# ARITY showList = 0 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Source_Position.hi b/ghc/compiler/tests/rename/bevan-bug-1/Source_Position.hi new file mode 100644 index 0000000000..f0583e9c7a --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Source_Position.hi @@ -0,0 +1,18 @@ +interface Source_Position where +make :: Int -> Int -> Source_Position + {-# ARITY make = 2 #-} +next_line :: Source_Position -> Source_Position + {-# ARITY next_line = 1 #-} +shift_column :: Source_Position -> Int -> Source_Position + {-# ARITY shift_column = 2 #-} +show_pos :: Source_Position -> [Char] -> [Char] + {-# ARITY show_pos = 1 #-} +start :: Source_Position + {-# ARITY start = 0 #-} +data Source_Position = Source_Position Int Int +instance Text Source_Position + {-# ARITY readsPrec = 0 #-} + {-# ARITY showsPrec = 2 #-} + {-# ARITY readList = 0 #-} + {-# ARITY showList = 0 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/Symbol.hi b/ghc/compiler/tests/rename/bevan-bug-1/Symbol.hi new file mode 100644 index 0000000000..048f321c92 --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/Symbol.hi @@ -0,0 +1,12 @@ +interface Symbol where +data Symbol + = Ampersand_Symbol | And_Symbol | Array_Symbol | Bar_Symbol | By_Symbol | Begin_Symbol | Case_Symbol | Circumflex_Symbol | Close_Brace_Symbol | Close_Bracket_Symbol | Close_Paren_Symbol | Colon_Equal_Symbol | Colon_Symbol | Comma_Symbol | Const_Symbol | Div_Symbol | Do_Symbol | Dot_Dot_Symbol | Dot_Symbol | Else_Symbol | Elseif_Symbol | End_Symbol | Equal_Symbol | Exit_Symbol | For_Symbol | GE_Symbol | GT_Symbol | Hash_Symbol | If_Symbol | Import_Symbol | In_Symbol | Is_Symbol | LE_Symbol | LT_Symbol | Loop_Symbol | Minus_Symbol | Mod_Symbol | Module_Symbol | Nil_Symbol | Of_Symbol | Open_Brace_Symbol | Open_Bracket_Symbol | Open_Paren_Symbol | Or_Symbol | Plus_Symbol | Pointer_Symbol | Proc_Symbol | Record_Symbol | Repeat_Symbol | Return_Symbol | Semi_Colon_Symbol | Set_Symbol | Slash_Symbol | Star_Symbol | Tilde_Symbol | Then_Symbol | To_Symbol | Type_Symbol | Until_Symbol | Var_Symbol | With_Symbol | While_Symbol +instance Eq Symbol + {-# ARITY (==) = 2 #-} + {-# ARITY (/=) = 0 #-} +instance Text Symbol + {-# ARITY readsPrec = 0 #-} + {-# ARITY showsPrec = 2 #-} + {-# ARITY readList = 0 #-} + {-# ARITY showList = 0 #-} + diff --git a/ghc/compiler/tests/rename/bevan-bug-1/bevan-bug-1.stderr b/ghc/compiler/tests/rename/bevan-bug-1/bevan-bug-1.stderr new file mode 100644 index 0000000000..1fef6c9385 --- /dev/null +++ b/ghc/compiler/tests/rename/bevan-bug-1/bevan-bug-1.stderr @@ -0,0 +1,147 @@ +Typechecked: +AbsBinds [] [] [(t_source_pos.t2, Lexer_Ops.t_source_pos)] + {- nonrec -} + t_source_pos.t2 :: + (Source_Position.Source_Position -> Source_Position.Source_Position) + -> Lexer_State.Lexer_State -> ((), Lexer_State.Lexer_State) + t_source_pos.t2 + transformer.r49 + = (Lexer_Combinators.and_with + [Source_Position.Source_Position, ()]) + Lexer_State.p_source_pos + (\ pos.r50 -> Lexer_State.i_source_pos + (transformer.r49 pos.r50)) +AbsBinds [] [] [(t_buffer.t11, Lexer_Ops.t_buffer)] + {- nonrec -} + t_buffer.t11 :: + (Lexer_Buffer.Lexer_Buffer -> Lexer_Buffer.Lexer_Buffer) + -> Lexer_State.Lexer_State -> ((), Lexer_State.Lexer_State) + t_buffer.t11 + transformer.r51 + = (Lexer_Combinators.and_with [Lexer_Buffer.Lexer_Buffer, ()]) + Lexer_State.p_buffer + (\ buff.r52 -> Lexer_State.i_buffer + (transformer.r51 buff.r52)) +AbsBinds [] [] [(buffer_len.t20, Lexer_Ops.buffer_len)] + {- nonrec -} + buffer_len.t20 :: Lexer_State.Lexer_State -> (Int, Lexer_State.Lexer_State) + buffer_len.t20 + = (Lexer_Combinators.and_with [Lexer_Buffer.Lexer_Buffer, Int]) + Lexer_State.p_buffer + (\ buff.r53 -> (Lexer_Combinators.return Int) + (Lexer_Buffer.len buff.r53)) +AbsBinds [] [] [(decimal_to_int.t28, Lexer_Ops.decimal_to_int)] + {- nonrec -} + decimal_to_int.t28 :: + Lexer_State.Lexer_State + -> (Oberon_Integer.Oberon_Integer, Lexer_State.Lexer_State) + decimal_to_int.t28 + = (Lexer_Combinators.and_with + [Lexer_Buffer.Lexer_Buffer, Oberon_Integer.Oberon_Integer]) + Lexer_State.p_buffer + (\ buff.r54 -> (Lexer_Combinators.return + Oberon_Integer.Oberon_Integer) + (Oberon_Integer.from_decimal_string + (Lexer_Buffer.to_string buff.r54))) +AbsBinds [] [] [(flush_buffer.t36, Lexer_Ops.flush_buffer)] + {- nonrec -} + flush_buffer.t36 :: Lexer_State.Lexer_State -> ((), Lexer_State.Lexer_State) + flush_buffer.t36 = Lexer_Ops.t_buffer Lexer_Buffer.flush +AbsBinds [] [] [(hex_to_int.t39, Lexer_Ops.hex_to_int)] + {- nonrec -} + hex_to_int.t39 :: + Lexer_State.Lexer_State + -> (Oberon_Integer.Oberon_Integer, Lexer_State.Lexer_State) + hex_to_int.t39 + = (Lexer_Combinators.and_with + [Lexer_Buffer.Lexer_Buffer, Oberon_Integer.Oberon_Integer]) + Lexer_State.p_buffer + (\ buff.r55 -> (Lexer_Combinators.return + Oberon_Integer.Oberon_Integer) + (Oberon_Integer.from_hex_string + (Lexer_Buffer.to_string buff.r55))) +AbsBinds [] [] [(move_input_column.t47, Lexer_Ops.move_input_column)] + {- nonrec -} + move_input_column.t47 :: Int -> Lexer_State.Lexer_Action () + move_input_column.t47 + dist.r56 = Lexer_Ops.t_source_pos + ((flip [Source_Position.Source_Position, + Int, + Source_Position.Source_Position]) + Source_Position.shift_column dist.r56) +AbsBinds [] [] [(next_input_line.t54, Lexer_Ops.next_input_line)] + {- nonrec -} + next_input_line.t54 :: + Lexer_State.Lexer_State -> ((), Lexer_State.Lexer_State) + next_input_line.t54 = Lexer_Ops.t_source_pos Source_Position.next_line +AbsBinds [] [] [(store_char.t57, Lexer_Ops.store_char)] + {- nonrec -} + store_char.t57 :: Char -> Lexer_State.Lexer_Action () + store_char.t57 + c.r57 = Lexer_Ops.t_buffer (Lexer_Buffer.add c.r57) +AbsBinds [] [] [(to_char.t61, Lexer_Ops.to_char)] + (toInteger.t79, int2Integer) + {- nonrec -} + to_char.t61 :: + Lexer_State.Lexer_State + -> (Oberon_Integer.Oberon_Integer, Lexer_State.Lexer_State) + to_char.t61 + = (Lexer_Combinators.and_with + [Lexer_Buffer.Lexer_Buffer, Oberon_Integer.Oberon_Integer]) + Lexer_State.p_buffer + (\ buff.r58 -> (Lexer_Combinators.return + Oberon_Integer.Oberon_Integer) + ((((.) [Lexer_Buffer.Lexer_Buffer, + [Char], + Oberon_Integer.Oberon_Integer]) + (((.) [[Char], + Char, + Oberon_Integer.Oberon_Integer]) + (((.) [Char, + Int, + Oberon_Integer.Oberon_Integer]) + (((.) [Int, + Integer, + Oberon_Integer.Oberon_Integer]) + Oberon_Integer.from_int + toInteger.t79) + ord) + (head Char)) + Lexer_Buffer.to_string) buff.r58)) +AbsBinds [] [] [(to_id.t88, Lexer_Ops.to_id)] + {- nonrec -} + to_id.t88 :: + Lexer_State.Lexer_State + -> (Oberon_Id.Oberon_Id, Lexer_State.Lexer_State) + to_id.t88 + = (Lexer_Combinators.and_with + [Lexer_Buffer.Lexer_Buffer, Oberon_Id.Oberon_Id]) + Lexer_State.p_buffer + (\ buff.r59 -> (Lexer_Combinators.return Oberon_Id.Oberon_Id) + (Oberon_Id.from_string + (Lexer_Buffer.to_string buff.r59))) +AbsBinds [] [] [(to_real.t96, Lexer_Ops.to_real)] + {- nonrec -} + to_real.t96 :: + Lexer_State.Lexer_State + -> (Oberon_Real.Oberon_Real, Lexer_State.Lexer_State) + to_real.t96 + = (Lexer_Combinators.and_with + [Lexer_Buffer.Lexer_Buffer, Oberon_Real.Oberon_Real]) + Lexer_State.p_buffer + (\ buff.r60 -> (Lexer_Combinators.return Oberon_Real.Oberon_Real) + (Oberon_Real.from_string + (Lexer_Buffer.to_string buff.r60))) +AbsBinds [] [] [(to_string.t104, Lexer_Ops.to_string)] + {- nonrec -} + to_string.t104 :: + Lexer_State.Lexer_State + -> (Oberon_String.Oberon_String, Lexer_State.Lexer_State) + to_string.t104 + = (Lexer_Combinators.and_with + [Lexer_Buffer.Lexer_Buffer, Oberon_String.Oberon_String]) + Lexer_State.p_buffer + (\ buff.r61 -> (Lexer_Combinators.return + Oberon_String.Oberon_String) + (Oberon_String.from_string + (Lexer_Buffer.to_string buff.r61))) diff --git a/ghc/compiler/tests/rename/rn001.hs b/ghc/compiler/tests/rename/rn001.hs new file mode 100644 index 0000000000..f2648a9b99 --- /dev/null +++ b/ghc/compiler/tests/rename/rn001.hs @@ -0,0 +1,10 @@ +--!!! rn001: super-simple set of bindings, +--!!! incl wildcard pattern-bindings and *duplicates* + +x = [] +y = [] +y = [] +_ = [] +_ = 1 +z = [] +_ = [] diff --git a/ghc/compiler/tests/rename/rn001.stderr b/ghc/compiler/tests/rename/rn001.stderr new file mode 100644 index 0000000000..aed3e0a49a --- /dev/null +++ b/ghc/compiler/tests/rename/rn001.stderr @@ -0,0 +1,74 @@ +Renamed-pass4: +module Main where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +{- nonrec -} +Main.x = [] +{- nonrec -} +Main.y = [] +{- nonrec -} +Main.y = [] +{- nonrec -} +_ = [] +{- nonrec -} +_ = 1 +{- nonrec -} +Main.z = [] +{- nonrec -} +_ = [] +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + + +"rn001.hs", line 5: multiple declarations of variable: + y ( "rn001.hs", line 5, "rn001.hs", line 6) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/rename/rn002.hs b/ghc/compiler/tests/rename/rn002.hs new file mode 100644 index 0000000000..51a09b65c2 --- /dev/null +++ b/ghc/compiler/tests/rename/rn002.hs @@ -0,0 +1,4 @@ +--!!! split definition of f (error) +f [] = [] +g x = x +f (x:xs) = [] diff --git a/ghc/compiler/tests/rename/rn002.stderr b/ghc/compiler/tests/rename/rn002.stderr new file mode 100644 index 0000000000..08f0579877 --- /dev/null +++ b/ghc/compiler/tests/rename/rn002.stderr @@ -0,0 +1,69 @@ +Renamed-pass4: +module Main where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +{- nonrec -} +Main.f + [] = [] +{- nonrec -} +Main.g + x = x +{- nonrec -} +Main.f + (x : xs) = [] +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + + +"rn002.hs", line 2: multiple declarations of variable: + f ( "rn002.hs", line 2, "rn002.hs", line 4) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/rename/rn003.hs b/ghc/compiler/tests/rename/rn003.hs new file mode 100644 index 0000000000..493cfa2779 --- /dev/null +++ b/ghc/compiler/tests/rename/rn003.hs @@ -0,0 +1,9 @@ +module Foo (f) where +-- export food +f x = x + +--!!! weird patterns with no variables +1 = f 1 +[] = f [] +1 = f (f 1) +[] = f (f []) diff --git a/ghc/compiler/tests/rename/rn003.stderr b/ghc/compiler/tests/rename/rn003.stderr new file mode 100644 index 0000000000..c18f4e2555 --- /dev/null +++ b/ghc/compiler/tests/rename/rn003.stderr @@ -0,0 +1,67 @@ +Renamed-pass4: +module Foo ( + f + ) where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +{- nonrec -} +Foo.f + x = x +{- nonrec -} +1 = Foo.f 1 +{- nonrec -} +[] = Foo.f ([]) +{- nonrec -} +1 = Foo.f (Foo.f 1) +{- nonrec -} +[] = Foo.f (Foo.f ([])) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn004.hs b/ghc/compiler/tests/rename/rn004.hs new file mode 100644 index 0000000000..247d04b8d7 --- /dev/null +++ b/ghc/compiler/tests/rename/rn004.hs @@ -0,0 +1,9 @@ +module Foo where + +--!!! multiple definitions, but hidden in patterns + +f x = x + where + a = [] + (b,c,a) = ([],[],d) + [d,b,_] = ([],a,[]) diff --git a/ghc/compiler/tests/rename/rn004.stderr b/ghc/compiler/tests/rename/rn004.stderr new file mode 100644 index 0000000000..a9e55c7b08 --- /dev/null +++ b/ghc/compiler/tests/rename/rn004.stderr @@ -0,0 +1,71 @@ +Renamed-pass4: +module Foo where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +{- nonrec -} +Foo.f + x = x + where + {- nonrec -} + a = [] + {- rec -} + (b, c, a) = ([], [], d) + [d, b, _] = ([], a, []) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + + +"rn004.hs", line 7: multiple declarations of variable in binding group: + a ( "rn004.hs", line 7, "rn004.hs", line 8) +"rn004.hs", line 8: multiple declarations of variable in binding group: + b ( "rn004.hs", line 8, "rn004.hs", line 9) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/rename/rn005.hs b/ghc/compiler/tests/rename/rn005.hs new file mode 100644 index 0000000000..f1df4244af --- /dev/null +++ b/ghc/compiler/tests/rename/rn005.hs @@ -0,0 +1,8 @@ +--!!! rn005: simplest case: a few non-recursive bindings + +module Test where + +f = [] +g x = x +h x y = x +i x y z = x diff --git a/ghc/compiler/tests/rename/rn005.stderr b/ghc/compiler/tests/rename/rn005.stderr new file mode 100644 index 0000000000..dfcd629d52 --- /dev/null +++ b/ghc/compiler/tests/rename/rn005.stderr @@ -0,0 +1,65 @@ +Renamed-pass4: +module Test where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +{- nonrec -} +Test.f = [] +{- nonrec -} +Test.g + x = x +{- nonrec -} +Test.h + x y = x +{- nonrec -} +Test.i + x y z = x +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn006.hs b/ghc/compiler/tests/rename/rn006.hs new file mode 100644 index 0000000000..6524bbabea --- /dev/null +++ b/ghc/compiler/tests/rename/rn006.hs @@ -0,0 +1,14 @@ +--!!! 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 diff --git a/ghc/compiler/tests/rename/rn006.stderr b/ghc/compiler/tests/rename/rn006.stderr new file mode 100644 index 0000000000..c81bd623ba --- /dev/null +++ b/ghc/compiler/tests/rename/rn006.stderr @@ -0,0 +1,68 @@ +Renamed-pass4: +module Test where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +{- rec -} +Test.f + x = Test.g x x +Test.g + x y = Test.h x x y +Test.h + x y z = Test.f z +{- rec -} +Test.i + x = Test.j x x +Test.j + x y = Test.k x x y +Test.k + x y z = Test.i z +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn007.hs b/ghc/compiler/tests/rename/rn007.hs new file mode 100644 index 0000000000..d743044556 --- /dev/null +++ b/ghc/compiler/tests/rename/rn007.hs @@ -0,0 +1,20 @@ +--!!! rn007: as rn006, but w/ pattern bindings; +--!!! also a one-node recursive bindings +-- +module Test where + +-- a recursive blob of one node +a = a + +-- two sets of mutually-recursive blobs: +-- f, g, h are mut rec +-- i, j, k are mut rec + +(f1@(f2@(f3@f)), 1) = g 1 1 +(i1@(i2@(i3@i)), 1) = j 1 1 + +(Foo g 1 2) = (h, 1, 1, 2) +(Foo j 1 2) = (k, 1, 1, 2) + +(~ ~ ~ ~h, 1, 2, 3) = f 3 +(~ ~ ~ ~k, 1, 2, 3) = i 3 diff --git a/ghc/compiler/tests/rename/rn007.stderr b/ghc/compiler/tests/rename/rn007.stderr new file mode 100644 index 0000000000..21d14df410 --- /dev/null +++ b/ghc/compiler/tests/rename/rn007.stderr @@ -0,0 +1,70 @@ +Renamed-pass4: +module Test where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +{- rec -} +Test.a = Test.a +{- rec -} +((Test.f1@(Test.f2@(Test.f3@Test.f))), 1) = Test.g 1 1 +(*UNBOUND*Foo Test.g 1 2) = (Test.h, 1, 1, 2) +(~~~~Test.h, 1, 2, 3) = Test.f 3 +{- rec -} +((Test.i1@(Test.i2@(Test.i3@Test.i))), 1) = Test.j 1 1 +(*UNBOUND*Foo Test.j 1 2) = (Test.k, 1, 1, 2) +(~~~~Test.k, 1, 2, 3) = Test.i 3 +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + + +"rn007.hs", line 16: undefined value: Foo +"rn007.hs", line 17: undefined value: Foo +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/rename/rn008.hs b/ghc/compiler/tests/rename/rn008.hs new file mode 100644 index 0000000000..45fc0de69e --- /dev/null +++ b/ghc/compiler/tests/rename/rn008.hs @@ -0,0 +1,14 @@ +module Test where + +-- two sets of mutually-recursive blobs: +-- f, g, h are mut rec +-- i, j, k are mut rec + +(f1@(f2@(f3@f)), 1) = g 1 1 +(i1@(i2@(i3@i)), 1) = j 1 1 + +(Foo g 1 2) = (h, 1, 1, 2) +(Foo j 1 2) = (k, 1, 1, 2) + +(~ ~ ~ ~h, 1, 2, 3) = f 3 +(~ ~ ~ ~k, 1, 2, 3) = i 3 diff --git a/ghc/compiler/tests/rename/rn008.stderr b/ghc/compiler/tests/rename/rn008.stderr new file mode 100644 index 0000000000..a6884dfd2f --- /dev/null +++ b/ghc/compiler/tests/rename/rn008.stderr @@ -0,0 +1,68 @@ +Renamed-pass4: +module Test where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +{- rec -} +((Test.f1@(Test.f2@(Test.f3@Test.f))), 1) = Test.g 1 1 +(*UNBOUND*Foo Test.g 1 2) = (Test.h, 1, 1, 2) +(~~~~Test.h, 1, 2, 3) = Test.f 3 +{- rec -} +((Test.i1@(Test.i2@(Test.i3@Test.i))), 1) = Test.j 1 1 +(*UNBOUND*Foo Test.j 1 2) = (Test.k, 1, 1, 2) +(~~~~Test.k, 1, 2, 3) = Test.i 3 +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + + +"rn008.hs", line 10: undefined value: Foo +"rn008.hs", line 11: undefined value: Foo +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/rename/rn009.hs b/ghc/compiler/tests/rename/rn009.hs new file mode 100644 index 0000000000..dbf6966ab4 --- /dev/null +++ b/ghc/compiler/tests/rename/rn009.hs @@ -0,0 +1,2 @@ +module Imp10 where +import Int10 diff --git a/ghc/compiler/tests/rename/rn009.stderr b/ghc/compiler/tests/rename/rn009.stderr new file mode 100644 index 0000000000..cdbf46ceeb --- /dev/null +++ b/ghc/compiler/tests/rename/rn009.stderr @@ -0,0 +1,94 @@ +Renamed-pass4: +module Imp10 where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +data Int10.T1 a + = Int10.C1 a +data Int10.T10 a b c d e + = Int10.T10C1 a + | Int10.T10C2 b + | Int10.T10C3 c + | Int10.T10C4 d + | Int10.T10C5 e +data Int10.T2 a b + = Int10.T2C1 a + | Int10.T2C2 b +data Int10.T3 a b c + = Int10.T3C1 a + | Int10.T3C2 b + | Int10.T3C3 c +data Int10.T4 a b c d + = Int10.T4C1 a + | Int10.T4C2 b + | Int10.T4C3 c + | Int10.T4C4 d +data Int10.T5 a b c d e + = Int10.T5C1 a + | Int10.T5C2 b + | Int10.T5C3 c + | Int10.T5C4 d + | Int10.T5C5 e +data Int10.T6 a + = Int10.T6C6 a +data Int10.T7 a b + = Int10.T7C6 a + | Int10.T7C7 b +data Int10.T8 a b c + = Int10.T8C1 a + | Int10.T8C2 b + | Int10.T8C3 c +data Int10.T9 a b c d + = Int10.T9C1 a + | Int10.T9C2 b + | Int10.T9C3 c + | Int10.T9C4 d +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn010.hs b/ghc/compiler/tests/rename/rn010.hs new file mode 100644 index 0000000000..da32cce46b --- /dev/null +++ b/ghc/compiler/tests/rename/rn010.hs @@ -0,0 +1,12 @@ +module Imp100 where +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 + diff --git a/ghc/compiler/tests/rename/rn010.stderr b/ghc/compiler/tests/rename/rn010.stderr new file mode 100644 index 0000000000..9e793633b0 --- /dev/null +++ b/ghc/compiler/tests/rename/rn010.stderr @@ -0,0 +1,94 @@ +Renamed-pass4: +module Imp100 where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +data Int10.T1 a + = Int10.C1 a +data Int10.T10 a b c d e + = Int10.T10C1 a + | Int10.T10C2 b + | Int10.T10C3 c + | Int10.T10C4 d + | Int10.T10C5 e +data Int10.T2 a b + = Int10.T2C1 a + | Int10.T2C2 b +data Int10.T3 a b c + = Int10.T3C1 a + | Int10.T3C2 b + | Int10.T3C3 c +data Int10.T4 a b c d + = Int10.T4C1 a + | Int10.T4C2 b + | Int10.T4C3 c + | Int10.T4C4 d +data Int10.T5 a b c d e + = Int10.T5C1 a + | Int10.T5C2 b + | Int10.T5C3 c + | Int10.T5C4 d + | Int10.T5C5 e +data Int10.T6 a + = Int10.T6C6 a +data Int10.T7 a b + = Int10.T7C6 a + | Int10.T7C7 b +data Int10.T8 a b c + = Int10.T8C1 a + | Int10.T8C2 b + | Int10.T8C3 c +data Int10.T9 a b c d + = Int10.T9C1 a + | Int10.T9C2 b + | Int10.T9C3 c + | Int10.T9C4 d +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn011.hs b/ghc/compiler/tests/rename/rn011.hs new file mode 100644 index 0000000000..c71a553849 --- /dev/null +++ b/ghc/compiler/tests/rename/rn011.hs @@ -0,0 +1,102 @@ +module Imp1000 where +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 + diff --git a/ghc/compiler/tests/rename/rn011.stderr b/ghc/compiler/tests/rename/rn011.stderr new file mode 100644 index 0000000000..a3f4176d1c --- /dev/null +++ b/ghc/compiler/tests/rename/rn011.stderr @@ -0,0 +1,94 @@ +Renamed-pass4: +module Imp1000 where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +data Int10.T1 a + = Int10.C1 a +data Int10.T10 a b c d e + = Int10.T10C1 a + | Int10.T10C2 b + | Int10.T10C3 c + | Int10.T10C4 d + | Int10.T10C5 e +data Int10.T2 a b + = Int10.T2C1 a + | Int10.T2C2 b +data Int10.T3 a b c + = Int10.T3C1 a + | Int10.T3C2 b + | Int10.T3C3 c +data Int10.T4 a b c d + = Int10.T4C1 a + | Int10.T4C2 b + | Int10.T4C3 c + | Int10.T4C4 d +data Int10.T5 a b c d e + = Int10.T5C1 a + | Int10.T5C2 b + | Int10.T5C3 c + | Int10.T5C4 d + | Int10.T5C5 e +data Int10.T6 a + = Int10.T6C6 a +data Int10.T7 a b + = Int10.T7C6 a + | Int10.T7C7 b +data Int10.T8 a b c + = Int10.T8C1 a + | Int10.T8C2 b + | Int10.T8C3 c +data Int10.T9 a b c d + = Int10.T9C1 a + | Int10.T9C2 b + | Int10.T9C3 c + | Int10.T9C4 d +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn012.hs b/ghc/compiler/tests/rename/rn012.hs new file mode 100644 index 0000000000..a49abc68c3 --- /dev/null +++ b/ghc/compiler/tests/rename/rn012.hs @@ -0,0 +1,52 @@ +module Imp500 where +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 +import Int10 + diff --git a/ghc/compiler/tests/rename/rn012.stderr b/ghc/compiler/tests/rename/rn012.stderr new file mode 100644 index 0000000000..31b7a51ccf --- /dev/null +++ b/ghc/compiler/tests/rename/rn012.stderr @@ -0,0 +1,94 @@ +Renamed-pass4: +module Imp500 where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +data Int10.T1 a + = Int10.C1 a +data Int10.T10 a b c d e + = Int10.T10C1 a + | Int10.T10C2 b + | Int10.T10C3 c + | Int10.T10C4 d + | Int10.T10C5 e +data Int10.T2 a b + = Int10.T2C1 a + | Int10.T2C2 b +data Int10.T3 a b c + = Int10.T3C1 a + | Int10.T3C2 b + | Int10.T3C3 c +data Int10.T4 a b c d + = Int10.T4C1 a + | Int10.T4C2 b + | Int10.T4C3 c + | Int10.T4C4 d +data Int10.T5 a b c d e + = Int10.T5C1 a + | Int10.T5C2 b + | Int10.T5C3 c + | Int10.T5C4 d + | Int10.T5C5 e +data Int10.T6 a + = Int10.T6C6 a +data Int10.T7 a b + = Int10.T7C6 a + | Int10.T7C7 b +data Int10.T8 a b c + = Int10.T8C1 a + | Int10.T8C2 b + | Int10.T8C3 c +data Int10.T9 a b c d + = Int10.T9C1 a + | Int10.T9C2 b + | Int10.T9C3 c + | Int10.T9C4 d +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn013.hs b/ghc/compiler/tests/rename/rn013.hs new file mode 100644 index 0000000000..e48c2c56ee --- /dev/null +++ b/ghc/compiler/tests/rename/rn013.hs @@ -0,0 +1,21 @@ +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 diff --git a/ghc/compiler/tests/rename/rn013.stderr b/ghc/compiler/tests/rename/rn013.stderr new file mode 100644 index 0000000000..7f6d594c7a --- /dev/null +++ b/ghc/compiler/tests/rename/rn013.stderr @@ -0,0 +1,94 @@ +Renamed-pass4: +module Mod10 where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +data Mod10.T1 a + = Mod10.C1 a +data Mod10.T10 a b c d e + = Mod10.T10C1 a + | Mod10.T10C2 b + | Mod10.T10C3 c + | Mod10.T10C4 d + | Mod10.T10C5 e +data Mod10.T2 a b + = Mod10.T2C1 a + | Mod10.T2C2 b +data Mod10.T3 a b c + = Mod10.T3C1 a + | Mod10.T3C2 b + | Mod10.T3C3 c +data Mod10.T4 a b c d + = Mod10.T4C1 a + | Mod10.T4C2 b + | Mod10.T4C3 c + | Mod10.T4C4 d +data Mod10.T5 a b c d e + = Mod10.T5C1 a + | Mod10.T5C2 b + | Mod10.T5C3 c + | Mod10.T5C4 d + | Mod10.T5C5 e +data Mod10.T6 a + = Mod10.T6C6 a +data Mod10.T7 a b + = Mod10.T7C6 a + | Mod10.T7C7 b +data Mod10.T8 a b c + = Mod10.T8C1 a + | Mod10.T8C2 b + | Mod10.T8C3 c +data Mod10.T9 a b c d + = Mod10.T9C1 a + | Mod10.T9C2 b + | Mod10.T9C3 c + | Mod10.T9C4 d +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn014.hs b/ghc/compiler/tests/rename/rn014.hs new file mode 100644 index 0000000000..6802fc7366 --- /dev/null +++ b/ghc/compiler/tests/rename/rn014.hs @@ -0,0 +1 @@ +import Prelude diff --git a/ghc/compiler/tests/rename/rn014.stderr b/ghc/compiler/tests/rename/rn014.stderr new file mode 100644 index 0000000000..8d5c455f83 --- /dev/null +++ b/ghc/compiler/tests/rename/rn014.stderr @@ -0,0 +1,54 @@ +Renamed-pass4: +module Main where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn015.hs b/ghc/compiler/tests/rename/rn015.hs new file mode 100644 index 0000000000..852034734e --- /dev/null +++ b/ghc/compiler/tests/rename/rn015.hs @@ -0,0 +1,19 @@ +--!!! 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 + diff --git a/ghc/compiler/tests/rename/rn015.stderr b/ghc/compiler/tests/rename/rn015.stderr new file mode 100644 index 0000000000..fc3df5eac4 --- /dev/null +++ b/ghc/compiler/tests/rename/rn015.stderr @@ -0,0 +1,73 @@ +Renamed-pass4: +module Test where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +class Test.K a where + op1{op 1 cls Test.K} :: a -> a -> a + op2{op 2 cls Test.K} :: Int -> a +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +instance Test.K Bool where + op1{op 1 cls Test.K} + a b = a +instance Test.K Int where + op1{op 1 cls Test.K} + a b = a (+) b + op2{op 2 cls Test.K} + x = x +instance Test.K [a] where + *UNBOUND*op3 + a = a +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + + +"rn015.hs", line 18: "op3" is not an operation of class "K" +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/rename/rn016.hs b/ghc/compiler/tests/rename/rn016.hs new file mode 100644 index 0000000000..b561ce1e75 --- /dev/null +++ b/ghc/compiler/tests/rename/rn016.hs @@ -0,0 +1,6 @@ +--!!! Import an interface defining a class and some instances + +module Main where + +import Rn016 + diff --git a/ghc/compiler/tests/rename/rn016.stderr b/ghc/compiler/tests/rename/rn016.stderr new file mode 100644 index 0000000000..ff45b2e4ef --- /dev/null +++ b/ghc/compiler/tests/rename/rn016.stderr @@ -0,0 +1,60 @@ +Renamed-pass4: +module Main where +infixl 9 PreludeArray.! +infixl 9 PreludeList.!! +infixl 7 PreludeRatio.% +infixl 7 (*) +infixl 6 (+) +infixl 6 (-) +infixl 7 (/) +infixl 9 PreludeArray.// +infixl 7 `div` +infixl 7 `mod` +infixl 7 `quot` +infixl 7 `rem` +infixr 0 $ +infixr 3 && +infixr 8 (**) +infixr 9 . +infixr 8 Prelude.^ +infixr 8 Prelude.^^ +infixr 2 || +infix 4 (/=) +infix 6 :+ +infix 1 := +infix 4 (<) +infix 4 (<=) +infix 4 (==) +infix 4 (>) +infix 4 (>=) +infix 5 PreludeList.\\ +class X.K a where + op1{op 1 cls X.K} :: a -> a -> a + op2{op 2 cls X.K} :: Int -> a +instance (Eq a, Eq b) => Eq (a, b) +instance (Eq a, Eq b, Eq c) => Eq (a, b, c) +instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) +instance (Ix a, Ix b) => Ix (a, b) +instance (Ix a, Ix b, Ix c) => Ix (a, b, c) +instance (Ix a, Ix b, Ix c, Ix d) => Ix (a, b, c, d) +instance (Binary a, Binary b) => Binary (a, b) +instance (Binary a, Binary b, Binary c) => Binary (a, b, c) +instance (Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) +instance X.K Bool +instance X.K Int +instance X.K [a] +instance (Ord a, Ord b) => Ord (a, b) +instance (Ord a, Ord b, Ord c) => Ord (a, b, c) +instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d) +instance (Text a, Text b) => Text (a, b) +instance (Text a, Text b, Text c) => Text (a, b, c) +instance (Text a, Text b, Text c, Text d) => Text (a, b, c, d) +PreludeArray.! :: Ix a => Array a b -> a -> b +PreludeList.!! :: Integral a => [b] -> a -> b +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +Prelude.^ :: (Num b, Integral a) => b -> a -> b +Prelude.^^ :: (Fractional b, Integral a) => b -> a -> b +PreludeList.or :: [Bool] -> Bool + diff --git a/ghc/compiler/tests/rename/rn017.hs b/ghc/compiler/tests/rename/rn017.hs new file mode 100644 index 0000000000..3adc45fd67 --- /dev/null +++ b/ghc/compiler/tests/rename/rn017.hs @@ -0,0 +1,13 @@ +module Test ( Test.. , Rn017.. ) where + +import Rn017 + +f x = x + +data Foo = MkFoo + +class FOO a where + op :: a -> Int + +instance FOO Foo where + op x = 42 diff --git a/ghc/compiler/tests/rename/rn017.stderr b/ghc/compiler/tests/rename/rn017.stderr new file mode 100644 index 0000000000..d1f5d456d2 --- /dev/null +++ b/ghc/compiler/tests/rename/rn017.stderr @@ -0,0 +1,48 @@ +Renamer-pass4: +module Test ( + Test.., Rn017.. + ) where +infixl 7 PreludeRatio.% +infixl 9 PreludeArray.// +infixr 8 PreludeBasic.^ +infixr 8 PreludeBasic.^^ +infix 5 PreludeList.\\ +data Test.Foo + = Test.MkFoo +data Bar.Wibble + = Bar.MkWibble Burf.Wobble +data Burf.Wobble +class Test.FOO a where + op{op 1 cls Test.FOO} :: a -> Int +instance Test.FOO Test.Foo where + op{op 1 cls Test.FOO} + x = 42 +{- nonrec -} +Test.f + x = x +PreludeRatio.% :: Integral a => a -> a -> Ratio a +PreludeArray.// :: Ix a => Array a b -> [Assoc a b] -> Array a b +PreludeList.\\ :: Eq a => [a] -> [a] -> [a] +PreludeBasic.^ :: (Num b, Integral a) => b -> a -> b +PreludeBasic.^^ :: (Fractional b, Integral a) => b -> a -> b +Bar.a :: Int -> Int +Bar.b :: Int -> Int +Rn017.c :: Int -> Int +interface Test where +import Bar(Wibble(..), a, b) +import Burf(Wobble(..)) +import Rn017(c) +a :: Int -> Int +b :: Int -> Int +c :: Int -> Int +f :: a -> a + {-# ARITY f = 1 #-} +class FOO a where + op :: a -> Int + {-# ARITY op = 1 #-} +data Foo = MkFoo +data Wibble = MkWibble Wobble +data Wobble +instance FOO Foo + {-# ARITY op = 1 #-} + diff --git a/ghc/compiler/tests/rename/timing001.hs b/ghc/compiler/tests/rename/timing001.hs new file mode 100644 index 0000000000..06fc56aeaf --- /dev/null +++ b/ghc/compiler/tests/rename/timing001.hs @@ -0,0 +1,506 @@ +--!!! 500 defns chained together at the top-level + +a000 = a001 +a001 = a002 +a002 = a003 +a003 = a004 +a004 = a005 +a005 = a006 +a006 = a007 +a007 = a008 +a008 = a009 +a009 = a010 +a010 = a011 +a011 = a012 +a012 = a013 +a013 = a014 +a014 = a015 +a015 = a016 +a016 = a017 +a017 = a018 +a018 = a019 +a019 = a020 +a020 = a021 +a021 = a022 +a022 = a023 +a023 = a024 +a024 = a025 +a025 = a026 +a026 = a027 +a027 = a028 +a028 = a029 +a029 = a030 +a030 = a031 +a031 = a032 +a032 = a033 +a033 = a034 +a034 = a035 +a035 = a036 +a036 = a037 +a037 = a038 +a038 = a039 +a039 = a040 +a040 = a041 +a041 = a042 +a042 = a043 +a043 = a044 +a044 = a045 +a045 = a046 +a046 = a047 +a047 = a048 +a048 = a049 +a049 = a050 +a050 = a051 +a051 = a052 +a052 = a053 +a053 = a054 +a054 = a055 +a055 = a056 +a056 = a057 +a057 = a058 +a058 = a059 +a059 = a060 +a060 = a061 +a061 = a062 +a062 = a063 +a063 = a064 +a064 = a065 +a065 = a066 +a066 = a067 +a067 = a068 +a068 = a069 +a069 = a070 +a070 = a071 +a071 = a072 +a072 = a073 +a073 = a074 +a074 = a075 +a075 = a076 +a076 = a077 +a077 = a078 +a078 = a079 +a079 = a080 +a080 = a081 +a081 = a082 +a082 = a083 +a083 = a084 +a084 = a085 +a085 = a086 +a086 = a087 +a087 = a088 +a088 = a089 +a089 = a090 +a090 = a091 +a091 = a092 +a092 = a093 +a093 = a094 +a094 = a095 +a095 = a096 +a096 = a097 +a097 = a098 +a098 = a099 +a099 = a100 + +a100 = a101 +a101 = a102 +a102 = a103 +a103 = a104 +a104 = a105 +a105 = a106 +a106 = a107 +a107 = a108 +a108 = a109 +a109 = a110 +a110 = a111 +a111 = a112 +a112 = a113 +a113 = a114 +a114 = a115 +a115 = a116 +a116 = a117 +a117 = a118 +a118 = a119 +a119 = a120 +a120 = a121 +a121 = a122 +a122 = a123 +a123 = a124 +a124 = a125 +a125 = a126 +a126 = a127 +a127 = a128 +a128 = a129 +a129 = a130 +a130 = a131 +a131 = a132 +a132 = a133 +a133 = a134 +a134 = a135 +a135 = a136 +a136 = a137 +a137 = a138 +a138 = a139 +a139 = a140 +a140 = a141 +a141 = a142 +a142 = a143 +a143 = a144 +a144 = a145 +a145 = a146 +a146 = a147 +a147 = a148 +a148 = a149 +a149 = a150 +a150 = a151 +a151 = a152 +a152 = a153 +a153 = a154 +a154 = a155 +a155 = a156 +a156 = a157 +a157 = a158 +a158 = a159 +a159 = a160 +a160 = a161 +a161 = a162 +a162 = a163 +a163 = a164 +a164 = a165 +a165 = a166 +a166 = a167 +a167 = a168 +a168 = a169 +a169 = a170 +a170 = a171 +a171 = a172 +a172 = a173 +a173 = a174 +a174 = a175 +a175 = a176 +a176 = a177 +a177 = a178 +a178 = a179 +a179 = a180 +a180 = a181 +a181 = a182 +a182 = a183 +a183 = a184 +a184 = a185 +a185 = a186 +a186 = a187 +a187 = a188 +a188 = a189 +a189 = a190 +a190 = a191 +a191 = a192 +a192 = a193 +a193 = a194 +a194 = a195 +a195 = a196 +a196 = a197 +a197 = a198 +a198 = a199 +a199 = a200 + +a200 = a201 +a201 = a202 +a202 = a203 +a203 = a204 +a204 = a205 +a205 = a206 +a206 = a207 +a207 = a208 +a208 = a209 +a209 = a210 +a210 = a211 +a211 = a212 +a212 = a213 +a213 = a214 +a214 = a215 +a215 = a216 +a216 = a217 +a217 = a218 +a218 = a219 +a219 = a220 +a220 = a221 +a221 = a222 +a222 = a223 +a223 = a224 +a224 = a225 +a225 = a226 +a226 = a227 +a227 = a228 +a228 = a229 +a229 = a230 +a230 = a231 +a231 = a232 +a232 = a233 +a233 = a234 +a234 = a235 +a235 = a236 +a236 = a237 +a237 = a238 +a238 = a239 +a239 = a240 +a240 = a241 +a241 = a242 +a242 = a243 +a243 = a244 +a244 = a245 +a245 = a246 +a246 = a247 +a247 = a248 +a248 = a249 +a249 = a250 +a250 = a251 +a251 = a252 +a252 = a253 +a253 = a254 +a254 = a255 +a255 = a256 +a256 = a257 +a257 = a258 +a258 = a259 +a259 = a260 +a260 = a261 +a261 = a262 +a262 = a263 +a263 = a264 +a264 = a265 +a265 = a266 +a266 = a267 +a267 = a268 +a268 = a269 +a269 = a270 +a270 = a271 +a271 = a272 +a272 = a273 +a273 = a274 +a274 = a275 +a275 = a276 +a276 = a277 +a277 = a278 +a278 = a279 +a279 = a280 +a280 = a281 +a281 = a282 +a282 = a283 +a283 = a284 +a284 = a285 +a285 = a286 +a286 = a287 +a287 = a288 +a288 = a289 +a289 = a290 +a290 = a291 +a291 = a292 +a292 = a293 +a293 = a294 +a294 = a295 +a295 = a296 +a296 = a297 +a297 = a298 +a298 = a299 +a299 = a300 + +a300 = a301 +a301 = a302 +a302 = a303 +a303 = a304 +a304 = a305 +a305 = a306 +a306 = a307 +a307 = a308 +a308 = a309 +a309 = a310 +a310 = a311 +a311 = a312 +a312 = a313 +a313 = a314 +a314 = a315 +a315 = a316 +a316 = a317 +a317 = a318 +a318 = a319 +a319 = a320 +a320 = a321 +a321 = a322 +a322 = a323 +a323 = a324 +a324 = a325 +a325 = a326 +a326 = a327 +a327 = a328 +a328 = a329 +a329 = a330 +a330 = a331 +a331 = a332 +a332 = a333 +a333 = a334 +a334 = a335 +a335 = a336 +a336 = a337 +a337 = a338 +a338 = a339 +a339 = a340 +a340 = a341 +a341 = a342 +a342 = a343 +a343 = a344 +a344 = a345 +a345 = a346 +a346 = a347 +a347 = a348 +a348 = a349 +a349 = a350 +a350 = a351 +a351 = a352 +a352 = a353 +a353 = a354 +a354 = a355 +a355 = a356 +a356 = a357 +a357 = a358 +a358 = a359 +a359 = a360 +a360 = a361 +a361 = a362 +a362 = a363 +a363 = a364 +a364 = a365 +a365 = a366 +a366 = a367 +a367 = a368 +a368 = a369 +a369 = a370 +a370 = a371 +a371 = a372 +a372 = a373 +a373 = a374 +a374 = a375 +a375 = a376 +a376 = a377 +a377 = a378 +a378 = a379 +a379 = a380 +a380 = a381 +a381 = a382 +a382 = a383 +a383 = a384 +a384 = a385 +a385 = a386 +a386 = a387 +a387 = a388 +a388 = a389 +a389 = a390 +a390 = a391 +a391 = a392 +a392 = a393 +a393 = a394 +a394 = a395 +a395 = a396 +a396 = a397 +a397 = a398 +a398 = a399 +a399 = a400 + +a400 = a401 +a401 = a402 +a402 = a403 +a403 = a404 +a404 = a405 +a405 = a406 +a406 = a407 +a407 = a408 +a408 = a409 +a409 = a410 +a410 = a411 +a411 = a412 +a412 = a413 +a413 = a414 +a414 = a415 +a415 = a416 +a416 = a417 +a417 = a418 +a418 = a419 +a419 = a420 +a420 = a421 +a421 = a422 +a422 = a423 +a423 = a424 +a424 = a425 +a425 = a426 +a426 = a427 +a427 = a428 +a428 = a429 +a429 = a430 +a430 = a431 +a431 = a432 +a432 = a433 +a433 = a434 +a434 = a435 +a435 = a436 +a436 = a437 +a437 = a438 +a438 = a439 +a439 = a440 +a440 = a441 +a441 = a442 +a442 = a443 +a443 = a444 +a444 = a445 +a445 = a446 +a446 = a447 +a447 = a448 +a448 = a449 +a449 = a450 +a450 = a451 +a451 = a452 +a452 = a453 +a453 = a454 +a454 = a455 +a455 = a456 +a456 = a457 +a457 = a458 +a458 = a459 +a459 = a460 +a460 = a461 +a461 = a462 +a462 = a463 +a463 = a464 +a464 = a465 +a465 = a466 +a466 = a467 +a467 = a468 +a468 = a469 +a469 = a470 +a470 = a471 +a471 = a472 +a472 = a473 +a473 = a474 +a474 = a475 +a475 = a476 +a476 = a477 +a477 = a478 +a478 = a479 +a479 = a480 +a480 = a481 +a481 = a482 +a482 = a483 +a483 = a484 +a484 = a485 +a485 = a486 +a486 = a487 +a487 = a488 +a488 = a489 +a489 = a490 +a490 = a491 +a491 = a492 +a492 = a493 +a493 = a494 +a494 = a495 +a495 = a496 +a496 = a497 +a497 = a498 +a498 = a499 +a499 = [] -- !!! ta-dah!!! diff --git a/ghc/compiler/tests/rename/timing002.hs b/ghc/compiler/tests/rename/timing002.hs new file mode 100644 index 0000000000..9c7146e700 --- /dev/null +++ b/ghc/compiler/tests/rename/timing002.hs @@ -0,0 +1,502 @@ +--!!! 500 defns chained together with "where"s + +a500 = let a000 = [] + a001 = a000 + a002 = a001 + a003 = a002 + a004 = a003 + a005 = a004 + a006 = a005 + a007 = a006 + a008 = a007 + a009 = a008 + a010 = a009 + a011 = a010 + a012 = a011 + a013 = a012 + a014 = a013 + a015 = a014 + a016 = a015 + a017 = a016 + a018 = a017 + a019 = a018 + a020 = a019 + a021 = a020 + a022 = a021 + a023 = a022 + a024 = a023 + a025 = a024 + a026 = a025 + a027 = a026 + a028 = a027 + a029 = a028 + a030 = a029 + a031 = a030 + a032 = a031 + a033 = a032 + a034 = a033 + a035 = a034 + a036 = a035 + a037 = a036 + a038 = a037 + a039 = a038 + a040 = a039 + a041 = a040 + a042 = a041 + a043 = a042 + a044 = a043 + a045 = a044 + a046 = a045 + a047 = a046 + a048 = a047 + a049 = a048 + a050 = a049 + a051 = a050 + a052 = a051 + a053 = a052 + a054 = a053 + a055 = a054 + a056 = a055 + a057 = a056 + a058 = a057 + a059 = a058 + a060 = a059 + a061 = a060 + a062 = a061 + a063 = a062 + a064 = a063 + a065 = a064 + a066 = a065 + a067 = a066 + a068 = a067 + a069 = a068 + a070 = a069 + a071 = a070 + a072 = a071 + a073 = a072 + a074 = a073 + a075 = a074 + a076 = a075 + a077 = a076 + a078 = a077 + a079 = a078 + a080 = a079 + a081 = a080 + a082 = a081 + a083 = a082 + a084 = a083 + a085 = a084 + a086 = a085 + a087 = a086 + a088 = a087 + a089 = a088 + a090 = a089 + a091 = a090 + a092 = a091 + a093 = a092 + a094 = a093 + a095 = a094 + a096 = a095 + a097 = a096 + a098 = a097 + a099 = a098 + a100 = a099 + a101 = a100 + a102 = a101 + a103 = a102 + a104 = a103 + a105 = a104 + a106 = a105 + a107 = a106 + a108 = a107 + a109 = a108 + a110 = a109 + a111 = a110 + a112 = a111 + a113 = a112 + a114 = a113 + a115 = a114 + a116 = a115 + a117 = a116 + a118 = a117 + a119 = a118 + a120 = a119 + a121 = a120 + a122 = a121 + a123 = a122 + a124 = a123 + a125 = a124 + a126 = a125 + a127 = a126 + a128 = a127 + a129 = a128 + a130 = a129 + a131 = a130 + a132 = a131 + a133 = a132 + a134 = a133 + a135 = a134 + a136 = a135 + a137 = a136 + a138 = a137 + a139 = a138 + a140 = a139 + a141 = a140 + a142 = a141 + a143 = a142 + a144 = a143 + a145 = a144 + a146 = a145 + a147 = a146 + a148 = a147 + a149 = a148 + a150 = a149 + a151 = a150 + a152 = a151 + a153 = a152 + a154 = a153 + a155 = a154 + a156 = a155 + a157 = a156 + a158 = a157 + a159 = a158 + a160 = a159 + a161 = a160 + a162 = a161 + a163 = a162 + a164 = a163 + a165 = a164 + a166 = a165 + a167 = a166 + a168 = a167 + a169 = a168 + a170 = a169 + a171 = a170 + a172 = a171 + a173 = a172 + a174 = a173 + a175 = a174 + a176 = a175 + a177 = a176 + a178 = a177 + a179 = a178 + a180 = a179 + a181 = a180 + a182 = a181 + a183 = a182 + a184 = a183 + a185 = a184 + a186 = a185 + a187 = a186 + a188 = a187 + a189 = a188 + a190 = a189 + a191 = a190 + a192 = a191 + a193 = a192 + a194 = a193 + a195 = a194 + a196 = a195 + a197 = a196 + a198 = a197 + a199 = a198 + a200 = a199 + a201 = a200 + a202 = a201 + a203 = a202 + a204 = a203 + a205 = a204 + a206 = a205 + a207 = a206 + a208 = a207 + a209 = a208 + a210 = a209 + a211 = a210 + a212 = a211 + a213 = a212 + a214 = a213 + a215 = a214 + a216 = a215 + a217 = a216 + a218 = a217 + a219 = a218 + a220 = a219 + a221 = a220 + a222 = a221 + a223 = a222 + a224 = a223 + a225 = a224 + a226 = a225 + a227 = a226 + a228 = a227 + a229 = a228 + a230 = a229 + a231 = a230 + a232 = a231 + a233 = a232 + a234 = a233 + a235 = a234 + a236 = a235 + a237 = a236 + a238 = a237 + a239 = a238 + a240 = a239 + a241 = a240 + a242 = a241 + a243 = a242 + a244 = a243 + a245 = a244 + a246 = a245 + a247 = a246 + a248 = a247 + a249 = a248 + a250 = a249 + a251 = a250 + a252 = a251 + a253 = a252 + a254 = a253 + a255 = a254 + a256 = a255 + a257 = a256 + a258 = a257 + a259 = a258 + a260 = a259 + a261 = a260 + a262 = a261 + a263 = a262 + a264 = a263 + a265 = a264 + a266 = a265 + a267 = a266 + a268 = a267 + a269 = a268 + a270 = a269 + a271 = a270 + a272 = a271 + a273 = a272 + a274 = a273 + a275 = a274 + a276 = a275 + a277 = a276 + a278 = a277 + a279 = a278 + a280 = a279 + a281 = a280 + a282 = a281 + a283 = a282 + a284 = a283 + a285 = a284 + a286 = a285 + a287 = a286 + a288 = a287 + a289 = a288 + a290 = a289 + a291 = a290 + a292 = a291 + a293 = a292 + a294 = a293 + a295 = a294 + a296 = a295 + a297 = a296 + a298 = a297 + a299 = a298 + a300 = a299 + a301 = a300 + a302 = a301 + a303 = a302 + a304 = a303 + a305 = a304 + a306 = a305 + a307 = a306 + a308 = a307 + a309 = a308 + a310 = a309 + a311 = a310 + a312 = a311 + a313 = a312 + a314 = a313 + a315 = a314 + a316 = a315 + a317 = a316 + a318 = a317 + a319 = a318 + a320 = a319 + a321 = a320 + a322 = a321 + a323 = a322 + a324 = a323 + a325 = a324 + a326 = a325 + a327 = a326 + a328 = a327 + a329 = a328 + a330 = a329 + a331 = a330 + a332 = a331 + a333 = a332 + a334 = a333 + a335 = a334 + a336 = a335 + a337 = a336 + a338 = a337 + a339 = a338 + a340 = a339 + a341 = a340 + a342 = a341 + a343 = a342 + a344 = a343 + a345 = a344 + a346 = a345 + a347 = a346 + a348 = a347 + a349 = a348 + a350 = a349 + a351 = a350 + a352 = a351 + a353 = a352 + a354 = a353 + a355 = a354 + a356 = a355 + a357 = a356 + a358 = a357 + a359 = a358 + a360 = a359 + a361 = a360 + a362 = a361 + a363 = a362 + a364 = a363 + a365 = a364 + a366 = a365 + a367 = a366 + a368 = a367 + a369 = a368 + a370 = a369 + a371 = a370 + a372 = a371 + a373 = a372 + a374 = a373 + a375 = a374 + a376 = a375 + a377 = a376 + a378 = a377 + a379 = a378 + a380 = a379 + a381 = a380 + a382 = a381 + a383 = a382 + a384 = a383 + a385 = a384 + a386 = a385 + a387 = a386 + a388 = a387 + a389 = a388 + a390 = a389 + a391 = a390 + a392 = a391 + a393 = a392 + a394 = a393 + a395 = a394 + a396 = a395 + a397 = a396 + a398 = a397 + a399 = a398 + a400 = a399 + a401 = a400 + a402 = a401 + a403 = a402 + a404 = a403 + a405 = a404 + a406 = a405 + a407 = a406 + a408 = a407 + a409 = a408 + a410 = a409 + a411 = a410 + a412 = a411 + a413 = a412 + a414 = a413 + a415 = a414 + a416 = a415 + a417 = a416 + a418 = a417 + a419 = a418 + a420 = a419 + a421 = a420 + a422 = a421 + a423 = a422 + a424 = a423 + a425 = a424 + a426 = a425 + a427 = a426 + a428 = a427 + a429 = a428 + a430 = a429 + a431 = a430 + a432 = a431 + a433 = a432 + a434 = a433 + a435 = a434 + a436 = a435 + a437 = a436 + a438 = a437 + a439 = a438 + a440 = a439 + a441 = a440 + a442 = a441 + a443 = a442 + a444 = a443 + a445 = a444 + a446 = a445 + a447 = a446 + a448 = a447 + a449 = a448 + a450 = a449 + a451 = a450 + a452 = a451 + a453 = a452 + a454 = a453 + a455 = a454 + a456 = a455 + a457 = a456 + a458 = a457 + a459 = a458 + a460 = a459 + a461 = a460 + a462 = a461 + a463 = a462 + a464 = a463 + a465 = a464 + a466 = a465 + a467 = a466 + a468 = a467 + a469 = a468 + a470 = a469 + a471 = a470 + a472 = a471 + a473 = a472 + a474 = a473 + a475 = a474 + a476 = a475 + a477 = a476 + a478 = a477 + a479 = a478 + a480 = a479 + a481 = a480 + a482 = a481 + a483 = a482 + a484 = a483 + a485 = a484 + a486 = a485 + a487 = a486 + a488 = a487 + a489 = a488 + a490 = a489 + a491 = a490 + a492 = a491 + a493 = a492 + a494 = a493 + a495 = a494 + a496 = a495 + a497 = a496 + a498 = a497 in + a498 diff --git a/ghc/compiler/tests/rename/timing003.hs b/ghc/compiler/tests/rename/timing003.hs new file mode 100644 index 0000000000..201f4efa66 --- /dev/null +++ b/ghc/compiler/tests/rename/timing003.hs @@ -0,0 +1,506 @@ +--!!! 500 defns, not chained together + +a000 = [] +a001 = [] +a002 = [] +a003 = [] +a004 = [] +a005 = [] +a006 = [] +a007 = [] +a008 = [] +a009 = [] +a010 = [] +a011 = [] +a012 = [] +a013 = [] +a014 = [] +a015 = [] +a016 = [] +a017 = [] +a018 = [] +a019 = [] +a020 = [] +a021 = [] +a022 = [] +a023 = [] +a024 = [] +a025 = [] +a026 = [] +a027 = [] +a028 = [] +a029 = [] +a030 = [] +a031 = [] +a032 = [] +a033 = [] +a034 = [] +a035 = [] +a036 = [] +a037 = [] +a038 = [] +a039 = [] +a040 = [] +a041 = [] +a042 = [] +a043 = [] +a044 = [] +a045 = [] +a046 = [] +a047 = [] +a048 = [] +a049 = [] +a050 = [] +a051 = [] +a052 = [] +a053 = [] +a054 = [] +a055 = [] +a056 = [] +a057 = [] +a058 = [] +a059 = [] +a060 = [] +a061 = [] +a062 = [] +a063 = [] +a064 = [] +a065 = [] +a066 = [] +a067 = [] +a068 = [] +a069 = [] +a070 = [] +a071 = [] +a072 = [] +a073 = [] +a074 = [] +a075 = [] +a076 = [] +a077 = [] +a078 = [] +a079 = [] +a080 = [] +a081 = [] +a082 = [] +a083 = [] +a084 = [] +a085 = [] +a086 = [] +a087 = [] +a088 = [] +a089 = [] +a090 = [] +a091 = [] +a092 = [] +a093 = [] +a094 = [] +a095 = [] +a096 = [] +a097 = [] +a098 = [] +a099 = [] + +a100 = [] +a101 = [] +a102 = [] +a103 = [] +a104 = [] +a105 = [] +a106 = [] +a107 = [] +a108 = [] +a109 = [] +a110 = [] +a111 = [] +a112 = [] +a113 = [] +a114 = [] +a115 = [] +a116 = [] +a117 = [] +a118 = [] +a119 = [] +a120 = [] +a121 = [] +a122 = [] +a123 = [] +a124 = [] +a125 = [] +a126 = [] +a127 = [] +a128 = [] +a129 = [] +a130 = [] +a131 = [] +a132 = [] +a133 = [] +a134 = [] +a135 = [] +a136 = [] +a137 = [] +a138 = [] +a139 = [] +a140 = [] +a141 = [] +a142 = [] +a143 = [] +a144 = [] +a145 = [] +a146 = [] +a147 = [] +a148 = [] +a149 = [] +a150 = [] +a151 = [] +a152 = [] +a153 = [] +a154 = [] +a155 = [] +a156 = [] +a157 = [] +a158 = [] +a159 = [] +a160 = [] +a161 = [] +a162 = [] +a163 = [] +a164 = [] +a165 = [] +a166 = [] +a167 = [] +a168 = [] +a169 = [] +a170 = [] +a171 = [] +a172 = [] +a173 = [] +a174 = [] +a175 = [] +a176 = [] +a177 = [] +a178 = [] +a179 = [] +a180 = [] +a181 = [] +a182 = [] +a183 = [] +a184 = [] +a185 = [] +a186 = [] +a187 = [] +a188 = [] +a189 = [] +a190 = [] +a191 = [] +a192 = [] +a193 = [] +a194 = [] +a195 = [] +a196 = [] +a197 = [] +a198 = [] +a199 = [] + +a200 = [] +a201 = [] +a202 = [] +a203 = [] +a204 = [] +a205 = [] +a206 = [] +a207 = [] +a208 = [] +a209 = [] +a210 = [] +a211 = [] +a212 = [] +a213 = [] +a214 = [] +a215 = [] +a216 = [] +a217 = [] +a218 = [] +a219 = [] +a220 = [] +a221 = [] +a222 = [] +a223 = [] +a224 = [] +a225 = [] +a226 = [] +a227 = [] +a228 = [] +a229 = [] +a230 = [] +a231 = [] +a232 = [] +a233 = [] +a234 = [] +a235 = [] +a236 = [] +a237 = [] +a238 = [] +a239 = [] +a240 = [] +a241 = [] +a242 = [] +a243 = [] +a244 = [] +a245 = [] +a246 = [] +a247 = [] +a248 = [] +a249 = [] +a250 = [] +a251 = [] +a252 = [] +a253 = [] +a254 = [] +a255 = [] +a256 = [] +a257 = [] +a258 = [] +a259 = [] +a260 = [] +a261 = [] +a262 = [] +a263 = [] +a264 = [] +a265 = [] +a266 = [] +a267 = [] +a268 = [] +a269 = [] +a270 = [] +a271 = [] +a272 = [] +a273 = [] +a274 = [] +a275 = [] +a276 = [] +a277 = [] +a278 = [] +a279 = [] +a280 = [] +a281 = [] +a282 = [] +a283 = [] +a284 = [] +a285 = [] +a286 = [] +a287 = [] +a288 = [] +a289 = [] +a290 = [] +a291 = [] +a292 = [] +a293 = [] +a294 = [] +a295 = [] +a296 = [] +a297 = [] +a298 = [] +a299 = [] + +a300 = [] +a301 = [] +a302 = [] +a303 = [] +a304 = [] +a305 = [] +a306 = [] +a307 = [] +a308 = [] +a309 = [] +a310 = [] +a311 = [] +a312 = [] +a313 = [] +a314 = [] +a315 = [] +a316 = [] +a317 = [] +a318 = [] +a319 = [] +a320 = [] +a321 = [] +a322 = [] +a323 = [] +a324 = [] +a325 = [] +a326 = [] +a327 = [] +a328 = [] +a329 = [] +a330 = [] +a331 = [] +a332 = [] +a333 = [] +a334 = [] +a335 = [] +a336 = [] +a337 = [] +a338 = [] +a339 = [] +a340 = [] +a341 = [] +a342 = [] +a343 = [] +a344 = [] +a345 = [] +a346 = [] +a347 = [] +a348 = [] +a349 = [] +a350 = [] +a351 = [] +a352 = [] +a353 = [] +a354 = [] +a355 = [] +a356 = [] +a357 = [] +a358 = [] +a359 = [] +a360 = [] +a361 = [] +a362 = [] +a363 = [] +a364 = [] +a365 = [] +a366 = [] +a367 = [] +a368 = [] +a369 = [] +a370 = [] +a371 = [] +a372 = [] +a373 = [] +a374 = [] +a375 = [] +a376 = [] +a377 = [] +a378 = [] +a379 = [] +a380 = [] +a381 = [] +a382 = [] +a383 = [] +a384 = [] +a385 = [] +a386 = [] +a387 = [] +a388 = [] +a389 = [] +a390 = [] +a391 = [] +a392 = [] +a393 = [] +a394 = [] +a395 = [] +a396 = [] +a397 = [] +a398 = [] +a399 = [] + +a400 = [] +a401 = [] +a402 = [] +a403 = [] +a404 = [] +a405 = [] +a406 = [] +a407 = [] +a408 = [] +a409 = [] +a410 = [] +a411 = [] +a412 = [] +a413 = [] +a414 = [] +a415 = [] +a416 = [] +a417 = [] +a418 = [] +a419 = [] +a420 = [] +a421 = [] +a422 = [] +a423 = [] +a424 = [] +a425 = [] +a426 = [] +a427 = [] +a428 = [] +a429 = [] +a430 = [] +a431 = [] +a432 = [] +a433 = [] +a434 = [] +a435 = [] +a436 = [] +a437 = [] +a438 = [] +a439 = [] +a440 = [] +a441 = [] +a442 = [] +a443 = [] +a444 = [] +a445 = [] +a446 = [] +a447 = [] +a448 = [] +a449 = [] +a450 = [] +a451 = [] +a452 = [] +a453 = [] +a454 = [] +a455 = [] +a456 = [] +a457 = [] +a458 = [] +a459 = [] +a460 = [] +a461 = [] +a462 = [] +a463 = [] +a464 = [] +a465 = [] +a466 = [] +a467 = [] +a468 = [] +a469 = [] +a470 = [] +a471 = [] +a472 = [] +a473 = [] +a474 = [] +a475 = [] +a476 = [] +a477 = [] +a478 = [] +a479 = [] +a480 = [] +a481 = [] +a482 = [] +a483 = [] +a484 = [] +a485 = [] +a486 = [] +a487 = [] +a488 = [] +a489 = [] +a490 = [] +a491 = [] +a492 = [] +a493 = [] +a494 = [] +a495 = [] +a496 = [] +a497 = [] +a498 = [] +a499 = [] diff --git a/ghc/compiler/tests/simplCore/Jmakefile b/ghc/compiler/tests/simplCore/Jmakefile new file mode 100644 index 0000000000..06ea194fca --- /dev/null +++ b/ghc/compiler/tests/simplCore/Jmakefile @@ -0,0 +1,10 @@ +runtests:: + @echo '###############################################################' + @echo '# Validation tests for the simplifier. #' + @echo '###############################################################' + +FLAGS=-noC -O -ddump-simpl -dcore-lint + +/* 001 is really a desugarer test, but it is only tickled by the simplifier */ +RunStdTest(simpl001,$(GHC), $(FLAGS) simpl001.hs -o2 simpl001.stderr) +RunStdTest(simpl002,$(GHC), $(FLAGS) simpl002.hs -o2 simpl002.stderr) diff --git a/ghc/compiler/tests/simplCore/simpl001.hs b/ghc/compiler/tests/simplCore/simpl001.hs new file mode 100644 index 0000000000..99cf51d2ce --- /dev/null +++ b/ghc/compiler/tests/simplCore/simpl001.hs @@ -0,0 +1,11 @@ +--!!! Desugaring sections with function-type arguments +-- + +-- type Foo a b = a -> (b -> a) -> b + +(++++) :: (a -> (b -> a) -> b) -> (a -> (b -> a) -> b) -> a -> (b -> a) -> b +x ++++ y = y + +g a xs = map (++++ a) xs + +h b xs = map (b ++++) xs diff --git a/ghc/compiler/tests/simplCore/simpl001.stderr b/ghc/compiler/tests/simplCore/simpl001.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/simplCore/simpl001.stderr diff --git a/ghc/compiler/tests/simplCore/simpl002.hs b/ghc/compiler/tests/simplCore/simpl002.hs new file mode 100644 index 0000000000..206e8612d1 --- /dev/null +++ b/ghc/compiler/tests/simplCore/simpl002.hs @@ -0,0 +1,9 @@ +--!!! class/instance mumble that failed Lint at one time +-- +class Foo a where + op :: Int -> a -> Bool + +data Wibble a b c = MkWibble a b c + +instance (Foo a, Foo b, Foo c) => Foo (Wibble a b c) where + op x y = error "xxx" diff --git a/ghc/compiler/tests/simplCore/simpl002.stderr b/ghc/compiler/tests/simplCore/simpl002.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/simplCore/simpl002.stderr diff --git a/ghc/compiler/tests/stranal/default.lhs b/ghc/compiler/tests/stranal/default.lhs new file mode 100644 index 0000000000..010e8d557c --- /dev/null +++ b/ghc/compiler/tests/stranal/default.lhs @@ -0,0 +1,15 @@ +> data Boolean = FF | TT +> data Pair a b = MkPair a b +> data LList alpha = Nill | Conss alpha (LList alpha) +> data Nat = Zero | Succ Nat +> data Tree x = Leaf x | Node (Tree x) (Tree x) +> data A a = MkA a (A a) +> +> append :: LList a -> LList a -> LList a +> append xs ys = case xs of +> Conss z zs -> Conss z (append zs ys) +> v -> ys + + + + diff --git a/ghc/compiler/tests/stranal/fact.lhs b/ghc/compiler/tests/stranal/fact.lhs new file mode 100644 index 0000000000..2507c6b41a --- /dev/null +++ b/ghc/compiler/tests/stranal/fact.lhs @@ -0,0 +1,2 @@ +> fact :: Int -> Int +> fact n = if n==0 then 2 else (fact n) * n diff --git a/ghc/compiler/tests/stranal/fun.lhs b/ghc/compiler/tests/stranal/fun.lhs new file mode 100644 index 0000000000..d86208bcdd --- /dev/null +++ b/ghc/compiler/tests/stranal/fun.lhs @@ -0,0 +1,5 @@ +> data Fun = MkFun (Fun -> Fun) +> data LList a = Nill | Conss a (LList a) + +> id :: Fun -> Fun +> id f = f diff --git a/ghc/compiler/tests/stranal/goo.lhs b/ghc/compiler/tests/stranal/goo.lhs new file mode 100644 index 0000000000..ddf666b7f3 --- /dev/null +++ b/ghc/compiler/tests/stranal/goo.lhs @@ -0,0 +1,9 @@ +> data Goo a = Gsimpl | Gcompl ([Goo a]) +> data Moo a b = Msimple | Mcompl (Moo b a) + + +> idGoo :: Goo a -> Goo a +> idGoo x = x + +> idMoo :: Moo a -> Moo a +> idMoo x = x diff --git a/ghc/compiler/tests/stranal/ins.lhs b/ghc/compiler/tests/stranal/ins.lhs new file mode 100644 index 0000000000..120b46fab9 --- /dev/null +++ b/ghc/compiler/tests/stranal/ins.lhs @@ -0,0 +1,26 @@ +TEST OF DEFACTORISATION FOR FUNCTIONS THAT DROP + POLYMORPHIC VARIABLES + +> data Boolean = FF | TT +> data Pair a b = MkPair a b +> data LList alpha = Nill | Conss alpha (LList alpha) +> data Nat = Zero | Succ Nat +> data Tree x = Leaf x | Node (Tree x) (Tree x) +> data A a = MkA a (A a) +> +> append :: LList a -> LList a -> LList a +> append xs ys = case xs of +> Nill -> ys +> Conss z zs -> Conss z (append zs ys) + +The following function drops @b@. + +> flat :: Tree (Pair a b) -> LList a +> flat t = case t of +> Leaf (MkPair a b) -> Conss a Nill +> Node l r -> append (flat l) (flat r) +> +> fl :: Boolean -> LList Boolean +> fl x = flat (Leaf (MkPair TT Zero)) +> + diff --git a/ghc/compiler/tests/stranal/map.lhs b/ghc/compiler/tests/stranal/map.lhs new file mode 100644 index 0000000000..d79ec03c1b --- /dev/null +++ b/ghc/compiler/tests/stranal/map.lhs @@ -0,0 +1,31 @@ +> data Boolean = FF | TT +> data Pair a b = MkPair a b +> data LList alpha = Nill | Conss alpha (LList alpha) +> data Nat = Zero | Succ Nat +> data Tree x = Leaf x | Node (Tree x) (Tree x) +> data A a = MkA a (A a) + +> {- +> map :: (a -> b) -> [a] -> [b] +> map f xs = case xs of +> [] -> [] +> (y:ys) -> (f y):(map f ys) + +> map_ide :: [[a]] -> [[a]] +> map_ide = map (\x->x) +>-} + +> id :: a -> a +> id x = x + +> idNat :: Nat -> Nat +> idNat x = x + +> idBool :: Boolean -> Boolean +> idBool x = x + +> fun :: (a->b) -> a -> b +> fun f x = g f +> where +> g f = f x + diff --git a/ghc/compiler/tests/stranal/moo.lhs b/ghc/compiler/tests/stranal/moo.lhs new file mode 100644 index 0000000000..3d6226b8e2 --- /dev/null +++ b/ghc/compiler/tests/stranal/moo.lhs @@ -0,0 +1,5 @@ +> data Moo a b = Msimple | Mcompl (Moo b a) + + +> idMoo :: Moo a -> Moo a +> idMoo x = x diff --git a/ghc/compiler/tests/stranal/sim.lhs b/ghc/compiler/tests/stranal/sim.lhs new file mode 100644 index 0000000000..c788681f7f --- /dev/null +++ b/ghc/compiler/tests/stranal/sim.lhs @@ -0,0 +1,102 @@ +> data Boolean = FF | TT +> data Pair a b = MkPair a b +> data LList alpha = Nill | Conss alpha (LList alpha) +> data Nat = Zero | Succ Nat +> data Tree x = Leaf x | Node (Tree x) (Tree x) +> data A a = MkA a (A a) +>{- +> id :: a -> a +> id x = x +> +> idb :: Boolean -> Boolean +> idb b = b +> +> swap :: Pair a b -> Pair b a +> swap t = case t of +> MkPair x y -> MkPair y x +> +> bang :: A (A a) -> Boolean +> bang x = case x of +> MkA y ys -> TT +> +> neg :: Boolean -> Boolean +> neg b = case b of +> FF -> TT +> TT -> FF +> +> null :: LList x -> Boolean +> null l = case l of +> Nill -> TT +> _ -> FF +> +> loop :: Boolean -> a +> loop b = loop b +>-} +> idl :: LList a -> LList a +> idl xs = case xs of +> Conss y ys -> Conss y (idl ys) +> _ -> Nill +>{- +> idn :: Nat -> Nat +> idn n = case n of +> Zero -> Zero +> Succ m -> Succ (idn m) +> +> add :: Nat -> Nat -> Nat +> add a b = case a of +> Zero -> b +> Succ c -> Succ (add c b) +> +> length :: LList a -> Nat +> length xs = case xs of +> Nill -> Zero +> Conss y ys -> Succ(length ys) +> +> before :: LList Nat -> LList Nat +> before xs = case xs of +> Nill -> Nill +> Conss y ys -> case y of +> Zero -> Nill +> Succ n -> Conss y (before ys) +> +> reverse :: LList a -> LList a +> reverse rs = case rs of +> Nill -> Nill +> Conss y ys -> append (reverse ys) (Conss y Nill) +> +> f :: Nat -> Nat +> f n = case n of +> Zero -> Zero +> Succ m -> Succ (g m) +> +> g :: Nat -> Nat +> g n = case n of +> Zero -> Zero +> Succ m -> Succ (f m) +> +> append :: LList a -> LList a -> LList a +> append xs ys = case xs of +> Nill -> ys +> Conss z zs -> Conss z (append zs ys) +> +> flatten :: Tree alpha -> LList alpha +> flatten t = case t of +> Leaf x -> Conss x Nill +> Node l r -> append (flatten l) (flatten r) +> +> sum :: Tree Nat -> Nat +> sum t = case t of +> Leaf t -> t +> Node l r -> add (sum l) (sum r) +> +> suml :: LList Nat -> Nat +> suml Nill = Zero +> suml (Conss n ns) = add n (suml ns) +> +> map :: (a -> b) -> LList a -> LList b +> map f xs = case xs of +> Nill -> Nill +> Conss y ys -> Conss (f y) (map f ys) +>-} + + diff --git a/ghc/compiler/tests/stranal/syn.lhs b/ghc/compiler/tests/stranal/syn.lhs new file mode 100644 index 0000000000..00da926506 --- /dev/null +++ b/ghc/compiler/tests/stranal/syn.lhs @@ -0,0 +1,14 @@ +THIS TEST IS FOR TYPE SYNONIMS AND FACTORISATION IN THEIR PRESENCE. + +> data M a = A | B a (M a) +> data L a = N | C a (Syn a) +> type Syn b = L b +> +> idL :: L (Syn c) -> L (Syn c) +> idL N = N +> idL (C x l) = C x (idL l) +> +> idM:: M (L (Syn x)) -> M (L (Syn x)) +> idM A = A +> idM (B x l) = B (idL x) (idM l) + diff --git a/ghc/compiler/tests/stranal/test.lhs b/ghc/compiler/tests/stranal/test.lhs new file mode 100644 index 0000000000..d1e192593d --- /dev/null +++ b/ghc/compiler/tests/stranal/test.lhs @@ -0,0 +1,5 @@ +> data LList t = Nill | Conss t (LList t) +> data BBool = TTrue | FFalse + +> f Nill = TTrue +> f (Conss a as) = FFalse diff --git a/ghc/compiler/tests/stranal/tst.lhs b/ghc/compiler/tests/stranal/tst.lhs new file mode 100644 index 0000000000..535393532d --- /dev/null +++ b/ghc/compiler/tests/stranal/tst.lhs @@ -0,0 +1,2 @@ +> a :: [a] -> [[a]] +> a x = [x] diff --git a/ghc/compiler/tests/stranal/unu.lhs b/ghc/compiler/tests/stranal/unu.lhs new file mode 100644 index 0000000000..3932285908 --- /dev/null +++ b/ghc/compiler/tests/stranal/unu.lhs @@ -0,0 +1,75 @@ +> data Boolean = FF | TT +> data Pair a b = Mkpair a b +> data LList alpha = Nill | Conss alpha (LList alpha) +> data Nat = Zero | Succ Nat +> data Tree t = Leaf t | Node (Tree t) (Tree t) +> data A a = MkA a (A a) +> data Foo baz = MkFoo (Foo (Foo baz)) +>{- +> append1 :: LList a -> LList a -> LList a +> append1 xs ys = append2 xs +> where +> append2 xs = case xs of +> Nill -> ys +> Conss x xs -> Conss x (append3 xs) +> append3 xs = case xs of +> Nill -> ys +> Conss x xs -> Conss x (append2 xs) +> +> loop :: a -> a +> loop x = loop x +> +> hd :: LList b -> b +> hd Nill = loop +> hd (Conss y ys) = y +> +> hdb :: LList (LList b) -> LList b +> hdb = hd +> +> append :: [a] -> [a] -> [a] +> append [] ys = ys +> append (x:xs) ys = x:(append xs ys) +> +> f :: [a] -> [a] +> f y = append x (f y) +> where x = append x (f y) +>-} +> app :: LList a -> LList a -> LList a +> app Nill Nill = Nill +> app xs ys = case xs of +> Nill -> ys +> Conss z zs -> Conss z (app zs ys) +>{- +> app :: LList a -> LList a -> LList a +> app xs ys = case xs of +> Nill -> case ys of +> Nill -> Nill +> Conss u us -> ap +> Conss a as -> ap +> where ap = case xs of +> Nill -> ys +> Conss z zs -> Conss z (app zs ys) +> +> app :: LList a -> LList a -> LList a +> app xs ys = case xs of +> Nill -> case ys of +> Nill -> Nill +> Conss u us -> ap xs ys +> Conss a as -> ap xs ys +> +> ap xs ys = case xs of +> Nill -> ys +> Conss z zs -> Conss z (app zs ys) +> +> ap :: LList a -> LList a -> LList a +> ap xs ys = case xs of +> Nill -> ys +> Conss z zs -> Conss z (ap zs ys) +> +> app :: LList a -> LList a -> LList a +> app xs ys = case xs of +> Nill -> case ys of +> Nill -> Nill +> Conss u us -> ap xs ys +> Conss a as -> ap xs ys +>-} diff --git a/ghc/compiler/tests/typecheck/Jmakefile b/ghc/compiler/tests/typecheck/Jmakefile new file mode 100644 index 0000000000..a4ca9c760c --- /dev/null +++ b/ghc/compiler/tests/typecheck/Jmakefile @@ -0,0 +1,7 @@ +#define IHaveSubdirs + +SUBDIRS = /* TEMPORARILY OUT: check_mess */ \ + should_fail \ + /* TEMPORARILY OUT: test_exps */ \ + should_succeed \ + bugs diff --git a/ghc/compiler/tests/typecheck/should_fail/Digraph.hs b/ghc/compiler/tests/typecheck/should_fail/Digraph.hs new file mode 100644 index 0000000000..a52d489b2c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/Digraph.hs @@ -0,0 +1,56 @@ +--!!! trying to have a polymorphic type sig where inappropriate +-- +module Digraph where + +data MaybeErr val err = Succeeded val | Failed err deriving () + +type Edge vertex = (vertex, vertex) +type Cycle vertex = [vertex] + +stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]] + +stronglyConnComp es vs + = snd (span_tree (new_range reversed_edges) + ([],[]) + ( snd (dfs (new_range es) ([],[]) vs) ) + ) + where + -- *********** the offending type signature ************** + reversed_edges :: Eq v => [Edge v] + reversed_edges = map swap es + + -- WRONGOLA: swap :: Eq v => Edge v -> Edge v + swap (x,y) = (y, x) + + -- WRONGOLA?: new_range :: Eq v => [Edge v] -> v -> [v] + + new_range [] w = [] + new_range ((x,y):xys) w + = if x==w + then (y : (new_range xys w)) + else (new_range xys w) + + {- WRONGOLA?: + span_tree :: Eq v => (v -> [v]) + -> ([v], [[v]]) + -> [v] + -> ([v], [[v]]) + -} + + span_tree r (vs,ns) [] = (vs,ns) + span_tree r (vs,ns) (x:xs) + | x `elem` vs = span_tree r (vs,ns) xs + | otherwise = span_tree r (vs',(x:ns'):ns) xs + where + (vs',ns') = dfs r (x:vs,[]) (r x) + +dfs :: Eq v => (v -> [v]) + -> ([v], [v]) + -> [v] + -> ([v], [v]) + +dfs r (vs,ns) [] = (vs,ns) +dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs + | otherwise = dfs r (vs',(x:ns')++ns) xs + where + (vs',ns') = dfs r (x:vs,[]) (r x) diff --git a/ghc/compiler/tests/typecheck/should_fail/Digraph.stderr b/ghc/compiler/tests/typecheck/should_fail/Digraph.stderr new file mode 100644 index 0000000000..a61101ca92 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/Digraph.stderr @@ -0,0 +1,8 @@ + +"Digraph.hs", line 19: Type signature is too polymorphic: + Signature: [Edge v] + Monomorphic type variables: v + In a type signature: [Edge v] +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/Jmakefile b/ghc/compiler/tests/typecheck/should_fail/Jmakefile new file mode 100644 index 0000000000..8ab9db4f71 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/Jmakefile @@ -0,0 +1,78 @@ +TEST_FLAGS=-noC -ddump-tc + +RunStdTest(tcfail001,$(GHC),$(TEST_FLAGS) tcfail001.hs -x1 -o2 tcfail001.stderr) +RunStdTest(tcfail002,$(GHC),$(TEST_FLAGS) tcfail002.hs -x1 -o2 tcfail002.stderr) +RunStdTest(tcfail003,$(GHC),$(TEST_FLAGS) tcfail003.hs -x1 -o2 tcfail003.stderr) +RunStdTest(tcfail004,$(GHC),$(TEST_FLAGS) tcfail004.hs -x1 -o2 tcfail004.stderr) +RunStdTest(tcfail005,$(GHC),$(TEST_FLAGS) tcfail005.hs -x1 -o2 tcfail005.stderr) +RunStdTest(tcfail006,$(GHC),$(TEST_FLAGS) tcfail006.hs -x1 -o2 tcfail006.stderr) +RunStdTest(tcfail007,$(GHC),$(TEST_FLAGS) tcfail007.hs -x1 -o2 tcfail007.stderr) +RunStdTest(tcfail008,$(GHC),$(TEST_FLAGS) tcfail008.hs -x1 -o2 tcfail008.stderr) +RunStdTest(tcfail009,$(GHC),$(TEST_FLAGS) tcfail009.hs -x1 -o2 tcfail009.stderr) + +RunStdTest(tcfail010,$(GHC),$(TEST_FLAGS) tcfail010.hs -x1 -o2 tcfail010.stderr) +RunStdTest(tcfail011,$(GHC),$(TEST_FLAGS) tcfail011.hs -x1 -o2 tcfail011.stderr) +RunStdTest(tcfail012,$(GHC),$(TEST_FLAGS) tcfail012.hs -x1 -o2 tcfail012.stderr) +RunStdTest(tcfail013,$(GHC),$(TEST_FLAGS) tcfail013.hs -x1 -o2 tcfail013.stderr) +RunStdTest(tcfail014,$(GHC),$(TEST_FLAGS) tcfail014.hs -x1 -o2 tcfail014.stderr) +RunStdTest(tcfail015,$(GHC),$(TEST_FLAGS) tcfail015.hs -x1 -o2 tcfail015.stderr) +RunStdTest(tcfail016,$(GHC),$(TEST_FLAGS) tcfail016.hs -x1 -o2 tcfail016.stderr) +RunStdTest(tcfail017,$(GHC),$(TEST_FLAGS) tcfail017.hs -x1 -o2 tcfail017.stderr) +RunStdTest(tcfail018,$(GHC),$(TEST_FLAGS) tcfail018.hs -x1 -o2 tcfail018.stderr) +RunStdTest(tcfail019,$(GHC),$(TEST_FLAGS) tcfail019.hs -x1 -o2 tcfail019.stderr) + +RunStdTest(tcfail020,$(GHC),$(TEST_FLAGS) tcfail020.hs -x1 -o2 tcfail020.stderr) +RunStdTest(tcfail021,$(GHC),$(TEST_FLAGS) tcfail021.hs -x1 -o2 tcfail021.stderr) +RunStdTest(tcfail022,$(GHC),$(TEST_FLAGS) tcfail022.hs -x1 -o2 tcfail022.stderr) +RunStdTest(tcfail023,$(GHC),$(TEST_FLAGS) tcfail023.hs -x1 -o2 tcfail023.stderr) +RunStdTest(tcfail024,$(GHC),$(TEST_FLAGS) tcfail024.hs -x1 -o2 tcfail024.stderr) +RunStdTest(tcfail025,$(GHC),$(TEST_FLAGS) tcfail025.hs -x1 -o2 tcfail025.stderr) +RunStdTest(tcfail026,$(GHC),$(TEST_FLAGS) tcfail026.hs -x1 -o2 tcfail026.stderr) +RunStdTest(tcfail027,$(GHC),$(TEST_FLAGS) tcfail027.hs -x1 -o2 tcfail027.stderr) +RunStdTest(tcfail028,$(GHC),$(TEST_FLAGS) tcfail028.hs -x1 -o2 tcfail028.stderr) +RunStdTest(tcfail029,$(GHC),$(TEST_FLAGS) tcfail029.hs -x1 -o2 tcfail029.stderr) + +RunStdTest(tcfail030,$(GHC),$(TEST_FLAGS) tcfail030.hs -x1 -o2 tcfail030.stderr) +RunStdTest(tcfail031,$(GHC),$(TEST_FLAGS) tcfail031.hs -x1 -o2 tcfail031.stderr) +RunStdTest(tcfail032,$(GHC),$(TEST_FLAGS) tcfail032.hs -x1 -o2 tcfail032.stderr) +RunStdTest(tcfail033,$(GHC),$(TEST_FLAGS) tcfail033.hs -x1 -o2 tcfail033.stderr) +RunStdTest(tcfail034,$(GHC),$(TEST_FLAGS) tcfail034.hs -x1 -o2 tcfail034.stderr) +RunStdTest(tcfail035,$(GHC),$(TEST_FLAGS) tcfail035.hs -x1 -o2 tcfail035.stderr) +RunStdTest(tcfail036,$(GHC),$(TEST_FLAGS) tcfail036.hs -x1 -o2 tcfail036.stderr) +RunStdTest(tcfail037,$(GHC),$(TEST_FLAGS) tcfail037.hs -x1 -o2 tcfail037.stderr) +RunStdTest(tcfail038,$(GHC),$(TEST_FLAGS) tcfail038.hs -x1 -o2 tcfail038.stderr) +RunStdTest(tcfail039,$(GHC),$(TEST_FLAGS) tcfail039.hs -x1 -o2 tcfail039.stderr) + +RunStdTest(tcfail040,$(GHC),$(TEST_FLAGS) tcfail040.hs -x1 -o2 tcfail040.stderr) +RunStdTest(tcfail041,$(GHC),$(TEST_FLAGS) tcfail041.hs -x1 -o2 tcfail041.stderr) +RunStdTest(tcfail042,$(GHC),$(TEST_FLAGS) tcfail042.hs -x1 -o2 tcfail042.stderr) +RunStdTest(tcfail043,$(GHC),$(TEST_FLAGS) tcfail043.hs -x1 -o2 tcfail043.stderr) +RunStdTest(tcfail044,$(GHC),$(TEST_FLAGS) tcfail044.hs -x1 -o2 tcfail044.stderr) +RunStdTest(tcfail045,$(GHC),$(TEST_FLAGS) -fglasgow-exts tcfail045.hs -x1 -o2 tcfail045.stderr) +RunStdTest(tcfail046,$(GHC),$(TEST_FLAGS) tcfail046.hs -x1 -o2 tcfail046.stderr) +RunStdTest(tcfail047,$(GHC),$(TEST_FLAGS) tcfail047.hs -x1 -o2 tcfail047.stderr) +RunStdTest(tcfail048,$(GHC),$(TEST_FLAGS) tcfail048.hs -x1 -o2 tcfail048.stderr) +RunStdTest(tcfail049,$(GHC),$(TEST_FLAGS) tcfail049.hs -x1 -o2 tcfail049.stderr) + +RunStdTest(tcfail050,$(GHC),$(TEST_FLAGS) tcfail050.hs -x1 -o2 tcfail050.stderr) +RunStdTest(tcfail051,$(GHC),$(TEST_FLAGS) tcfail051.hs -x1 -o2 tcfail051.stderr) +RunStdTest(tcfail052,$(GHC),$(TEST_FLAGS) tcfail052.hs -x1 -o2 tcfail052.stderr) +RunStdTest(tcfail053,$(GHC),$(TEST_FLAGS) tcfail053.hs -x1 -o2 tcfail053.stderr) +RunStdTest(tcfail054,$(GHC),$(TEST_FLAGS) tcfail054.hs -x1 -o2 tcfail054.stderr) +RunStdTest(tcfail055,$(GHC),$(TEST_FLAGS) tcfail055.hs -x1 -o2 tcfail055.stderr) +RunStdTest(tcfail056,$(GHC),$(TEST_FLAGS) tcfail056.hs -x1 -o2 tcfail056.stderr) +RunStdTest(tcfail057,$(GHC),$(TEST_FLAGS) tcfail057.hs -x1 -o2 tcfail057.stderr) +RunStdTest(tcfail058,$(GHC),$(TEST_FLAGS) tcfail058.hs -x1 -o2 tcfail058.stderr) +RunStdTest(tcfail059,$(GHC),$(TEST_FLAGS) -hi tcfail059.hs -x1 -o2 tcfail059.stderr) + +RunStdTest(tcfail060,$(GHC),$(TEST_FLAGS) -hi tcfail060.hs -x1 -o2 tcfail060.stderr) +RunStdTest(tcfail061,$(GHC),$(TEST_FLAGS) -hi tcfail061.hs -x1 -o2 tcfail061.stderr) +RunStdTest(tcfail062,$(GHC),$(TEST_FLAGS) -hi tcfail062.hs -x1 -o2 tcfail062.stderr) +RunStdTest(tcfail063,$(GHC),$(TEST_FLAGS) -hi tcfail063.hs -x1 -o2 tcfail063.stderr) +RunStdTest(tcfail064,$(GHC),$(TEST_FLAGS) -hi Fail064.hs -x1 -o2 tcfail064.stderr) +RunStdTest(tcfail065,$(GHC),$(TEST_FLAGS) -hi tcfail065.hs -x1 -o2 tcfail065.stderr) +RunStdTest(tcfail066,$(GHC),$(TEST_FLAGS) -hi tcfail066.hs -x1 -o2 tcfail066.stderr) +RunStdTest(tcfail067,$(GHC),$(TEST_FLAGS) -hi tcfail067.hs -x1 -o2 tcfail067.stderr) +RunStdTest(tcfail068,$(GHC) -fglasgow-exts,$(TEST_FLAGS) -hi tcfail068.hs -x1 -o2 tcfail068.stderr) + +RunStdTest(Digraph,$(GHC),$(TEST_FLAGS) Digraph.hs -x1 -o2 Digraph.stderr) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail001.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail001.hs new file mode 100644 index 0000000000..4e4ae932f5 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail001.hs @@ -0,0 +1,8 @@ +--!!! This should fail with a type error: the instance method +--!!! has a function type when it should have the type [a]. + +class A a where + op :: a + +instance (A a, A a) => A [a] where + op [] = [] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail001.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail001.stderr new file mode 100644 index 0000000000..bb40cb4d32 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail001.stderr @@ -0,0 +1,8 @@ + +"tcfail001.hs", line 8: + Couldn't match type "[tt5] -> [tt6]" against "[a]". + Inside a function binding: + op ... [] = [] +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail002.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail002.hs new file mode 100644 index 0000000000..b1fdd165b4 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail002.hs @@ -0,0 +1,4 @@ +module ShouldFail where + +c (x:y) = x +c z = z diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail002.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail002.stderr new file mode 100644 index 0000000000..449dd5c40f --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail002.stderr @@ -0,0 +1,9 @@ + +"tcfail002.hs", line 3: + Type variable "tt4" occurs within the type "[tt4]". + Inside two equations or case alternatives: + ... (x : y) -> x + ... z -> z +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail003.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail003.hs new file mode 100644 index 0000000000..8458014c1b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail003.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +(d:e) = [1,'a'] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail003.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail003.stderr new file mode 100644 index 0000000000..b875b06797 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail003.stderr @@ -0,0 +1,6 @@ + +"tcfail003.hs", line 3: No such instance: + class "Num", type "Char" (at an overloaded literal: 1) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail004.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail004.hs new file mode 100644 index 0000000000..513680bd12 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail004.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +(f,g) = (1,2,3) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail004.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail004.stderr new file mode 100644 index 0000000000..6272111274 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail004.stderr @@ -0,0 +1,8 @@ + +"tcfail004.hs", line 3: + Couldn't match type "(ot0, ot1)" against "(tt6, tt8, tt10)". + In a pattern binding: + (f, g) = (1, 2, 3) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail005.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail005.hs new file mode 100644 index 0000000000..ca211e1216 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail005.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +(h:i) = (1,'a') diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail005.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail005.stderr new file mode 100644 index 0000000000..f3c1a12425 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail005.stderr @@ -0,0 +1,8 @@ + +"tcfail005.hs", line 3: + Couldn't match type "[tt4]" against "(tt5, Char)". + In a pattern binding: + (h : i) = (1, 'a') +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail006.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail006.hs new file mode 100644 index 0000000000..37fd1f9c35 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail006.hs @@ -0,0 +1,5 @@ +module ShouldFail where + +(j,k) = case (if True then True else False) of + True -> (True,1) + False -> (1,True) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail006.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail006.stderr new file mode 100644 index 0000000000..122557ca65 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail006.stderr @@ -0,0 +1,6 @@ + +"tcfail006.hs", line 5: No such instance: + class "Num", type "Bool" (at an overloaded literal: 1) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail007.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail007.hs new file mode 100644 index 0000000000..ee24983aff --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail007.hs @@ -0,0 +1,4 @@ +module ShouldFail where + +n x | True = x+1 + | False = True diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail007.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail007.stderr new file mode 100644 index 0000000000..207597e1c1 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail007.stderr @@ -0,0 +1,6 @@ + +"tcfail007.hs", line 4: No such instance: + class "Num", type "Bool" (at an overloaded literal: 1) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail008.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail008.hs new file mode 100644 index 0000000000..dbc9d0c911 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail008.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +o = 1:2 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail008.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail008.stderr new file mode 100644 index 0000000000..c4a2f198f2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail008.stderr @@ -0,0 +1,6 @@ + +"tcfail008.hs", line 3: No such instance: + class "Num", type "[tt3]" (at an overloaded literal: 2) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail009.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail009.hs new file mode 100644 index 0000000000..e8afa0fbf7 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail009.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +p = [(1::Int)..(2::Integer)] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail009.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail009.stderr new file mode 100644 index 0000000000..86760a4df1 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail009.stderr @@ -0,0 +1,7 @@ + +"tcfail009.hs", line 3: + Couldn't match type "Integer" against "Int". + In an arithmetic sequence: [ (1 :: Int) .. (2 :: Integer) ] +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail010.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail010.hs new file mode 100644 index 0000000000..8b793355da --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail010.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +q = \ (y:z) -> z+2 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail010.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail010.stderr new file mode 100644 index 0000000000..46c8072d1d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail010.stderr @@ -0,0 +1,6 @@ + +"tcfail010.hs", line 3: No such instance: + class "Num", type "[tt4]" (at a use of an overloaded identifier: +) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail011.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail011.hs new file mode 100644 index 0000000000..89f5c4bcd1 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail011.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +z = \y -> x x where x = y diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail011.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail011.stderr new file mode 100644 index 0000000000..9ec109e128 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail011.stderr @@ -0,0 +1,5 @@ + +"tcfail011.hs", line 3: undefined value: y +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail012.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail012.hs new file mode 100644 index 0000000000..67e5fa0256 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail012.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +True = [] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail012.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail012.stderr new file mode 100644 index 0000000000..c1bb07e7dc --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail012.stderr @@ -0,0 +1,8 @@ + +"tcfail012.hs", line 3: + Couldn't match type "Bool" against "[tt0]". + In a pattern binding: + True = [] +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail013.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail013.hs new file mode 100644 index 0000000000..c9ccc52a64 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail013.hs @@ -0,0 +1,4 @@ +module ShouldFail where + +f [] = 1 +f True = 2 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail013.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail013.stderr new file mode 100644 index 0000000000..81b18dd3ea --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail013.stderr @@ -0,0 +1,9 @@ + +"tcfail013.hs", line 3: + Couldn't match type "[tt2]" against "Bool". + Inside two equations or case alternatives: + ... [] -> 1 + ... True -> 2 +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail014.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail014.hs new file mode 100644 index 0000000000..7d9169936d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail014.hs @@ -0,0 +1,5 @@ +module ShouldFail where + +f x = g+1 + where g y = h+2 + where h z = z z diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail014.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail014.stderr new file mode 100644 index 0000000000..c9390b2520 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail014.stderr @@ -0,0 +1,10 @@ + +"tcfail014.hs", line 5: + Type variable "ot8" occurs within the type "ot8 -> ot9". + Too many arguments in application of function "z" + +"tcfail014.hs", line 6: No such instance: + class "Num", type "tt19 -> tt20" (at an overloaded literal: 1) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail015.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail015.hs new file mode 100644 index 0000000000..ae929e3973 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail015.hs @@ -0,0 +1,9 @@ +module ShouldFail where + +data AList a = ANull | ANode a (AList a) + +type IntList = AList Int + +g (ANull) = 2 +g (ANode b (ANode c d)) | b = c+1 + | otherwise = 4 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail015.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail015.stderr new file mode 100644 index 0000000000..446381815d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail015.stderr @@ -0,0 +1,6 @@ + +"tcfail015.hs", line 7: No such instance: + class "Num", type "Bool" (at an overloaded literal: 2) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail016.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail016.hs new file mode 100644 index 0000000000..2dfd4a50e0 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail016.hs @@ -0,0 +1,9 @@ +module ShouldFail where + +type AnnExpr a = (a,Expr a) + +data Expr a = Var [Char] + | App (AnnExpr a) (AnnExpr a) + +g (Var name) = [name] +g (App e1 e2) = (g e1)++(g e2) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail016.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail016.stderr new file mode 100644 index 0000000000..9d2fc284b3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail016.stderr @@ -0,0 +1,11 @@ + +"tcfail016.hs", line 8: + Couldn't match type "(a, Expr a)" against "Expr a". + Inside a function binding: + g ... (Var name) + = [name] + (App e1 e2) + = (g e1) ++ (g e2) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail017.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail017.hs new file mode 100644 index 0000000000..db3215dc19 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail017.hs @@ -0,0 +1,13 @@ + +module ShouldFail where + +class C a where + op1 :: a -> a + +class (C a) => B a where + op2 :: a -> a -> a + +instance (B a) => B [a] where + op2 xs ys = xs + + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail017.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail017.stderr new file mode 100644 index 0000000000..2c17257da3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail017.stderr @@ -0,0 +1,6 @@ + +"tcfail017.hs", line 11: No such instance: + class "C", type "[a]" (at an instance declaration) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail018.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail018.hs new file mode 100644 index 0000000000..d91306ac55 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail018.hs @@ -0,0 +1,5 @@ + + +module ShouldSucc where + +(a:[]) = 1 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail018.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail018.stderr new file mode 100644 index 0000000000..7f564f4551 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail018.stderr @@ -0,0 +1,6 @@ + +"tcfail018.hs", line 5: No such instance: + class "Num", type "[tt3]" (at an overloaded literal: 1) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail019.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail019.hs new file mode 100644 index 0000000000..b3da9cdebc --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail019.hs @@ -0,0 +1,21 @@ + +module P where + +class A a where + p1 :: a -> a + p2 :: a -> a -> a + +class (A b) => B b where + p3 :: b + p4 :: b -> b + +class (A c) => C c where + p5 :: c -> c + p6 :: c -> Int + +class (B d,C d) => D d where + p7 :: d -> d + +instance D [a] where + p7 l = [] + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail019.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail019.stderr new file mode 100644 index 0000000000..7ac11dc089 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail019.stderr @@ -0,0 +1,6 @@ + +"tcfail019.hs", line 20: No such instance: + class "B", type "[a]" (at an instance declaration) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail020.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail020.hs new file mode 100644 index 0000000000..9697838fb1 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail020.hs @@ -0,0 +1,17 @@ + +module P where + +class A a where + p1 :: a -> a + p2 :: a -> a -> a + +class (A b) => B b where + p3 :: b + +instance (A a) => B [a] where + p3 = [] + +data X = XC --, causes stack dump + +--instance B Bool where +-- p3 = True diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail020.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail020.stderr new file mode 100644 index 0000000000..760faeeee5 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail020.stderr @@ -0,0 +1,6 @@ + +"tcfail020.hs", line 12: No such instance: + class "A", type "[a]" (at an instance declaration) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail021.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail021.hs new file mode 100644 index 0000000000..6afdea7920 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail021.hs @@ -0,0 +1,2 @@ + +f x x = 2 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail021.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail021.stderr new file mode 100644 index 0000000000..8b4e139c3d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail021.stderr @@ -0,0 +1,6 @@ + +"tcfail021.hs", line 2: multiple declarations of variable in pattern: + x ( "tcfail021.hs", line 2, "tcfail021.hs", line 2) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail022.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail022.hs new file mode 100644 index 0000000000..d5e51ed4fd --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail022.hs @@ -0,0 +1,6 @@ + +f x = 2 + +g x = 6 + +f x = 3 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail022.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail022.stderr new file mode 100644 index 0000000000..277f09ddb7 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail022.stderr @@ -0,0 +1,6 @@ + +"tcfail022.hs", line 2: multiple declarations of variable: + f ( "tcfail022.hs", line 2, "tcfail022.hs", line 6) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail023.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail023.hs new file mode 100644 index 0000000000..ae2a356461 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail023.hs @@ -0,0 +1,13 @@ + +data B = C + +class A a where + op :: a -> a + +instance A B where + op C = True + +instance A B where + op C = True + + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail023.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail023.stderr new file mode 100644 index 0000000000..52dd9fafcb --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail023.stderr @@ -0,0 +1,11 @@ + +"tcfail023.hs", line 8: Duplicate/overlapping instances: + class "A", type "B"; at "tcfail023.hs", line 8 and "tcfail023.hs", line 11 + +"tcfail023.hs", line 11: + Couldn't match type "Bool" against "B". + Inside a function binding: + op ... C = True +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail024.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail024.hs new file mode 100644 index 0000000000..3dc567811b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail024.hs @@ -0,0 +1,4 @@ + +data F = A | B + +data G = A | C diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail024.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail024.stderr new file mode 100644 index 0000000000..f48129d8ab --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail024.stderr @@ -0,0 +1,6 @@ + +"tcfail024.hs", line 2: multiple declarations of variable: + A ( "tcfail024.hs", line 2, "tcfail024.hs", line 4) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail025.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail025.hs new file mode 100644 index 0000000000..b342618e15 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail025.hs @@ -0,0 +1,6 @@ + +type A = Int + +type B = Bool + +type A = [Bool] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail025.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail025.stderr new file mode 100644 index 0000000000..02efd9b3ef --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail025.stderr @@ -0,0 +1,6 @@ + +"tcfail025.hs", line 6: multiple declarations of type synonym: + A ( "tcfail025.hs", line 6, "tcfail025.hs", line 2) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail026.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail026.hs new file mode 100644 index 0000000000..725b0d1632 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail026.hs @@ -0,0 +1,9 @@ + +class A a where + op1 :: a + +class B a where + op2 :: b -> b + +class A a where + op3 :: a diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail026.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail026.stderr new file mode 100644 index 0000000000..950e459f8d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail026.stderr @@ -0,0 +1,6 @@ + +"tcfail026.hs", line 9: multiple declarations of class: + A ( "tcfail026.hs", line 9, "tcfail026.hs", line 3) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail027.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail027.hs new file mode 100644 index 0000000000..b80430ba26 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail027.hs @@ -0,0 +1,7 @@ +--!!! tests for CycleErr in classes + +class (B a) => A a where + op1 :: a -> a + +class (A a) => B a where + op2 :: a -> a -> a diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail027.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail027.stderr new file mode 100644 index 0000000000..e86e6abcdc --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail027.stderr @@ -0,0 +1,7 @@ + +The following classes form a cycle: + "tcfail027.hs", line 4: A + "tcfail027.hs", line 7: B +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail028.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail028.hs new file mode 100644 index 0000000000..8e8c2946a0 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail028.hs @@ -0,0 +1,3 @@ +--!!! tests for ArityErr + +data A a b = B (A a) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail028.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail028.stderr new file mode 100644 index 0000000000..edc5403ae7 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail028.stderr @@ -0,0 +1,6 @@ + +"tcfail028.hs", line 3: Type has too few arguments: + "A" should have 2 argument(s), but has been given 1 argument(s) instead +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail029.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail029.hs new file mode 100644 index 0000000000..312e6fee47 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail029.hs @@ -0,0 +1,5 @@ +--!!! tests for InstOpErr + +data Foo = Bar | Baz + +f x = x > Bar diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail029.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail029.stderr new file mode 100644 index 0000000000..2ba72506be --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail029.stderr @@ -0,0 +1,6 @@ + +"tcfail029.hs", line 5: No such instance: + class "Ord", type "Foo" (at a use of an overloaded identifier: >) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail030.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail030.hs new file mode 100644 index 0000000000..2aa8659940 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail030.hs @@ -0,0 +1 @@ +--!!! empty file diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail030.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail030.stderr new file mode 100644 index 0000000000..72c2f6f06c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail030.stderr @@ -0,0 +1,3 @@ +Typechecked: + + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail031.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail031.hs new file mode 100644 index 0000000000..c81ced8229 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail031.hs @@ -0,0 +1,2 @@ + +f x = if 'a' then 1 else 2 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail031.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail031.stderr new file mode 100644 index 0000000000..5f304ee250 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail031.stderr @@ -0,0 +1,6 @@ + +"tcfail031.hs", line 2: + Couldn't match type "Char" against "Bool". In a predicate expression: 'a' +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail032.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail032.hs new file mode 100644 index 0000000000..0e8884da3f --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail032.hs @@ -0,0 +1,16 @@ +{- This test gives the following not-very-wonderful error message. + + "tc_sig.hs", line 3: Type signature does not match the inferred type: + Signature: t76 -> Int + Inferred type: t75 + +It *is* an error, because x does not have the polytype + forall a. Eq a => a -> Int +becuase it is monomorphic, but the error message isn't very illuminating. +-} + +module TcSig where + +f x = (x :: (Eq a) => a -> Int) + + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail032.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail032.stderr new file mode 100644 index 0000000000..53fee2da11 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail032.stderr @@ -0,0 +1,8 @@ + +"tcfail032.hs", line 14: Type signature is too polymorphic: + Signature: a -> Int + Monomorphic type variables: a + In an expression with a type signature: x:: a -> Int +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail033.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail033.hs new file mode 100644 index 0000000000..5c8b4d8e7e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail033.hs @@ -0,0 +1,3 @@ +-- from Jon Hill + +buglet = [ x | (x,y) <- buglet ] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail033.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail033.stderr new file mode 100644 index 0000000000..b441c25d9f --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail033.stderr @@ -0,0 +1,8 @@ + +"tcfail033.hs", line 3: + Type variable "tt2" occurs within the type "(tt2, tt3)". + In a pattern binding: + buglet = [ x | (x, y) <- buglet ] +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail034.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail034.hs new file mode 100644 index 0000000000..e0d0ffeace --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail034.hs @@ -0,0 +1,37 @@ +{- +From: Jon Hill <hilly@dcs.qmw.ac.uk@jess.gla.ac.uk@pp.dcs.glasgow.ac.uk> +To: glasgow-haskell-bugs +Subject: Unfriendly error message +Date: Thu, 25 Jun 1992 09:22:55 +0100 + +Hello again, + +I came across a rather nasty error message when I gave a function an +incorrect type signature (the context is wrong). I can remember reading +in the source about this problem - I just thought I'd let you know anyway :-) +-} + +test::(Num a, Eq a) => a -> Bool +test x = (x `mod` 3) == 0 + +{- +granite> ndph bug002.ldh +Data Parallel Haskell Compiler, version 0.01 (Glasgow 0.07) + + +"<unknown>", line <unknown>: Cannot express dicts in terms of dictionaries available: +dicts_encl: + "<built-in>", line : dict.87 :: <Num a> + "<built-in>", line : dict.88 :: <Eq a> +dicts_encl': + "<built-in>", line : dict.87 :: <Num a> + "<built-in>", line : dict.88 :: <Eq a> +dicts: + "<built-in>", line : dict.87 :: <Num a> + "<built-in>", line : dict.88 :: <Eq a> +super_class_dict: "<built-in>", line : dict.80 :: <Integral a> +Fail: Compilation errors found + +dph: execution of the Haskell compiler had trouble + +-} diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail034.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail034.stderr new file mode 100644 index 0000000000..db6fbf45e3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail034.stderr @@ -0,0 +1,7 @@ + +These overloadings don't match type signature: + "tcfail034.hs", line 15; class "Integral", type "a" + (at a use of an overloaded identifier: mod) +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail035.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail035.hs new file mode 100644 index 0000000000..a0b9f0ee56 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail035.hs @@ -0,0 +1,9 @@ +--!!! instances with empty where parts: duplicate +-- +module M where + +data NUM = ONE | TWO +instance Num NUM +instance Num NUM +instance Eq NUM +instance Text NUM diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail035.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail035.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail035.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail036.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail036.hs new file mode 100644 index 0000000000..eb9f9aff85 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail036.hs @@ -0,0 +1,10 @@ +--!!! prelude class name in an instance-tycon position +-- +module M where + +data NUM = ONE | TWO +instance Num NUM + where ONE + ONE = TWO +instance Num NUM +instance Eq Num +--instance Text Num diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail036.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail036.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail036.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail037.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail037.hs new file mode 100644 index 0000000000..07b308b98c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail037.hs @@ -0,0 +1,11 @@ +--!!! PreludeCore entities cannot be redefined at the top-level +-- +module M where + +data NUM = ONE | TWO + +f a b = a + b +f :: NUM -> NUM -> NUM + +ONE + ONE = TWO + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail037.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail037.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail037.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail038.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail038.hs new file mode 100644 index 0000000000..7d03529a4e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail038.hs @@ -0,0 +1,11 @@ +--!!! duplicate class-method declarations + +module M where + +data NUM = ONE | TWO +instance Eq NUM where + a == b = True + a /= b = False + a == b = False + a /= b = True + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail038.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail038.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail038.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail039.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail039.hs new file mode 100644 index 0000000000..f0df10c287 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail039.hs @@ -0,0 +1,12 @@ +--!!! bogus re-use of prelude class-method name (==) +-- +module M where + +data NUM = ONE | TWO +class EQ a where + (==) :: a -> a -> Bool + +instance EQ NUM +-- a /= b = False +-- a == b = True +-- a /= b = False diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail039.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail039.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail039.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail040.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail040.hs new file mode 100644 index 0000000000..c611518ee4 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail040.hs @@ -0,0 +1,29 @@ +--!!! instances of functions +-- +module M where + +data NUM = ONE | TWO + +class EQ a where + (===) :: a -> a -> Bool + +class ORD a where + (<<) :: a -> a -> Bool + a << b = True + +instance EQ (a -> b) where + f === g = True + +instance ORD (a -> b) + +f = (<<) === (<<) +--f :: (EQ a,Num a) => a -> a -> Bool + + +{- +instance EQ NUM where +-- a /= b = False + a === b = True +-- a /= b = False + +-} diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail040.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail040.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail040.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail041.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail041.hs new file mode 100644 index 0000000000..ca92003d70 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail041.hs @@ -0,0 +1,60 @@ +{- +To: Lennart Augustsson <augustss@cs.chalmers.se> +Cc: partain@dcs.gla.ac.uk, John Peterson (Yale) <peterson-john@cs.yale.edu>, + simonpj@dcs.gla.ac.uk +Subject: Type checking matter +Date: Fri, 23 Oct 92 15:28:38 +0100 +From: Simon L Peyton Jones <simonpj@dcs.gla.ac.uk> + + +I've looked at the enclosed again. It seems to me that +since "s" includes a recursive call to "sort", inside the body +of "sort", then "sort" is monomorphic, and hence so is "s"; +hence the type signature (which claims full polymorphism) is +wrong. + +[Lennart says he can't see any free variables inside "s", but there +is one, namely "sort"!] + +Will: one for the should-fail suite? + +Simon + + +------- Forwarded Message + + +From: Lennart Augustsson <augustss@cs.chalmers.se> +To: partain +Subject: Re: just to show you I'm a nice guy... +Date: Tue, 26 May 92 17:30:12 +0200 + +> Here's a fairly simple module from our compiler, which includes what +> we claim is an illegal type signature (grep ILLEGAL ...). +> Last time I checked, hbc accepted this module. + +Not that I don't believe you, but why is this illegal? +As far as I can see there are no free variables in the function s, +which makes me believe that it can typechecked like a top level +definition. And for a top level defn the signature should be +all right. + + -- Lennart +- ------- End of forwarded message ------- +-} + +sort :: Ord a => [a] -> [a] +sort xs = s xs (length xs) + where + s :: Ord b => [b] -> Int -> [b] -- This signature is WRONG + s xs k = if k <= 1 then xs + else merge (sort ys) (sort zs) + where (ys,zs) = init_last xs (k `div` (2::Int)) + +-- Defns of merge and init_last are just dummies with the correct types +merge :: Ord a => [a] -> [a] -> [a] +merge xs ys = xs + +init_last :: [a] -> Int -> ([a],[a]) +init_last a b = (a,a) + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail041.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail041.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail041.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail042.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail042.hs new file mode 100644 index 0000000000..566bfea991 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail042.hs @@ -0,0 +1,28 @@ +--!!! weird class/instance examples off the haskell list +-- + +class Foo a where foo :: a -> a +class Foo a => Bar a where bar :: a -> a + + +instance Num a => Foo [a] where + foo [] = [] + foo (x:xs) = map (x+) xs + + +instance (Eq a, Text a) => Bar [a] where + bar [] = [] + bar (x:xs) = foo xs where u = x==x + v = show x + +------------------------------------------ + +{- +class Foo a => Bar2 a where bar2 :: a -> a + +instance (Eq a, Text a) => Foo [a] + +instance Num a => Bar2 [a] + +data X a = X a +-} diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail042.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail042.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail042.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail043.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail043.hs new file mode 100644 index 0000000000..cc1983be5b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail043.hs @@ -0,0 +1,222 @@ +-- The translation of this program should assign only one dictionary to +-- the function search (an Ord dictionary). Instead, it assigns two. +-- The output produced currently displays this. + +-- 10/12/92: This program is actually erroneous. The pattern-binding for +-- search falls under the monomorphism restriction, and there is no +-- call to search which might fix its type. So there should be a complaint. +-- But the actual error message is horrible: +-- +-- "bug001.hs", line 26: Ambiguous overloading: +-- class "Ord_", type "a" (at a use of an overloaded identifier: gt) +-- class "Eq_", type "a" (at a use of an overloaded identifier: eq) + + + +class Eq_ a where + eq :: a -> a -> Bool + +instance Eq_ Int where + eq = eqIntEq + +instance (Eq_ a) => Eq_ [a] where + eq = \ xs ys -> + if (null xs) + then (null ys) + else if (null ys) + then False + else and (eq (hd xs) (hd ys)) (eq (tl xs) (tl ys)) + +class (Eq_ a) => Ord_ a where + gt :: a -> a -> Bool + +instance Ord_ Int where + gt = ordIntGt + +search + = \ a bs -> if gt (hd bs) a + then False + else if eq a (hd bs) then True else search a (tl bs) + +and :: Bool -> Bool -> Bool +and True True = True + +hd :: [a] -> a +hd (a:as) = a + +tl :: [a] -> [a] +tl (a:as) = as + +ordIntGt :: Int -> Int -> Bool +ordIntGt 2 3 = True + +eqIntEq :: Int -> Int -> Bool +eqIntEq 2 3 = True + +null :: [a] -> Bool +null [] = True + + + +{- + +=============================================== +Main.Eq__INST_PreludeBuiltin.Int = + let + AbsBinds [] [] [(eq, eq)] + {- nonrec -} + {-# LINE 2 "test3.hs" -} + + eq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool + eq = Main.eqIntEq + in ({-dict-} [] [eq]) + +Main.Eq__INST_PreludeBuiltin.List = + /\ t135 -> + \{-dict-} _dict138 -> + let + {- nonrec -} + _dict136 = {-singleDict-} _dict138 + {- nonrec -} + _dict129 = {-singleDict-} _dict136 + AbsBinds [] [] [(eq, eq)] + {- nonrec -} + + _dict133 = + Main.Eq__INST_PreludeBuiltin.List + [t135] [{-singleDict-} _dict136] + {- nonrec -} + {-# LINE 5 "test3.hs" -} + + eq :: [t135] -> [t135] -> PreludeCore.Bool + eq = \ xs ys -> + +if (Main.null t135) xs then + (Main.null t135) ys + else + + if (Main.null t135) ys then + PreludeCore.False + else + + Main.and + + + ((Main.Eq_.eq t135 _dict129) + + + ((Main.hd t135) xs) + ((Main.hd t135) ys)) + + + + + + +(Main.Eq_.eq [t135] _dict133) + + + + ((Main.tl t135) xs) + ((Main.tl t135) ys)) + in ({-dict-} [] [eq]) +Main.Ord__INST_PreludeBuiltin.Int = + let + {- nonrec -} + _dict142 = Main.Eq__INST_PreludeBuiltin.Int [] [] + AbsBinds [] [] [(gt, gt)] + {- nonrec -} + {-# LINE 16 "test3.hs" -} + + gt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool + gt = Main.ordIntGt + in ({-dict-} [_dict142] [gt]) + +Main.Eq_.eq = /\ a -> \{-classdict-} [] [eq] -> eq + +Main.Ord_.gt = /\ a -> \{-classdict-} [_dict56] [gt] -> gt + +Main.Ord__TO_Main.Eq_ = /\ a -> \{-classdict-} [_dict58] [gt] -> ???_dict58??? + +AbsBinds [t60] [] [(hd, Main.hd)] + {- nonrec -} + + + + hd :: [t60] -> t60 + hd (a PreludeBuiltin.: as) + = a + +AbsBinds [t68] [] [(tl, Main.tl)] + {- nonrec -} + + + + + tl :: [t68] -> [t68] + tl (a PreludeBuiltin.: as) + = as + + +AbsBinds [t91] [_dict85, _dict88] [(search, Main.search)] + {- rec -} + {-# LINE 19 "test3.hs" -} + + + search :: t91 -> [t91] -> PreludeCore.Bool + search + = \ a bs -> + + +if (Main.Ord_.gt t91 _dict85) ((Main.hd t91) bs) a then + PreludeCore.False + else + + if (Main.Eq_.eq t91 _dict88) a ((Main.hd t91) bs) then + PreludeCore.True + else + + search a ((Main.tl t91) bs) +AbsBinds [] [] [(and, Main.and)] + {- nonrec -} + and :: PreludeCore.Bool -> PreludeCore.Bool -> PreludeCore.Bool + and PreludeCore.True PreludeCore.True + = PreludeCore.True +AbsBinds [] [] [(ordIntGt, Main.ordIntGt)] + {- nonrec -} + _dict97 = PreludeCore.Num_INST_PreludeBuiltin.Int [] [] + {- nonrec -} + _dict98 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] [] + {- nonrec -} + _dict100 = PreludeCore.Num_INST_PreludeBuiltin.Int [] [] + {- nonrec -} + _dict101 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] [] + {- nonrec -} + + + + ordIntGt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool + ordIntGt + 2 3 = PreludeCore.True +AbsBinds [] [] [(eqIntEq, Main.eqIntEq)] + {- nonrec -} + _dict105 = PreludeCore.Num_INST_PreludeBuiltin.Int [] [] + {- nonrec -} + _dict106 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] [] + {- nonrec -} + _dict108 = PreludeCore.Num_INST_PreludeBuiltin.Int [] [] + {- nonrec -} + _dict109 = PreludeCore.Eq_INST_PreludeBuiltin.Int [] [] + {- nonrec -} + + eqIntEq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool + eqIntEq + 2 3 = PreludeCore.True + + +AbsBinds [t112] [] [(null, Main.null)] + {- nonrec -} + + null :: [t112] -> PreludeCore.Bool + null [] = PreludeCore.True +-} diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail043.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail043.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail043.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail044.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail044.hs new file mode 100644 index 0000000000..9d056409f1 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail044.hs @@ -0,0 +1,22 @@ +--!!! tcfail044: duplicated type variable in instance decls +-- +module Main where + +instance (Eq a) => Eq (a->a) + + +instance (Num a) => Num (a->a) where + f + g = \x -> f x + g x + negate f = \x -> - (f x) + f * g = \x -> f x * g x + fromInteger n = \x -> fromInteger n + +ss :: Float -> Float +cc :: Float -> Float +tt :: Float -> Float + +ss = sin * sin +cc = cos * cos +tt = ss + cc + +main _ = [AppendChan stdout ((show (tt 0.4))++ " "++(show (tt 1.652)))] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail044.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail044.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail044.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail045.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail045.hs new file mode 100644 index 0000000000..f13b603508 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail045.hs @@ -0,0 +1,7 @@ +--!!! a bad _CCallable thing (from a bug from Satnam) +-- +data Socket = Socket# _Addr +instance _CCallable Socket + +f :: Socket -> PrimIO () +f x = _ccall_ foo x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail045.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail045.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail045.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail046.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail046.hs new file mode 100644 index 0000000000..c58988a5e3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail046.hs @@ -0,0 +1,32 @@ +--!! function types in deriving Eq things +-- From a bug report by Dave Harrison <D.A.Harrison@newcastle.ac.uk> + +module Simulation(Process(..), + Status, + Pid(..), + Time(..), + Continuation, + Message, + MessList(..) ) where + +type Process a = Pid -> Time -> Message a -> ( MessList a, + Continuation a) + +data Continuation a = Do (Process a) deriving Eq + + +type ProcList a = [ (Pid, Status, Process a) ] +data Status = Active | Passive | Busy Integer | Terminated + deriving Eq + + +data Message a = Create (Process a) | Created Pid | Activate Pid | + Passivate Pid | Terminate Pid | Wait Pid Time | + Query Pid a | Data Pid a | Event | + Output Pid String + deriving Eq + +type MessList a = [ Message a ] + +type Pid = Integer +type Time = Integer diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail046.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail046.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail046.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail047.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail047.hs new file mode 100644 index 0000000000..12770a33eb --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail047.hs @@ -0,0 +1,6 @@ + +class A a where + op1 :: a -> a + +instance A (a,(b,c)) where + op1 a = a diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail047.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail047.stderr new file mode 100644 index 0000000000..fd0781bd7e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail047.stderr @@ -0,0 +1,2 @@ +"tcfail047.hs", line 5: syntax error; on input: ( +ghc: execution of the Haskell parser had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail048.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail048.hs new file mode 100644 index 0000000000..5b58e204a2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail048.hs @@ -0,0 +1,3 @@ + +class (B a) => C a where + op1 :: a -> a diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail048.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail048.stderr new file mode 100644 index 0000000000..5d168311ce --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail048.stderr @@ -0,0 +1,5 @@ + +"tcfail048.hs", line 3: undefined class: B +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail049.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail049.hs new file mode 100644 index 0000000000..3fa7791dff --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail049.hs @@ -0,0 +1,2 @@ + +f x = g x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail049.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail049.stderr new file mode 100644 index 0000000000..8156893dc5 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail049.stderr @@ -0,0 +1,5 @@ + +"tcfail049.hs", line 2: undefined value: g +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail050.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail050.hs new file mode 100644 index 0000000000..a1fa3541d2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail050.hs @@ -0,0 +1,2 @@ + +f x = B x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail050.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail050.stderr new file mode 100644 index 0000000000..0f3df12883 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail050.stderr @@ -0,0 +1,5 @@ + +"tcfail050.hs", line 2: undefined value: B +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail051.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail051.hs new file mode 100644 index 0000000000..f94aa9d9bf --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail051.hs @@ -0,0 +1,3 @@ + +instance B Bool where + op1 a = a diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail051.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail051.stderr new file mode 100644 index 0000000000..1ea74dc935 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail051.stderr @@ -0,0 +1,7 @@ + +"tcfail051.hs", line 3: undefined class: B + +"tcfail051.hs", line 3: "op1" is not an operation of class "*UNBOUND*B". +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail052.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail052.hs new file mode 100644 index 0000000000..09488054ed --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail052.hs @@ -0,0 +1,2 @@ + +data C a = B a c diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail052.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail052.stderr new file mode 100644 index 0000000000..33d2255320 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail052.stderr @@ -0,0 +1,5 @@ + +"tcfail052.hs", line 2: undefined type variable: c +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail053.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail053.hs new file mode 100644 index 0000000000..99028ab4c8 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail053.hs @@ -0,0 +1,2 @@ + +data B = C A diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail053.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail053.stderr new file mode 100644 index 0000000000..8030f97630 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail053.stderr @@ -0,0 +1,5 @@ + +"tcfail053.hs", line 2: undefined type constructor: A +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail054.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail054.hs new file mode 100644 index 0000000000..69ce2e81b2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail054.hs @@ -0,0 +1,2 @@ + +f (B a) = True diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail054.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail054.stderr new file mode 100644 index 0000000000..4c2a2f6327 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail054.stderr @@ -0,0 +1,5 @@ + +"tcfail054.hs", line 2: undefined value: B +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail055.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail055.hs new file mode 100644 index 0000000000..fc6efe3bb7 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail055.hs @@ -0,0 +1,2 @@ + +f x = (x + 1 :: Int) :: Float diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail055.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail055.stderr new file mode 100644 index 0000000000..c3bd5619d4 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail055.stderr @@ -0,0 +1,7 @@ + +"tcfail055.hs", line 2: + Couldn't match type "Int" against "Float". + In an expression with a type signature: (x (+) 1 :: Int):: Float +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail056.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail056.hs new file mode 100644 index 0000000000..6e15f2bf5d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail056.hs @@ -0,0 +1,10 @@ + +data Foo = MkFoo Bool + +instance Eq Foo where + (MkFoo x) == (MkFoo y) = x == y + +instance Eq Foo where + -- forgot to type "Ord" above + (MkFoo x) <= (MkFoo y) = x <= y + diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail056.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail056.stderr new file mode 100644 index 0000000000..cb7ca89350 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail056.stderr @@ -0,0 +1,5 @@ + +"tcfail056.hs", line 9: "<=" is not an operation of class "Eq". +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail057.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail057.hs new file mode 100644 index 0000000000..bef0085fe5 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail057.hs @@ -0,0 +1,6 @@ +module ShouldFail where + +--!!! inadvertently using -> instead of => + +f :: (RealFrac a) -> a -> a +f x = x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail057.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail057.stderr new file mode 100644 index 0000000000..8159127a52 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail057.stderr @@ -0,0 +1,5 @@ + +"tcfail057.hs", line 5: undefined type constructor: RealFrac +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail058.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail058.hs new file mode 100644 index 0000000000..191d5644b9 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail058.hs @@ -0,0 +1,6 @@ +module ShouldFail where + +--!!! inadvertently using => instead of -> + +f :: (Array a) => a -> b +f x = x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail058.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail058.stderr new file mode 100644 index 0000000000..2ab1191100 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail058.stderr @@ -0,0 +1,5 @@ + +"tcfail058.hs", line 5: undefined class: Array +Fail: Compilation errors found + +ghc: execution of the Haskell compiler had trouble diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail059.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail059.hs new file mode 100644 index 0000000000..8f80a69738 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail059.hs @@ -0,0 +1,3 @@ +--!! The tycon export shouldn't be allowed to succeed +-- +module Foo ( Bar(..) ) where { data Bar = Bar X; data X = Y } diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail059.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail059.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail059.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail060.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail060.hs new file mode 100644 index 0000000000..1d859923c4 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail060.hs @@ -0,0 +1,9 @@ +--!! The class export shouldn't be allowed to succeed +-- +module Foo ( Baz(..) ) where + +class Baz a where + opx :: Int -> Bar -> a -> a + +data Bar = Bar X +data X = Y diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail060.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail060.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail060.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail061.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail061.hs new file mode 100644 index 0000000000..4ed535e9ea --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail061.hs @@ -0,0 +1,10 @@ +--!! signature bugs exposed by Sigbjorne Finne +-- + +type Flarp a = (b,b) + +--More fun can be had if we change the signature slightly + +type Bob a = a + +type Flarp2 a = Bob (b,b) diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail061.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail061.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail061.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail062.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail062.hs new file mode 100644 index 0000000000..8989d91b20 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail062.hs @@ -0,0 +1,37 @@ +--!!! bug report from Satnam +-- +module RubyAST +where + +type Module = (String,[Declaration]) + +data Declaration + = Architecture String StructuralExpression | + Behaviour String Parameter Parameter BehaviouralExpression + deriving (Eq, Text) + +data Parameter = ParameterVariable String | ParameterList [Parameter] + deriving (Eq, Text) + +nameOfModule :: Module -> String +nameOfModule (name, _) = name + +data StructuralExpression + = Variable String | + Serial StructuralExpression StructuralExpression | + Par [StructuralExpression] + deriving (Eq, Text) + +data BehaviouralExpression + = BehaviouralVariable String + | AndExpr BehaviouralExpression BehaviouralExpression + | OrExpr BehaviouralExpression BehaviouralExpression + | NotExpr BehaviouralExpression + deriving (Eq, Text) + + +type BehaviouralRelation + = (behaviouralExpression, behaviouralExpression) +-----^ typo ----------------^ typo (but so what?) + +type BehaviouralRelationList = [BehaviouralRelation] diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail062.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail062.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail062.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail063.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail063.hs new file mode 100644 index 0000000000..562cdf4400 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail063.hs @@ -0,0 +1,5 @@ +--!!! no type variable on a context +--!!! reported by Sigbjorn Finne + +moby :: Num => Int -> a -> Int +moby x y = x+y diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail063.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail063.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail063.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail065.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail065.hs new file mode 100644 index 0000000000..3029b1978c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail065.hs @@ -0,0 +1,37 @@ +{- + +------- Forwarded Message + +Date: Wed, 30 Nov 1994 16:34:18 +0100 +From: John Hughes <rjmh@cs.chalmers.se> +To: augustss@cs.chalmers.se, simonpj@dcs.gla.ac.uk +Subject: Nice little program + + +Lennart, Simon, + +You might like to look at the fun little program below. + +THUMBS DOWN to hbc for compiling it (it prints [72, 101, 108, 108, 111]) +THUMBS UP to ghc for rejecting it --- but what an error message! +nhc and gofer both reject it with the right error message. +I haven't tried Yale Haskell. + +Enjoy! +- ---------------------------- +-} + +class HasX a where + setX :: x->a->a + +data X x = X x +instance HasX (X x) where + setX x (X _) = X x + +changetype x = case setX x (X (error "change type!")) of X y->y + +main = print (changetype "Hello" :: [Int]) + +{- +------- End of Forwarded Message +-} diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail065.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail065.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail065.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail066.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail066.hs new file mode 100644 index 0000000000..f146acd759 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail066.hs @@ -0,0 +1,41 @@ +--!! INLINE on recursive functions. +{- +Date: Thu, 8 Dec 94 11:38:24 GMT +From: Julian Seward (DRL PhD) <sewardj@computer-science.manchester.ac.uk> +Message-Id: <9412081138.AA16652@rdf009.cs.man.ac.uk> +To: partain@dcs.gla.ac.uk +-} + +type IMonad a + = IMonadState -> IMonadReturn a + +data IMonadReturn a + = IMonadOk IMonadState a + | IMonadFail IMonadState String + +type IMonadState + = Int + + +returnI r = \s0 -> IMonadOk s0 r + +failI msg = \s0 -> IMonadFail s0 msg + +thenI m k + = \s0 -> case m s0 of + IMonadFail s1 msg -> IMonadFail s1 msg + IMonadOk s1 r1 -> k r1 s1 + +tickI n = \s0 -> IMonadOk (s0+n) () + +mapI f [] = returnI [] +mapI f (x:xs) = f x `thenI` ( \ fx -> + mapI f xs `thenI` ( \ fxs -> + returnI (fx:fxs) + )) + +{-# INLINE returnI #-} +{-# INLINE failI #-} +{-# INLINE thenI #-} +{-# INLINE tickI #-} +{-# INLINE mapI #-} diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail066.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail066.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail066.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail067.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail067.hs new file mode 100644 index 0000000000..b84328c414 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail067.hs @@ -0,0 +1,98 @@ +module SubRange where + +infixr 1 `rangeOf` + + +data Ord a => SubRange a = SubRange (a, a) a + +type IntSubRange = SubRange Int + + +subRangeValue :: SubRange a -> a +subRangeValue (SubRange (lower, upper) value) = value + +subRange :: SubRange a -> (a, a) +subRange (SubRange r value) = r + +newRange :: (Ord a, Text a) => (a, a) -> a -> SubRange a +newRange r value = checkRange (SubRange r value) + + +checkRange :: (Ord a, Text a) => SubRange a -> SubRange a +checkRange (SubRange (lower, upper) value) + = if (value < lower) || (value > upper) then + error ("### sub range error. range = " ++ show lower ++ + ".." ++ show upper ++ " value = " ++ show value ++ "\n") + else + SubRange (lower, upper) value + + +instance Eq a => Eq (SubRange a) where + (==) a b = subRangeValue a == subRangeValue b + +instance (Ord a) => Ord (SubRange a) where + (<) = relOp (<) + (<=) = relOp (<=) + (>=) = relOp (>=) + (>) = relOp (>) + +relOp :: Ord a => (a->a->Bool) -> SubRange a -> SubRange a -> Bool +relOp op a b = (subRangeValue a) `op` (subRangeValue b) + +rangeOf :: (Ord a, Text a) => SubRange a -> SubRange a -> SubRange a +rangeOf a b = checkRange (SubRange (subRange b) (subRangeValue a)) + +showRange :: Text a => SubRange a -> String +showRange (SubRange (lower, upper) value) + = show value ++ " :" ++ show lower ++ ".." ++ show upper + +showRangePair :: (Text a, Text b) => (SubRange a, SubRange b) -> String +showRangePair (a, b) + = "(" ++ showRange a ++ ", " ++ showRange b ++ ")" + +showRangeTriple :: (Text a, Text b, Text c) => + (SubRange a, SubRange b, SubRange c) -> String +showRangeTriple (a, b, c) + = "(" ++ showRange a ++ ", " ++ showRange b ++ ", " ++ showRange c ++ ")" + + + +instance Num a => Num (SubRange a) where + negate = numSubRangeNegate + (+) = numSubRangeAdd + (-) = numSubRangeSubtract + (*) = numSubRangeMultiply + fromInteger a = SubRange (fromInteger a, fromInteger a) (fromInteger a) + +numSubRangeNegate :: (Ord a, Num a) => SubRange a -> SubRange a +numSubRangeNegate (SubRange (lower, upper) value) + = checkRange (SubRange (lower, upper) (-value)) + +numSubRangeBinOp :: Num a => (a -> a -> a) -> + SubRange a -> SubRange a -> SubRange a +numSubRangeBinOp op a b + = SubRange (result, result) result + where + result = (subRangeValue a) `op` (subRangeValue b) + +-- partain: +numSubRangeAdd, numSubRangeSubtract, numSubRangeMultiply :: Num a => SubRange a -> SubRange a -> SubRange a + +numSubRangeAdd = numSubRangeBinOp (+) +numSubRangeSubtract = numSubRangeBinOp (-) +numSubRangeMultiply = numSubRangeBinOp (*) + +unsignedBits :: Int -> (Int, Int) +unsignedBits n = (0, 2^n-1) + +signedBits :: Int -> (Int, Int) +signedBits n = (-2^(n-1), 2^(n-1)-1) + + +si_n :: Int -> Int -> IntSubRange +si_n bits value = SubRange (signedBits bits) value + +si8, si10, si16 :: Int -> IntSubRange +si8 = si_n 8 +si10 = si_n 10 +si16 = si_n 16 diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail067.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail067.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail067.stderr diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail068.hs b/ghc/compiler/tests/typecheck/should_fail/tcfail068.hs new file mode 100644 index 0000000000..2b17bcebc3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail068.hs @@ -0,0 +1,92 @@ +--!! Make sure that state threads don't escape +--!! (example from Neil Ashton at York) +-- +module IndTree(IndTree(..), itgen, itiap, itrap, itrapstate) where + +--partain: import Auxiliary +import PreludeGlaST + +type IndTree s t = _MutableArray s (Int,Int) t + +itgen :: Constructed a => (Int,Int) -> a -> IndTree s a +itgen n x = + _runST ( + newArray ((1,1),n) x) + +itiap :: Constructed a => (Int,Int) -> (a->a) -> IndTree s a -> IndTree s a +itiap i f arr = + _runST ( + readArray arr i `thenStrictlyST` \val -> + writeArray arr i (f val) `seqStrictlyST` + returnStrictlyST arr) + +itrap :: Constructed a => ((Int,Int),(Int,Int)) -> (a->a) -> IndTree s a -> IndTree s a +itrap ((i,k),(j,l)) f arr = _runST(itrap' i k) + where + itrap' i k = if k > l then returnStrictlyST arr + else (itrapsnd i k `seqStrictlyST` + itrap' i (k+1)) + itrapsnd i k = if i > j then returnStrictlyST arr + else (readArray arr (i,k) `thenStrictlyST` \val -> + writeArray arr (i,k) (f val) `seqStrictlyST` + itrapsnd (i+1) k) + +itrapstate :: Constructed b => ((Int,Int),(Int,Int)) -> (a->b->(a,b)) -> ((Int,Int)->c->a) -> + (a->c) -> c -> IndTree s b -> (c, IndTree s b) +itrapstate ((i,k),(j,l)) f c d s arr = _runST(itrapstate' i k s) + where + itrapstate' i k s = if k > l then returnStrictlyST (s,arr) + else (itrapstatesnd i k s `thenStrictlyST` \(s,arr) -> + itrapstate' i (k+1) s) + itrapstatesnd i k s = if i > j then returnStrictlyST (s,arr) + else (readArray arr (i,k) `thenStrictlyST` \val -> + let (newstate, newval) = f (c (i,k) s) val + in writeArray arr (i,k) newval `seqStrictlyST` + itrapstatesnd (i+1) k (d newstate)) + +-- stuff from Auxiliary: copied here (partain) + +sap :: (a->b) -> (c,a) -> (c,b) +sap f (x,y) = (x, f y) + +fap :: (a->b) -> (a,c) -> (b,c) +fap f (x,y) = (f x, y) + +nonempty :: [a] -> Bool +nonempty [] = False +nonempty (_:_) = True + +-- const :: a -> b -> a +-- const k x = k + +-- id :: a -> a +-- id x = x + +compose :: [a->a] -> a -> a +compose = foldr (.) id + +data Maybe t = Just t | Nothing + +class Constructed a where + normal :: a -> Bool + +instance Constructed Bool where + normal True = True + normal False = True + +instance Constructed Int where + normal 0 = True + normal n = True + +instance (Constructed a, Constructed b) => Constructed (a,b) where + normal (x,y) = normal x && normal y + +-- pair :: (Constructed a, Constructed b) => a -> b -> (a,b) +-- pair x y | normal x && normal y = (x,y) + +instance Constructed (Maybe a) where + normal Nothing = True + normal (Just _) = True + +just :: Constructed a => a -> Maybe a +just x | normal x = Just x diff --git a/ghc/compiler/tests/typecheck/should_fail/tcfail068.stderr b/ghc/compiler/tests/typecheck/should_fail/tcfail068.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_fail/tcfail068.stderr diff --git a/ghc/compiler/tests/typecheck/should_succeed/ClassFoo.hi b/ghc/compiler/tests/typecheck/should_succeed/ClassFoo.hi new file mode 100644 index 0000000000..eb94aa3a40 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/ClassFoo.hi @@ -0,0 +1,4 @@ +interface ClassFoo where +class Foo a where + op1 :: a -> Int + op2 :: a -> a -> Int {-# ARITY op2 = 3 #-}{-# UPDATE op2 = 000 #-} {-# ARITY op1 = 1 #-}{-# UPDATE op1 = 0 #-} diff --git a/ghc/compiler/tests/typecheck/should_succeed/Jmakefile b/ghc/compiler/tests/typecheck/should_succeed/Jmakefile new file mode 100644 index 0000000000..e29a59cd3f --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/Jmakefile @@ -0,0 +1,93 @@ +TEST_FLAGS=-noC -ddump-tc -dcore-lint -hi + +RunStdTest(tc001,$(GHC),$(TEST_FLAGS) tc001.hs -o2 tc001.stderr) +RunStdTest(tc002,$(GHC),$(TEST_FLAGS) tc002.hs -o2 tc002.stderr) +RunStdTest(tc003,$(GHC),$(TEST_FLAGS) tc003.hs -o2 tc003.stderr) +RunStdTest(tc004,$(GHC),$(TEST_FLAGS) tc004.hs -o2 tc004.stderr) +RunStdTest(tc005,$(GHC),$(TEST_FLAGS) tc005.hs -o2 tc005.stderr) +RunStdTest(tc006,$(GHC),$(TEST_FLAGS) tc006.hs -o2 tc006.stderr) +RunStdTest(tc007,$(GHC),$(TEST_FLAGS) tc007.hs -o2 tc007.stderr) +RunStdTest(tc008,$(GHC),$(TEST_FLAGS) tc008.hs -o2 tc008.stderr) +RunStdTest(tc009,$(GHC),$(TEST_FLAGS) tc009.hs -o2 tc009.stderr) + +RunStdTest(tc010,$(GHC),$(TEST_FLAGS) tc010.hs -o2 tc010.stderr) +RunStdTest(tc011,$(GHC),$(TEST_FLAGS) tc011.hs -o2 tc011.stderr) +RunStdTest(tc012,$(GHC),$(TEST_FLAGS) tc012.hs -o2 tc012.stderr) +RunStdTest(tc013,$(GHC),$(TEST_FLAGS) tc013.hs -o2 tc013.stderr) +RunStdTest(tc014,$(GHC),$(TEST_FLAGS) tc014.hs -o2 tc014.stderr) +RunStdTest(tc015,$(GHC),$(TEST_FLAGS) tc015.hs -o2 tc015.stderr) +RunStdTest(tc016,$(GHC),$(TEST_FLAGS) tc016.hs -o2 tc016.stderr) +RunStdTest(tc017,$(GHC),$(TEST_FLAGS) tc017.hs -o2 tc017.stderr) +RunStdTest(tc018,$(GHC),$(TEST_FLAGS) tc018.hs -o2 tc018.stderr) +RunStdTest(tc019,$(GHC),$(TEST_FLAGS) -fglasgow-exts tc019.hs -o2 tc019.stderr) + +RunStdTest(tc020,$(GHC),$(TEST_FLAGS) tc020.hs -o2 tc020.stderr) +RunStdTest(tc021,$(GHC),$(TEST_FLAGS) tc021.hs -o2 tc021.stderr) +RunStdTest(tc022,$(GHC),$(TEST_FLAGS) tc022.hs -o2 tc022.stderr) +RunStdTest(tc023,$(GHC),$(TEST_FLAGS) tc023.hs -o2 tc023.stderr) +RunStdTest(tc024,$(GHC),$(TEST_FLAGS) tc024.hs -o2 tc024.stderr) +RunStdTest(tc025,$(GHC),$(TEST_FLAGS) tc025.hs -o2 tc025.stderr) +RunStdTest(tc026,$(GHC),$(TEST_FLAGS) tc026.hs -o2 tc026.stderr) +RunStdTest(tc027,$(GHC),$(TEST_FLAGS) tc027.hs -o2 tc027.stderr) +RunStdTest(tc028,$(GHC),$(TEST_FLAGS) tc028.hs -o2 tc028.stderr) +RunStdTest(tc029,$(GHC),$(TEST_FLAGS) tc029.hs -o2 tc029.stderr) + +RunStdTest(tc030,$(GHC),$(TEST_FLAGS) tc030.hs -o2 tc030.stderr) +RunStdTest(tc031,$(GHC),$(TEST_FLAGS) tc031.hs -o2 tc031.stderr) +RunStdTest(tc032,$(GHC),$(TEST_FLAGS) tc032.hs -o2 tc032.stderr) +RunStdTest(tc033,$(GHC),$(TEST_FLAGS) tc033.hs -o2 tc033.stderr) +RunStdTest(tc034,$(GHC),$(TEST_FLAGS) tc034.hs -o2 tc034.stderr) +RunStdTest(tc035,$(GHC),$(TEST_FLAGS) tc035.hs -o2 tc035.stderr) +RunStdTest(tc036,$(GHC),$(TEST_FLAGS) tc036.hs -o2 tc036.stderr) +RunStdTest(tc037,$(GHC),$(TEST_FLAGS) tc037.hs -o2 tc037.stderr) +RunStdTest(tc038,$(GHC),$(TEST_FLAGS) tc038.hs -o2 tc038.stderr) +RunStdTest(tc039,$(GHC),$(TEST_FLAGS) tc039.hs -o2 tc039.stderr) + +RunStdTest(tc040,$(GHC),$(TEST_FLAGS) tc040.hs -o2 tc040.stderr) +RunStdTest(tc041,$(GHC),$(TEST_FLAGS) tc041.hs -o2 tc041.stderr) +RunStdTest(tc042,$(GHC),$(TEST_FLAGS) tc042.hs -o2 tc042.stderr) +RunStdTest(tc043,$(GHC),$(TEST_FLAGS) tc043.hs -o2 tc043.stderr) +RunStdTest(tc044,$(GHC),$(TEST_FLAGS) tc044.hs -o2 tc044.stderr) +RunStdTest(tc045,$(GHC),$(TEST_FLAGS) tc045.hs -o2 tc045.stderr) +RunStdTest(tc046,$(GHC),$(TEST_FLAGS) tc046.hs -o2 tc046.stderr) +RunStdTest(tc047,$(GHC),$(TEST_FLAGS) tc047.hs -o2 tc047.stderr) +RunStdTest(tc048,$(GHC),$(TEST_FLAGS) tc048.hs -o2 tc048.stderr) +RunStdTest(tc049,$(GHC),$(TEST_FLAGS) tc049.hs -o2 tc049.stderr) + +RunStdTest(tc050,$(GHC),$(TEST_FLAGS) tc050.hs -o2 tc050.stderr) +RunStdTest(tc051,$(GHC),$(TEST_FLAGS) tc051.hs -o2 tc051.stderr) +RunStdTest(tc052,$(GHC),$(TEST_FLAGS) tc052.hs -o2 tc052.stderr) +RunStdTest(tc053,$(GHC),$(TEST_FLAGS) tc053.hs -o2 tc053.stderr) +RunStdTest(tc054,$(GHC),$(TEST_FLAGS) tc054.hs -o2 tc054.stderr) +RunStdTest(tc055,$(GHC),$(TEST_FLAGS) tc055.hs -o2 tc055.stderr) +RunStdTest(tc056,$(GHC),$(TEST_FLAGS) tc056.hs -o2 tc056.stderr) +RunStdTest(tc057,$(GHC),$(TEST_FLAGS) tc057.hs -o2 tc057.stderr) +RunStdTest(tc058,$(GHC),$(TEST_FLAGS) tc058.hs -o2 tc058.stderr) +RunStdTest(tc059,$(GHC),$(TEST_FLAGS) tc059.hs -o2 tc059.stderr) + +RunStdTest(tc060,$(GHC),$(TEST_FLAGS) tc060.hs -o2 tc060.stderr) +RunStdTest(tc061,$(GHC),$(TEST_FLAGS) tc061.hs -o2 tc061.stderr) +RunStdTest(tc062,$(GHC),$(TEST_FLAGS) tc062.hs -o2 tc062.stderr) +RunStdTest(tc063,$(GHC),$(TEST_FLAGS) tc063.hs -o2 tc063.stderr) +RunStdTest(tc064,$(GHC),$(TEST_FLAGS) tc064.hs -o2 tc064.stderr) +RunStdTest(tc065,$(GHC),$(TEST_FLAGS) tc065.hs -o2 tc065.stderr) +RunStdTest(tc066,$(GHC),$(TEST_FLAGS) tc066.hs -o2 tc066.stderr) +RunStdTest(tc067,$(GHC),$(TEST_FLAGS) tc067.hs -o2 tc067.stderr) +RunStdTest(tc068,$(GHC),$(TEST_FLAGS) tc068.hs -o2 tc068.stderr) +RunStdTest(tc069,$(GHC),$(TEST_FLAGS) tc069.hs -o2 tc069.stderr) + +RunStdTest(tc070,$(GHC),$(TEST_FLAGS) tc070.hs -o2 tc070.stderr) +RunStdTest(tc073,$(GHC),$(TEST_FLAGS) tc073.hs -o2 tc073.stderr) +RunStdTest(tc074,$(GHC),$(TEST_FLAGS) tc074.hs -o2 tc074.stderr) +RunStdTest(tc075,$(GHC),$(TEST_FLAGS) tc075.hs -o2 tc075.stderr) +RunStdTest(tc076,$(GHC),$(TEST_FLAGS) tc076.hs -o2 tc076.stderr) +RunStdTest(tc077,$(GHC),$(TEST_FLAGS) tc077.hs -o2 tc077.stderr) +RunStdTest(tc078,$(GHC),$(TEST_FLAGS) tc078.hs -o2 tc078.stderr) +RunStdTest(tc079,$(GHC),$(TEST_FLAGS) tc079.hs -o2 tc079.stderr) + +RunStdTest(tc080,$(GHC),$(TEST_FLAGS) tc080.hs -o2 tc080.stderr) +RunStdTest(tc081,$(GHC),$(TEST_FLAGS) tc081.hs -o2 tc081.stderr) +RunStdTest(tc082,$(GHC),$(TEST_FLAGS) tc082.hs -o2 tc082.stderr) +RunStdTest(tc083,$(GHC),$(TEST_FLAGS) tc083.hs -o2 tc083.stderr) +RunStdTest(tc084,$(GHC),$(TEST_FLAGS) tc084.hs -o2 tc084.stderr) +RunStdTest(tc085,$(GHC),$(TEST_FLAGS) tc085.hs -o2 tc085.stderr) diff --git a/ghc/compiler/tests/typecheck/should_succeed/M.hi b/ghc/compiler/tests/typecheck/should_succeed/M.hi new file mode 100644 index 0000000000..ffb4e0c9dc --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/M.hi @@ -0,0 +1,4 @@ +interface M where +class (ORD a, Text a) => EQ a where (===) :: a -> a -> Bool +class (Num a) => ORD a +data NUM = ONE | TWO diff --git a/ghc/compiler/tests/typecheck/should_succeed/ShouldSucceed.hi b/ghc/compiler/tests/typecheck/should_succeed/ShouldSucceed.hi new file mode 100644 index 0000000000..3ea8fd3a46 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/ShouldSucceed.hi @@ -0,0 +1,7 @@ +interface ShouldSucceed where { +{- TCE -} +{- CE -} +{- LVE -} +a :: Num t64 => t64 -> t64 +{- GIEinst -} +} diff --git a/ghc/compiler/tests/typecheck/should_succeed/TheUtils.hi b/ghc/compiler/tests/typecheck/should_succeed/TheUtils.hi new file mode 100644 index 0000000000..6ce638ba4b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/TheUtils.hi @@ -0,0 +1,33 @@ +interface TheUtils where +import Maybes(Labda) +import Pretty(PrettyRep) +let_1_0 :: a -> (a -> b) -> b {-# ARITY let_1_0 = 2 #-}{-# STRICTNESS let_1_0 = "T,F" ST #-} +assoc :: (Eq a) => a -> [(a, b)] -> String -> b {-# ARITY assoc = 4 #-}{-# STRICTNESS assoc = "2,F" ST #-} +assocWithDefault :: (Eq a) => [(a, b)] -> b -> a -> (b, Bool) {-# ARITY assocWithDefault = 4 #-}{-# STRICTNESS assocWithDefault = "1,F" ST #-} +cfst :: a -> b -> a {-# ARITY cfst = 2 #-}{-# STRICTNESS cfst = "0,0" ST #-} +hasNoDups :: (Eq a) => [a] -> Bool {-# ARITY hasNoDups = 2 #-}{-# STRICTNESS hasNoDups = "1,F" ST #-} +mapAccumL :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) {-# ARITY mapAccumL = 3 #-}{-# STRICTNESS mapAccumL = "2,F" ST #-} +mapAccumR :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c]) {-# ARITY mapAccumR = 3 #-}{-# STRICTNESS mapAccumR = "2,F" ST #-} +map2 :: (a -> b -> c) -> [a] -> [b] -> [c] {-# ARITY map2 = 3 #-}{-# STRICTNESS map2 = "1,F" ST #-} +map3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] {-# ARITY map3 = 4 #-}{-# STRICTNESS map3 = "1,F" ST #-} +applyToPair :: (a -> b, c -> d) -> (a, c) -> (b, d) {-# ARITY applyToPair = 2 #-}{-# STRICTNESS applyToPair = "0&1,F" ST #-} +applyToFst :: (a -> b) -> (a, c) -> (b, c) {-# ARITY applyToFst = 2 #-}{-# STRICTNESS applyToFst = "1,F" ST #-} +applyToSnd :: (a -> b) -> (c, a) -> (c, b) {-# ARITY applyToSnd = 2 #-}{-# STRICTNESS applyToSnd = "1,F" ST #-} +foldPair :: (a -> a -> a, b -> b -> b) -> (a, b) -> [(a, b)] -> (a, b) {-# ARITY foldPair = 3 #-}{-# STRICTNESS foldPair = "(0|1)&2,F" ST #-} +clookup :: (Eq a) => [a] -> [b] -> a -> b {-# ARITY clookup = 1 #-}{-# STRICTNESS clookup = "T,F" ST #-} +clookupElse :: (Eq b) => a -> [b] -> [a] -> b -> a {-# ARITY clookupElse = 5 #-}{-# STRICTNESS clookupElse = "2,F" ST #-} +clookrepl :: (Eq a) => [a] -> [b] -> a -> (b -> b) -> [b] {-# ARITY clookrepl = 5 #-}{-# STRICTNESS clookrepl = "1,F" ST #-} +forall :: (a -> Bool) -> [a] -> Bool {-# ARITY forall = 2 #-}{-# STRICTNESS forall = "1,F" ST #-} +exists :: (a -> Bool) -> [a] -> Bool {-# ARITY exists = 2 #-}{-# STRICTNESS exists = "1,F" ST #-} +elemIndex :: (Eq a) => [a] -> a -> Int {-# ARITY elemIndex = 3 #-}{-# STRICTNESS elemIndex = "1,F" ST #-} +(\\\) :: (Eq a) => [a] -> [a] -> [a] {-# ARITY (\\\) = 1 #-}{-# STRICTNESS (\\\) = "T,F" ST #-} +nOfThem :: Int -> a -> [a] {-# ARITY nOfThem = 2 #-}{-# STRICTNESS nOfThem = "T,F" ST #-} +panic :: [Char] -> a {-# ARITY panic = 1 #-}{-# STRICTNESS panic = "T,F" ST #-} +pprPanic :: (Int -> Bool -> PrettyRep) -> a {-# ARITY pprPanic = 1 #-}{-# STRICTNESS pprPanic = "T,F" ST #-} +quicksort :: (a -> a -> Bool) -> [a] -> [a] {-# ARITY quicksort = 2 #-}{-# STRICTNESS quicksort = "1,F" ST #-} +runs :: (a -> a -> Bool) -> [a] -> [[a]] {-# ARITY runs = 2 #-}{-# STRICTNESS runs = "1,F" ST #-} +intLength :: [a] -> Int {-# ARITY intLength = 1 #-}{-# STRICTNESS intLength = "0,F" ST #-} +lengthExceeds :: [a] -> Int -> Bool {-# ARITY lengthExceeds = 2 #-}{-# STRICTNESS lengthExceeds = "0&1,F" ST #-} + +data Labda a +data PrettyRep diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc001.hs b/ghc/compiler/tests/typecheck/should_succeed/tc001.hs new file mode 100644 index 0000000000..c3b0a785e2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc001.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +a x = y+2 where y = x+3 diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc001.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc001.stderr new file mode 100644 index 0000000000..80519a27ed --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc001.stderr @@ -0,0 +1,19 @@ +Typechecked: +AbsBinds [tt12] [d.Num.t16] [(a.t1, ShouldSucceed.a)] + (fromInt.t15, fromInt tt12 d.Num.t16) + (lit.t8, fromInt.t15 (MkInt 3#)) + (d.Num.t17, d.Num.t16) + (+.t6, (+) tt12 d.Num.t17) + (fromInt.t18, fromInt.t15) + (lit.t13, fromInt.t18 (MkInt 2#)) + (+.t11, (+.t6)) + {- nonrec -} + a.t1 :: tt12 -> tt12 + a.t1 x.r54 = y.r55 +.t11 lit.t13 + where + AbsBinds [] [] [(y.t4, y.r55)] + {- nonrec -} + y.t4 :: tt12 + y.t4 = x.r54 +.t6 lit.t8 + {- nonrec -} + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc002.hs b/ghc/compiler/tests/typecheck/should_succeed/tc002.hs new file mode 100644 index 0000000000..fbe2cd50bd --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc002.hs @@ -0,0 +1 @@ +b = if True then 1 else 2 diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc002.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc002.stderr new file mode 100644 index 0000000000..75f416d7d3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc002.stderr @@ -0,0 +1,11 @@ +Typechecked: +d.Num.t7 = dfun.Num.Integer +fromInt.t6 = fromInt tt4 d.Num.t7 +lit.t5 = fromInt.t6 (MkInt 2#) +fromInt.t8 = fromInt.t6 +lit.t3 = fromInt.t8 (MkInt 1#) +AbsBinds [] [] [(b.t1, Main.b)] + {- nonrec -} + b.t1 :: tt4 + b.t1 = if True then lit.t3 else lit.t5 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc003.hs b/ghc/compiler/tests/typecheck/should_succeed/tc003.hs new file mode 100644 index 0000000000..70459c3443 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc003.hs @@ -0,0 +1,12 @@ +module ShouldSucceed where + +-- This is a somewhat surprising program. +-- It shows up the monomorphism restriction, *and* ambiguity resolution! +-- The binding is a pattern binding without a signature, so it is monomorphic. +-- Hence the types of c,d,e are not universally quantified. But then +-- their type variables are ambiguous, so the ambiguity resolution leaps +-- into action, and resolves them to Integer. + +-- That's why we check the interface file in the test suite. + +(c@(d,e)) = if True then (1,2) else (1,3) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc003.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc003.stderr new file mode 100644 index 0000000000..9bdced1e8a --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc003.stderr @@ -0,0 +1,25 @@ +Typechecked: +d.Num.t19 = dfun.Num.Integer +d.Num.t17 = dfun.Num.Integer +fromInt.t16 = fromInt tt14 d.Num.t17 +lit.t15 = fromInt.t16 (MkInt 3#) +fromInt.t18 = fromInt tt12 d.Num.t19 +lit.t13 = fromInt.t18 (MkInt 1#) +fromInt.t20 = fromInt.t16 +lit.t11 = fromInt.t20 (MkInt 2#) +lit.t9 = lit.t13 +AbsBinds +[] +[] +[(c.t3, ShouldSucceed.c), (d.t4, ShouldSucceed.d), (e.t5, ShouldSucceed.e)] + {- nonrec -} + (c.t3@(d.t4, e.t5)) :: (tt12, tt14) + (c.t3@(d.t4, e.t5)) = if True then (lit.t9, lit.t11) else (lit.t13, lit.t15) + +=-=-=-=-=INTERFACE STARTS HERE=-=-=-=-= ShouldSucceed +interface ShouldSucceed where +c :: (tt12, tt14) {-# ARITY _ = 0 #-} +d :: tt12 {-# ARITY _ = 0 #-} +e :: tt14 {-# ARITY _ = 0 #-} +=-=-=-=-=INTERFACE STOPS HERE=-=-=-=-= + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc004.hs b/ghc/compiler/tests/typecheck/should_succeed/tc004.hs new file mode 100644 index 0000000000..a0627302d4 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc004.hs @@ -0,0 +1,5 @@ +module ShouldSucceed where + +f x = case x of + True -> True + False -> x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc004.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc004.stderr new file mode 100644 index 0000000000..2caff64a13 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc004.stderr @@ -0,0 +1,8 @@ +Typechecked: +AbsBinds [] [] [(f.t1, ShouldSucceed.f)] + {- nonrec -} + f.t1 :: Bool -> Bool + f.t1 x.r54 = case x.r54 of + True -> True + False -> x.r54 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc005.hs b/ghc/compiler/tests/typecheck/should_succeed/tc005.hs new file mode 100644 index 0000000000..9d39da8912 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc005.hs @@ -0,0 +1,4 @@ +module ShouldSucceed where + +g ((x:z),y) = x +g (x,y) = 2 diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc005.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc005.stderr new file mode 100644 index 0000000000..13046bca76 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc005.stderr @@ -0,0 +1,11 @@ +Typechecked: +AbsBinds [tt11, tt12] [d.Num.t15] [(g.t1, ShouldSucceed.g)] + (fromInt.t14, fromInt tt12 d.Num.t15) + (lit.t13, fromInt.t14 (MkInt 2#)) + {- nonrec -} + g.t1 :: ([tt12], tt11) -> tt12 + g.t1 ((x.r54 : z.r56), y.r55) + = x.r54 + g.t1 (x.r57, y.r58) + = lit.t13 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc006.hs b/ghc/compiler/tests/typecheck/should_succeed/tc006.hs new file mode 100644 index 0000000000..2a22688d19 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc006.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +h = 1:h diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc006.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc006.stderr new file mode 100644 index 0000000000..97ba6d7cc3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc006.stderr @@ -0,0 +1,9 @@ +Typechecked: +d.Num.t7 = dfun.Num.Integer +fromInt.t6 = fromInt tt3 d.Num.t7 +lit.t4 = fromInt.t6 (MkInt 1#) +AbsBinds [] [] [(h.t1, ShouldSucceed.h)] + {- rec -} + h.t1 :: [tt3] + h.t1 = ((:) tt3) lit.t4 h.t1 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc007.hs b/ghc/compiler/tests/typecheck/should_succeed/tc007.hs new file mode 100644 index 0000000000..c65458514b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc007.hs @@ -0,0 +1,9 @@ +module ShouldSucceed where + +j = 2 + +k = 1:j:l + +l = 0:k + +m = j+j diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc007.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc007.stderr new file mode 100644 index 0000000000..4563532ff8 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc007.stderr @@ -0,0 +1,26 @@ +Typechecked: +d.Num.t24 = dfun.Num.Integer +d.Num.t26 = dfun.Num.Integer +fromInt.t23 = fromInt tt2 d.Num.t24 +lit.t3 = fromInt.t23 (MkInt 2#) +fromInt.t25 = fromInt tt15 d.Num.t26 +lit.t10 = fromInt.t25 (MkInt 1#) +fromInt.t27 = fromInt.t25 +lit.t16 = fromInt.t27 (MkInt 0#) +d.Num.t28 = d.Num.t24 +(+.t21) = (+) tt2 d.Num.t28 +AbsBinds [] [] [(j.t1, ShouldSucceed.j)] + {- nonrec -} + j.t1 :: tt2 + j.t1 = lit.t3 +AbsBinds [] [] [(k.t6, ShouldSucceed.k), (l.t7, ShouldSucceed.l)] + {- rec -} + k.t6 :: [tt15] + k.t6 = ((:) tt15) lit.t10 (((:) tt15) ShouldSucceed.j l.t7) + l.t7 :: [tt15] + l.t7 = ((:) tt15) lit.t16 k.t6 +AbsBinds [] [] [(m.t19, ShouldSucceed.m)] + {- nonrec -} + m.t19 :: tt2 + m.t19 = ShouldSucceed.j +.t21 ShouldSucceed.j + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc008.hs b/ghc/compiler/tests/typecheck/should_succeed/tc008.hs new file mode 100644 index 0000000000..236b575573 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc008.hs @@ -0,0 +1,4 @@ +module ShouldSucceed where + +n True = 1 +n False = 0 diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc008.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc008.stderr new file mode 100644 index 0000000000..a70264d93e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc008.stderr @@ -0,0 +1,11 @@ +Typechecked: +AbsBinds [tt4] [d.Num.t7] [(n.t1, ShouldSucceed.n)] + (fromInt.t6, fromInt tt4 d.Num.t7) + (lit.t3, fromInt.t6 (MkInt 1#)) + (fromInt.t8, fromInt.t6) + (lit.t5, fromInt.t8 (MkInt 0#)) + {- nonrec -} + n.t1 :: Bool -> tt4 + n.t1 True = lit.t3 + n.t1 False = lit.t5 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc009.hs b/ghc/compiler/tests/typecheck/should_succeed/tc009.hs new file mode 100644 index 0000000000..b682a94c0d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc009.hs @@ -0,0 +1,4 @@ +module ShouldSucceed where + +o (True,x) = x +o (False,y) = y+1 diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc009.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc009.stderr new file mode 100644 index 0000000000..0b70e78da0 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc009.stderr @@ -0,0 +1,13 @@ +Typechecked: +AbsBinds [tt10] [d.Num.t14] [(o.t1, ShouldSucceed.o)] + (fromInt.t13, fromInt tt10 d.Num.t14) + (lit.t11, fromInt.t13 (MkInt 1#)) + (d.Num.t15, d.Num.t14) + (+.t9, (+) tt10 d.Num.t15) + {- nonrec -} + o.t1 :: (Bool, tt10) -> tt10 + o.t1 (True, x.r54) + = x.r54 + o.t1 (False, y.r55) + = y.r55 +.t9 lit.t11 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc010.hs b/ghc/compiler/tests/typecheck/should_succeed/tc010.hs new file mode 100644 index 0000000000..8ec9afd3d0 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc010.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +p = [(y+2,True) | y <- [1,2]] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc010.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc010.stderr new file mode 100644 index 0000000000..96d1942e3c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc010.stderr @@ -0,0 +1,14 @@ +Typechecked: +d.Num.t13 = dfun.Num.Integer +fromInt.t12 = fromInt tt9 d.Num.t13 +lit.t10 = fromInt.t12 (MkInt 2#) +d.Num.t14 = d.Num.t13 +(+.t8) = (+) tt9 d.Num.t14 +lit.t6 = lit.t10 +fromInt.t15 = fromInt.t12 +lit.t4 = fromInt.t15 (MkInt 1#) +AbsBinds [] [] [(p.t1, ShouldSucceed.p)] + {- nonrec -} + p.t1 :: [(tt9, Bool)] + p.t1 = [ (y.r54 +.t8 lit.t10, True) | y.r54 <- [lit.t4, lit.t6] (tt9) ] + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc011.hs b/ghc/compiler/tests/typecheck/should_succeed/tc011.hs new file mode 100644 index 0000000000..24c5b3b91b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc011.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +x@_ = x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc011.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc011.stderr new file mode 100644 index 0000000000..20dc687177 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc011.stderr @@ -0,0 +1,6 @@ +Typechecked: +AbsBinds [tt0] [] [(x.t1, ShouldSucceed.x)] + {- rec -} + (x.t1@_) :: tt0 + (x.t1@_) = x.t1 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc012.hs b/ghc/compiler/tests/typecheck/should_succeed/tc012.hs new file mode 100644 index 0000000000..6f5e954220 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc012.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +q = \ y -> y diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc012.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc012.stderr new file mode 100644 index 0000000000..2839d8213e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc012.stderr @@ -0,0 +1,6 @@ +Typechecked: +AbsBinds [ot2] [] [(q.t1, ShouldSucceed.q)] + {- nonrec -} + q.t1 :: ot2 -> ot2 + q.t1 = \ y.r54 -> y.r54 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc013.hs b/ghc/compiler/tests/typecheck/should_succeed/tc013.hs new file mode 100644 index 0000000000..f6a08b5e7b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc013.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +(r,s) = (1,'a') diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc013.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc013.stderr new file mode 100644 index 0000000000..a6601db028 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc013.stderr @@ -0,0 +1,9 @@ +Typechecked: +d.Num.t9 = dfun.Num.Integer +fromInt.t8 = fromInt tt6 d.Num.t9 +lit.t7 = fromInt.t8 (MkInt 1#) +AbsBinds [] [] [(r.t2, ShouldSucceed.r), (s.t3, ShouldSucceed.s)] + {- nonrec -} + (r.t2, s.t3) :: (tt6, Char) + (r.t2, s.t3) = (lit.t7, 'a') + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc014.hs b/ghc/compiler/tests/typecheck/should_succeed/tc014.hs new file mode 100644 index 0000000000..97ce375583 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc014.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +t = 1+t diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc014.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc014.stderr new file mode 100644 index 0000000000..1f090077da --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc014.stderr @@ -0,0 +1,11 @@ +Typechecked: +d.Num.t8 = dfun.Num.Integer +fromInt.t7 = fromInt tt0 d.Num.t8 +lit.t5 = fromInt.t7 (MkInt 1#) +d.Num.t9 = d.Num.t8 +(+.t3) = (+) tt0 d.Num.t9 +AbsBinds [] [] [(t.t1, ShouldSucceed.t)] + {- rec -} + t.t1 :: tt0 + t.t1 = lit.t5 +.t3 t.t1 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc015.hs b/ghc/compiler/tests/typecheck/should_succeed/tc015.hs new file mode 100644 index 0000000000..41c902bfc6 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc015.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +u x = \ (y,z) -> x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc015.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc015.stderr new file mode 100644 index 0000000000..ac3d312659 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc015.stderr @@ -0,0 +1,7 @@ +Typechecked: +AbsBinds [tt5, tt6, ot2] [] [(u.t1, ShouldSucceed.u)] + {- nonrec -} + u.t1 :: ot2 -> (tt5, tt6) -> ot2 + u.t1 x.r54 = \ (y.r55, z.r56) + -> x.r54 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc016.hs b/ghc/compiler/tests/typecheck/should_succeed/tc016.hs new file mode 100644 index 0000000000..5f3c7e5721 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc016.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +f x@_ y@_ = x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc016.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc016.stderr new file mode 100644 index 0000000000..6aabab9953 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc016.stderr @@ -0,0 +1,7 @@ +Typechecked: +AbsBinds [ot5, ot3] [] [(f.t1, ShouldSucceed.f)] + {- nonrec -} + f.t1 :: ot3 -> ot5 -> ot3 + f.t1 (x.r54@_) (y.r55@_) + = x.r54 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc017.hs b/ghc/compiler/tests/typecheck/should_succeed/tc017.hs new file mode 100644 index 0000000000..ec51aeb8d0 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc017.hs @@ -0,0 +1,4 @@ +module ShouldSucceed where + +v | True = v+1 + | False = v diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc017.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc017.stderr new file mode 100644 index 0000000000..5bee79ef44 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc017.stderr @@ -0,0 +1,12 @@ +Typechecked: +d.Num.t8 = dfun.Num.Integer +fromInt.t7 = fromInt tt4 d.Num.t8 +lit.t5 = fromInt.t7 (MkInt 1#) +d.Num.t9 = d.Num.t8 +(+.t3) = (+) tt4 d.Num.t9 +AbsBinds [] [] [(v.t1, ShouldSucceed.v)] + {- rec -} + v.t1 :: tt4 + v.t1 | True = v.t1 +.t3 lit.t5 + | False = v.t1 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc018.hs b/ghc/compiler/tests/typecheck/should_succeed/tc018.hs new file mode 100644 index 0000000000..7fb398c6e6 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc018.hs @@ -0,0 +1,4 @@ +module ShouldSucceed where + +w = a where a = y + y = 2 diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc018.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc018.stderr new file mode 100644 index 0000000000..5a7b1b5316 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc018.stderr @@ -0,0 +1,20 @@ +Typechecked: +d.Num.t9 = dfun.Num.Integer +fromInt.t8 = fromInt tt4 d.Num.t9 +lit.t5 = fromInt.t8 (MkInt 2#) +AbsBinds [] [] [(w.t1, ShouldSucceed.w)] + {- nonrec -} + w.t1 :: tt4 + w.t1 = a.r54 + where + AbsBinds [] [] [(y.t3, y.r55)] + {- nonrec -} + y.t3 :: tt4 + y.t3 = lit.t5 + {- nonrec -} + AbsBinds [] [] [(a.t7, a.r54)] + {- nonrec -} + a.t7 :: tt4 + a.t7 = y.r55 + {- nonrec -} + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc019.hs b/ghc/compiler/tests/typecheck/should_succeed/tc019.hs new file mode 100644 index 0000000000..3cfe5ea626 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc019.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +(al:am) = [y+1 | (y,z) <- [(1,2)]] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc019.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc019.stderr new file mode 100644 index 0000000000..0d4c241e29 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc019.stderr @@ -0,0 +1,17 @@ +Typechecked: +d.Num.t19 = dfun.Num.Integer +d.Num.t22 = dfun.Num.Integer +fromInt.t18 = fromInt tt4 d.Num.t19 +lit.t16 = fromInt.t18 (MkInt 1#) +d.Num.t20 = d.Num.t19 +(+.t14) = (+) tt4 d.Num.t20 +fromInt.t21 = fromInt tt6 d.Num.t22 +lit.t12 = fromInt.t21 (MkInt 2#) +lit.t10 = lit.t16 +AbsBinds [] [] [(al.t2, ShouldSucceed.al), (am.t3, ShouldSucceed.am)] + {- nonrec -} + (al.t2 : am.t3) :: [tt4] + (al.t2 : am.t3) + = [ y.r55 +.t14 lit.t16 | + (y.r55, z.r56) <- [(lit.t10, lit.t12)] ((tt4, tt6)) ] + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc020.hs b/ghc/compiler/tests/typecheck/should_succeed/tc020.hs new file mode 100644 index 0000000000..a0ef679c8f --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc020.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +f x = a where a = x:a diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc020.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc020.stderr new file mode 100644 index 0000000000..07140e36c8 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc020.stderr @@ -0,0 +1,12 @@ +Typechecked: +AbsBinds [tt5] [] [(f.t1, ShouldSucceed.f)] + {- nonrec -} + f.t1 :: tt5 -> [tt5] + f.t1 x.r54 = a.r55 + where + AbsBinds [] [] [(a.t4, a.r55)] + {- rec -} + a.t4 :: [tt5] + a.t4 = ((:) tt5) x.r54 a.t4 + {- nonrec -} + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc021.hs b/ghc/compiler/tests/typecheck/should_succeed/tc021.hs new file mode 100644 index 0000000000..418fa38e29 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc021.hs @@ -0,0 +1,7 @@ +module ShouldSucceed where + +f x = a + +a = (x,x) + +x = x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc021.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc021.stderr new file mode 100644 index 0000000000..b17bfdbe40 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc021.stderr @@ -0,0 +1,14 @@ +Typechecked: +AbsBinds [tt0] [] [(x.t1, ShouldSucceed.x)] + {- rec -} + x.t1 :: tt0 + x.t1 = x.t1 +AbsBinds [tt4, tt5] [] [(a.t3, ShouldSucceed.a)] + {- nonrec -} + a.t3 :: (tt4, tt5) + a.t3 = (ShouldSucceed.x tt4, ShouldSucceed.x tt5) +AbsBinds [ot8, tt9, tt10] [] [(f.t7, ShouldSucceed.f)] + {- nonrec -} + f.t7 :: ot8 -> (tt9, tt10) + f.t7 x.r56 = ShouldSucceed.a [tt9, tt10] + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc022.hs b/ghc/compiler/tests/typecheck/should_succeed/tc022.hs new file mode 100644 index 0000000000..1a04d7e7a2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc022.hs @@ -0,0 +1,5 @@ +module ShouldSucceed where + +main = iD iD + +iD x = x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc022.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc022.stderr new file mode 100644 index 0000000000..de7d5718fa --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc022.stderr @@ -0,0 +1,11 @@ +Typechecked: +AbsBinds [ot2] [] [(id.t1, ShouldSucceed.id)] + {- nonrec -} + id.t1 :: ot2 -> ot2 + id.t1 + x.r55 = x.r55 +AbsBinds [tt6] [] [(main.t4, ShouldSucceed.main)] + {- nonrec -} + main.t4 :: tt6 -> tt6 + main.t4 = (ShouldSucceed.id (tt6 -> tt6)) (ShouldSucceed.id tt6) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc023.hs b/ghc/compiler/tests/typecheck/should_succeed/tc023.hs new file mode 100644 index 0000000000..b996719bb9 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc023.hs @@ -0,0 +1,7 @@ +module ShouldSucceed where + +main = s k k + +s f g x = f x (g x) + +k x y = x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc023.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc023.stderr new file mode 100644 index 0000000000..5ca71ff860 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc023.stderr @@ -0,0 +1,19 @@ +Typechecked: +AbsBinds [ot6, ot4, ot5] [] [(s.t1, ShouldSucceed.s)] + {- nonrec -} + s.t1 :: (ot4 -> ot6 -> ot5) -> (ot4 -> ot6) -> ot4 -> ot5 + s.t1 f.r56 g.r57 x.r58 + = f.r56 x.r58 (g.r57 x.r58) +AbsBinds [ot10, ot9] [] [(k.t8, ShouldSucceed.k)] + {- nonrec -} + k.t8 :: ot9 -> ot10 -> ot9 + k.t8 x.r59 y.r60 + = x.r59 +AbsBinds [tt19] [] [(main.t12, ShouldSucceed.main)] + {- nonrec -} + main.t12 :: tt19 -> tt19 + main.t12 + = (ShouldSucceed.s [tt18 -> tt19, tt19, tt19]) + (ShouldSucceed.k [tt18 -> tt19, tt19]) + (ShouldSucceed.k [tt18, tt19]) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc024.hs b/ghc/compiler/tests/typecheck/should_succeed/tc024.hs new file mode 100644 index 0000000000..e28d1acf96 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc024.hs @@ -0,0 +1,7 @@ +module ShouldSucceed where + +main x = s k k x + +s f g x = f x (g x) + +k x y = x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc024.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc024.stderr new file mode 100644 index 0000000000..84cf357c9c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc024.stderr @@ -0,0 +1,20 @@ +Typechecked: +AbsBinds [ot6, ot4, ot5] [] [(s.t1, ShouldSucceed.s)] + {- nonrec -} + s.t1 :: (ot4 -> ot6 -> ot5) -> (ot4 -> ot6) -> ot4 -> ot5 + s.t1 f.r57 g.r58 x.r59 + = f.r57 x.r59 (g.r58 x.r59) +AbsBinds [ot10, ot9] [] [(k.t8, ShouldSucceed.k)] + {- nonrec -} + k.t8 :: ot9 -> ot10 -> ot9 + k.t8 x.r60 y.r61 + = x.r60 +AbsBinds [tt20] [] [(main.t12, ShouldSucceed.main)] + {- nonrec -} + main.t12 :: tt20 -> tt20 + main.t12 + x.r56 = (ShouldSucceed.s [tt19 -> tt20, tt20, tt20]) + (ShouldSucceed.k [tt19 -> tt20, tt20]) + (ShouldSucceed.k [tt19, tt20]) + x.r56 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc025.hs b/ghc/compiler/tests/typecheck/should_succeed/tc025.hs new file mode 100644 index 0000000000..e9adf9acb5 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc025.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +g x = f (f True x) x where f x y = if x then y else (f x y) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc025.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc025.stderr new file mode 100644 index 0000000000..0cdf21db77 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc025.stderr @@ -0,0 +1,13 @@ +Typechecked: +AbsBinds [] [] [(g.t1, ShouldSucceed.g)] + {- nonrec -} + g.t1 :: Bool -> Bool + g.t1 x.r54 = (f.r55 Bool) ((f.r55 Bool) True x.r54) x.r54 + where + AbsBinds [ot7] [] [(f.t4, f.r55)] + {- rec -} + f.t4 :: Bool -> ot7 -> ot7 + f.t4 x.r56 y.r57 + = if x.r56 then y.r57 else f.t4 x.r56 y.r57 + {- nonrec -} + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc026.hs b/ghc/compiler/tests/typecheck/should_succeed/tc026.hs new file mode 100644 index 0000000000..3e718a5053 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc026.hs @@ -0,0 +1,4 @@ +module ShouldSucceed where + +g x = f (f True x) x +f x y = if x then y else (f x y) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc026.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc026.stderr new file mode 100644 index 0000000000..6d046909b2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc026.stderr @@ -0,0 +1,12 @@ +Typechecked: +AbsBinds [ot4] [] [(f.t1, ShouldSucceed.f)] + {- rec -} + f.t1 :: Bool -> ot4 -> ot4 + f.t1 x.r56 y.r57 + = if x.r56 then y.r57 else f.t1 x.r56 y.r57 +AbsBinds [] [] [(g.t6, ShouldSucceed.g)] + {- nonrec -} + g.t6 :: Bool -> Bool + g.t6 x.r55 = (ShouldSucceed.f Bool) + ((ShouldSucceed.f Bool) True x.r55) x.r55 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc027.hs b/ghc/compiler/tests/typecheck/should_succeed/tc027.hs new file mode 100644 index 0000000000..6edc01b619 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc027.hs @@ -0,0 +1,5 @@ +module ShouldSucceed where + +h x = f (f True x) x +f x y = if x then y else (g y x) +g y x = if x then y else (f x y) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc027.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc027.stderr new file mode 100644 index 0000000000..d202a0712f --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc027.stderr @@ -0,0 +1,15 @@ +Typechecked: +AbsBinds [ot9] [] [(f.t2, ShouldSucceed.f), (g.t3, ShouldSucceed.g)] + {- rec -} + f.t2 :: Bool -> ot9 -> ot9 + f.t2 x.r57 y.r58 + = if x.r57 then y.r58 else g.t3 y.r58 x.r57 + g.t3 :: ot9 -> Bool -> ot9 + g.t3 y.r60 x.r59 + = if x.r59 then y.r60 else f.t2 x.r59 y.r60 +AbsBinds [] [] [(h.t11, ShouldSucceed.h)] + {- nonrec -} + h.t11 :: Bool -> Bool + h.t11 + x.r56 = (ShouldSucceed.f Bool) ((ShouldSucceed.f Bool) True x.r56) x.r56 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc028.hs b/ghc/compiler/tests/typecheck/should_succeed/tc028.hs new file mode 100644 index 0000000000..49a0835ade --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc028.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +type H = (Int,Bool) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc028.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc028.stderr new file mode 100644 index 0000000000..72c2f6f06c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc028.stderr @@ -0,0 +1,3 @@ +Typechecked: + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc029.hs b/ghc/compiler/tests/typecheck/should_succeed/tc029.hs new file mode 100644 index 0000000000..c44b78f79f --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc029.hs @@ -0,0 +1,6 @@ +module ShouldSucceed where + +type G = [Int] + +data K = H Bool | M G + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc029.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc029.stderr new file mode 100644 index 0000000000..72c2f6f06c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc029.stderr @@ -0,0 +1,3 @@ +Typechecked: + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc030.hs b/ghc/compiler/tests/typecheck/should_succeed/tc030.hs new file mode 100644 index 0000000000..004bc226d1 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc030.hs @@ -0,0 +1,5 @@ +module ShouldSucceed where + +type H = [Bool] + +type G = (H,Char) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc030.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc030.stderr new file mode 100644 index 0000000000..72c2f6f06c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc030.stderr @@ -0,0 +1,3 @@ +Typechecked: + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc031.hs b/ghc/compiler/tests/typecheck/should_succeed/tc031.hs new file mode 100644 index 0000000000..c55bf11f54 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc031.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +data Rec = Node Int Rec diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc031.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc031.stderr new file mode 100644 index 0000000000..72c2f6f06c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc031.stderr @@ -0,0 +1,3 @@ +Typechecked: + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc032.hs b/ghc/compiler/tests/typecheck/should_succeed/tc032.hs new file mode 100644 index 0000000000..9c43bbb010 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc032.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +data AList b = Node b [b] | Other (b,Char) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc032.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc032.stderr new file mode 100644 index 0000000000..72c2f6f06c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc032.stderr @@ -0,0 +1,3 @@ +Typechecked: + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc033.hs b/ghc/compiler/tests/typecheck/should_succeed/tc033.hs new file mode 100644 index 0000000000..7111d75a4e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc033.hs @@ -0,0 +1,7 @@ +module ShouldSucceed where + +data Twine = Twine2 Twist + +data Twist = Twist2 Twine + +type F = Twine diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc033.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc033.stderr new file mode 100644 index 0000000000..72c2f6f06c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc033.stderr @@ -0,0 +1,3 @@ +Typechecked: + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc034.hs b/ghc/compiler/tests/typecheck/should_succeed/tc034.hs new file mode 100644 index 0000000000..0e7c4a66ed --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc034.hs @@ -0,0 +1,11 @@ +module ShouldSucceed where + +data AList a = ANull | ANode a (AList a) + +type IntList = AList Int + +g (ANull) = 2 +g (ANode b (ANode c d)) | b = 3 + | True = 4 + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc034.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc034.stderr new file mode 100644 index 0000000000..88eac08b6b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc034.stderr @@ -0,0 +1,16 @@ +Typechecked: +AbsBinds [tt12] [d.Num.t15] [(g.t1, ShouldSucceed.g)] + (fromInt.t14, fromInt tt12 d.Num.t15) + (lit.t4, fromInt.t14 (MkInt 2#)) + (fromInt.t16, fromInt.t14) + (lit.t13, fromInt.t16 (MkInt 4#)) + (fromInt.t17, fromInt.t16) + (lit.t11, fromInt.t17 (MkInt 3#)) + {- nonrec -} + g.t1 :: ShouldSucceed.AList Bool -> tt12 + g.t1 ShouldSucceed.ANull + = lit.t4 + g.t1 (ShouldSucceed.ANode b.r59 (ShouldSucceed.ANode c.r60 d.r61)) + | b.r59 = lit.t11 + | True = lit.t13 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc035.hs b/ghc/compiler/tests/typecheck/should_succeed/tc035.hs new file mode 100644 index 0000000000..b8dd554373 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc035.hs @@ -0,0 +1,9 @@ +module ShouldSucceed where + +type AnnExpr a = (a,Expr a) + +data Expr a = Var [Char] + | App (AnnExpr a) (AnnExpr a) + +g (a,(Var name)) = [name] +g (a,(App e1 e2)) = (g e1) ++ (g e2) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc035.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc035.stderr new file mode 100644 index 0000000000..677e2a15ca --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc035.stderr @@ -0,0 +1,9 @@ +Typechecked: +AbsBinds [a.t10] [] [(g.t1, ShouldSucceed.g)] + {- rec -} + g.t1 :: ShouldSucceed.AnnExpr a.t10 -> [[Char]] + g.t1 (a.r60, (ShouldSucceed.Var name.r61)) + = [name.r61] ([Char]) + g.t1 (a.r62, (ShouldSucceed.App e1.r63 e2.r64)) + = ((++) [Char]) (g.t1 e1.r63) (g.t1 e2.r64) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc036.hs b/ghc/compiler/tests/typecheck/should_succeed/tc036.hs new file mode 100644 index 0000000000..05b87846ac --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc036.hs @@ -0,0 +1,4 @@ +module ShouldSucceed where + +class (Eq a) => A a where + op1 :: a -> a diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc036.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc036.stderr new file mode 100644 index 0000000000..1cd9d2380d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc036.stderr @@ -0,0 +1,12 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.A.op1 = /\ a.t0 -> \{-classdict-} [d.Eq.t2] [op1.t1] -> op1.t1 +sdsel.ShouldSucceed.A.Eq = + /\ a.t0 -> \{-classdict-} [d.Eq.t2] [op1.t1] -> d.Eq.t2 +{- nonrec -} +defm.ShouldSucceed.A.op1 = + /\ a.t3 -> + \{-dict-} d.ShouldSucceed.A.t4 -> + (error (a.t3 -> a.t3)) + "No default method for \"ShouldSucceed.A.defm.ShouldSucceed.A.op1\"\n" + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc037.hi b/ghc/compiler/tests/typecheck/should_succeed/tc037.hi new file mode 100644 index 0000000000..026e6c2b5c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc037.hi @@ -0,0 +1,6 @@ +interface ShouldSucceed where { +class Eq' a where { + deq :: a -> a -> Bool + }; +instance (Eq' a) => Eq' [a] {-# FROMMODULE ShouldSucceed #-} +} diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc037.hs b/ghc/compiler/tests/typecheck/should_succeed/tc037.hs new file mode 100644 index 0000000000..8621b278d3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc037.hs @@ -0,0 +1,9 @@ +module ShouldSucceed where + +class Eq' a where + deq :: a -> a -> Bool + +instance (Eq' a) => Eq' [a] where + deq [] [] = True + deq (x:xs) (y:ys) = if (x `deq` y) then (deq xs ys) else False + deq other1 other2 = False diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc037.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc037.stderr new file mode 100644 index 0000000000..87167e2893 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc037.stderr @@ -0,0 +1,34 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq'.deq = /\ a.t21 -> \{-classdict-} [] [deq.t22] -> deq.t22 +{- nonrec -} +defm.ShouldSucceed.Eq'.deq = + /\ a.t23 -> + \{-dict-} d.ShouldSucceed.Eq'.t24 -> + (error (a.t23 -> a.t23 -> Bool)) + "No default method for \"ShouldSucceed.Eq'.defm.ShouldSucceed.Eq'.deq\"\n" +AbsBinds +[a.t0] +[d.ShouldSucceed.Eq'.t1] +[(d.ShouldSucceed.Eq'.t2, dfun.ShouldSucceed.Eq'.List)] + (d.ShouldSucceed.Eq'.t19, d.ShouldSucceed.Eq'.t2) + (ShouldSucceed.Eq'.deq.t16, + ShouldSucceed.Eq'.deq [a.t0] d.ShouldSucceed.Eq'.t19) + (d.ShouldSucceed.Eq'.t20, d.ShouldSucceed.Eq'.t1) + (ShouldSucceed.Eq'.deq.t13, + ShouldSucceed.Eq'.deq a.t0 d.ShouldSucceed.Eq'.t20) + {- rec -} + d.ShouldSucceed.Eq'.t2 = ({-dict-} [] [deq.t3]) + deq.t3 :: [a.t0] -> [a.t0] -> Bool + deq.t3 + [] [] = True + deq.t3 + (x.r29 : xs.r30) (y.r31 : ys.r32) + = if x.r29 `ShouldSucceed.Eq'.deq.t13` y.r31 then + ShouldSucceed.Eq'.deq.t16 xs.r30 ys.r32 + else + False + deq.t3 + other1.r33 other2.r34 + = False + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc038.hs b/ghc/compiler/tests/typecheck/should_succeed/tc038.hs new file mode 100644 index 0000000000..d404ee6913 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc038.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +f (x:xs) = if (x == (fromInteger 2)) then xs else [] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc038.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc038.stderr new file mode 100644 index 0000000000..1e044f96e2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc038.stderr @@ -0,0 +1,15 @@ +Typechecked: +fromInt.t16 = int2Integer +lit.t10 = fromInt.t16 (MkInt 2#) +AbsBinds [tt12] [d.Num.t14] [(f.t1, ShouldSucceed.f)] + (d.Eq.t15, sdsel.Num.Eq tt12 d.Num.t14) + (fromInteger.t8, fromInteger tt12 d.Num.t14) + (==.t6, (==) tt12 d.Eq.t15) + {- nonrec -} + f.t1 :: [tt12] -> [tt12] + f.t1 (x.r54 : xs.r55) + = if x.r54 ==.t6 (fromInteger.t8 lit.t10) then + xs.r55 + else + [] (tt12) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc039.hs b/ghc/compiler/tests/typecheck/should_succeed/tc039.hs new file mode 100644 index 0000000000..0e5bd9518c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc039.hs @@ -0,0 +1,4 @@ +module ShouldSucc where + +class (Eq a) => A a where + op1 :: a -> a diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc039.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc039.stderr new file mode 100644 index 0000000000..025c3e9b60 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc039.stderr @@ -0,0 +1,11 @@ +Typechecked: +{- nonrec -} +ShouldSucc.A.op1 = /\ a.t0 -> \{-classdict-} [d.Eq.t2] [op1.t1] -> op1.t1 +sdsel.ShouldSucc.A.Eq = /\ a.t0 -> \{-classdict-} [d.Eq.t2] [op1.t1] -> d.Eq.t2 +{- nonrec -} +defm.ShouldSucc.A.op1 = + /\ a.t3 -> + \{-dict-} d.ShouldSucc.A.t4 -> + (error (a.t3 -> a.t3)) + "No default method for \"ShouldSucc.A.defm.ShouldSucc.A.op1\"\n" + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc040.hi b/ghc/compiler/tests/typecheck/should_succeed/tc040.hi new file mode 100644 index 0000000000..41d1ee57b3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc040.hi @@ -0,0 +1,4 @@ +interface ShouldSucceed where { +import PreludeCore(Eq) +f :: Eq a => a -> [a] +} diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc040.hs b/ghc/compiler/tests/typecheck/should_succeed/tc040.hs new file mode 100644 index 0000000000..33113cc07d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc040.hs @@ -0,0 +1,9 @@ +module ShouldSucceed where + +--!!! tests the deduction of contexts. + +f :: (Eq a) => a -> [a] + +f x = g x + where + g y = if (y == x) then [] else [y] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc040.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc040.stderr new file mode 100644 index 0000000000..686e842145 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc040.stderr @@ -0,0 +1,17 @@ +Typechecked: +AbsBinds [a.t2] [d.Eq.t3] [(f.t1, ShouldSucceed.f)] + (d.Eq.t12, d.Eq.t3) + (==.t9, (==) a.t2 d.Eq.t12) + {- nonrec -} + f.t1 :: a.t2 -> [a.t2] + f.t1 x.r55 = g.r56 x.r55 + where + AbsBinds [] [] [(g.t6, g.r56)] + {- nonrec -} + g.t6 :: a.t2 -> [a.t2] + g.t6 y.r57 = if y.r57 ==.t9 x.r55 then + [] (a.t2) + else + [y.r57] (a.t2) + {- nonrec -} + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc041.hs b/ghc/compiler/tests/typecheck/should_succeed/tc041.hs new file mode 100644 index 0000000000..730af9c1ae --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc041.hs @@ -0,0 +1,12 @@ +--!!! a very simple test of class and instance declarations + +module ShouldSucceed where + +class H a where + op1 :: a -> a -> a + +instance H Bool where + op1 x y = y + +f :: Bool -> Int -> Bool +f x y = op1 x x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc041.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc041.stderr new file mode 100644 index 0000000000..1087bed893 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc041.stderr @@ -0,0 +1,22 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.H.op1 = /\ a.t8 -> \{-classdict-} [] [op1.t9] -> op1.t9 +{- nonrec -} +defm.ShouldSucceed.H.op1 = + /\ a.t10 -> + \{-dict-} d.ShouldSucceed.H.t11 -> + (error (a.t10 -> a.t10 -> a.t10)) + "No default method for \"ShouldSucceed.H.defm.ShouldSucceed.H.op1\"\n" +{- rec -} +dfun.ShouldSucceed.H.Bool = ({-dict-} [] [const.ShouldSucceed.H.Bool.op1]) +const.ShouldSucceed.H.Bool.op1 :: Bool -> Bool -> Bool +const.ShouldSucceed.H.Bool.op1 + x.r29 y.r30 + = y.r30 +AbsBinds [] [] [(f.t1, ShouldSucceed.f)] + (ShouldSucceed.H.op1.t5, const.ShouldSucceed.H.Bool.op1) + {- nonrec -} + f.t1 :: Bool -> Int -> Bool + f.t1 x.r58 y.r59 + = ShouldSucceed.H.op1.t5 x.r58 x.r58 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc042.hs b/ghc/compiler/tests/typecheck/should_succeed/tc042.hs new file mode 100644 index 0000000000..708ea26d67 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc042.hs @@ -0,0 +1,73 @@ +--!!! a file mailed us by Ryzard Kubiak. This provides a good test of the code +--!!! handling type signatures and recursive data types. + +module ShouldSucceed where + +data Boolean = FF | TT +data Pair a b = Mkpair a b +data List alpha = Nil | Cons alpha (List alpha) +data Nat = Zero | Succ Nat +data Tree t = Leaf t | Node (Tree t) (Tree t) + +idb :: Boolean -> Boolean +idb x = x + + +swap :: Pair a b -> Pair b a +swap t = case t of + Mkpair x y -> Mkpair y x + +neg :: Boolean -> Boolean +neg b = case b of + FF -> TT + TT -> FF + +nUll :: List alpha -> Boolean +nUll l = case l of + Nil -> TT + Cons y ys -> FF + +idl :: List a -> List a +idl xs = case xs of + Nil -> Nil + Cons y ys -> Cons y (idl ys) + +add :: Nat -> Nat -> Nat +add a b = case a of + Zero -> b + Succ c -> Succ (add c b) + +app :: List alpha -> List alpha -> List alpha +app xs zs = case xs of + Nil -> zs + Cons y ys -> Cons y (app ys zs) + +lEngth :: List a -> Nat +lEngth xs = case xs of + Nil -> Zero + Cons y ys -> Succ(lEngth ys) + +before :: List Nat -> List Nat +before xs = case xs of + Nil -> Nil + Cons y ys -> case y of + Zero -> Nil + Succ n -> Cons y (before ys) + +rEverse :: List alpha -> List alpha +rEverse rs = case rs of + Nil -> Nil + Cons y ys -> app (rEverse ys) (Cons y Nil) + + +flatten :: Tree alpha -> List alpha +flatten t = case t of + Leaf x -> Cons x Nil + Node l r -> app (flatten l) (flatten r) + +sUm :: Tree Nat -> Nat +sUm t = case t of + Leaf t -> t + Node l r -> add (sUm l) (sUm r) + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc042.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc042.stderr new file mode 100644 index 0000000000..ee74e981e1 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc042.stderr @@ -0,0 +1,125 @@ +Typechecked: +AbsBinds [] [] [(idb.t1, ShouldSucceed.idb)] + {- nonrec -} + idb.t1 :: ShouldSucceed.Boolean -> ShouldSucceed.Boolean + idb.t1 + x.r91 = x.r91 +AbsBinds [a.t12, b.t13] [] [(swap.t4, ShouldSucceed.swap)] + {- nonrec -} + swap.t4 :: ShouldSucceed.Pair b.t13 a.t12 -> ShouldSucceed.Pair a.t12 b.t13 + swap.t4 + t.r92 = case t.r92 of + (ShouldSucceed.Mkpair x.r93 y.r94) + -> (ShouldSucceed.Mkpair [a.t12, b.t13]) y.r94 x.r93 +AbsBinds [] [] [(neg.t16, ShouldSucceed.neg)] + {- nonrec -} + neg.t16 :: ShouldSucceed.Boolean -> ShouldSucceed.Boolean + neg.t16 + b.r95 = case b.r95 of + ShouldSucceed.FF + -> ShouldSucceed.TT + ShouldSucceed.TT + -> ShouldSucceed.FF +AbsBinds [alpha.t26] [] [(null.t20, ShouldSucceed.null)] + {- nonrec -} + null.t20 :: ShouldSucceed.List alpha.t26 -> ShouldSucceed.Boolean + null.t20 + l.r96 = case l.r96 of + ShouldSucceed.Nil + -> ShouldSucceed.TT + (ShouldSucceed.Cons y.r97 ys.r98) + -> ShouldSucceed.FF +AbsBinds [a.t30] [] [(idl.t29, ShouldSucceed.idl)] + {- rec -} + idl.t29 :: ShouldSucceed.List a.t30 -> ShouldSucceed.List a.t30 + idl.t29 + xs.r99 = case xs.r99 of + ShouldSucceed.Nil + -> ShouldSucceed.Nil a.t30 + (ShouldSucceed.Cons y.r100 ys.r101) + -> (ShouldSucceed.Cons a.t30) + y.r100 (idl.t29 ys.r101) +AbsBinds [] [] [(add.t41, ShouldSucceed.add)] + {- rec -} + add.t41 :: ShouldSucceed.Nat -> ShouldSucceed.Nat -> ShouldSucceed.Nat + add.t41 + a.r102 b.r103 + = case a.r102 of + ShouldSucceed.Zero + -> b.r103 + (ShouldSucceed.Succ c.r104) + -> ShouldSucceed.Succ (add.t41 c.r104 b.r103) +AbsBinds [alpha.t49] [] [(app.t48, ShouldSucceed.app)] + {- rec -} + app.t48 :: + ShouldSucceed.List alpha.t49 + -> ShouldSucceed.List alpha.t49 -> ShouldSucceed.List alpha.t49 + app.t48 + xs.r105 zs.r106 + = case xs.r105 of + ShouldSucceed.Nil + -> zs.r106 + (ShouldSucceed.Cons y.r107 ys.r108) + -> (ShouldSucceed.Cons alpha.t49) + y.r107 (app.t48 ys.r108 zs.r106) +AbsBinds [a.t61] [] [(length.t60, ShouldSucceed.length)] + {- rec -} + length.t60 :: ShouldSucceed.List a.t61 -> ShouldSucceed.Nat + length.t60 + xs.r109 = case xs.r109 of + ShouldSucceed.Nil + -> ShouldSucceed.Zero + (ShouldSucceed.Cons y.r110 ys.r111) + -> ShouldSucceed.Succ (length.t60 ys.r111) +AbsBinds [] [] [(before.t70, ShouldSucceed.before)] + {- rec -} + before.t70 :: + ShouldSucceed.List ShouldSucceed.Nat + -> ShouldSucceed.List ShouldSucceed.Nat + before.t70 + xs.r112 = case xs.r112 of + ShouldSucceed.Nil + -> ShouldSucceed.Nil ShouldSucceed.Nat + (ShouldSucceed.Cons y.r113 ys.r114) + -> case y.r113 of + ShouldSucceed.Zero + -> ShouldSucceed.Nil ShouldSucceed.Nat + (ShouldSucceed.Succ n.r115) + -> (ShouldSucceed.Cons + ShouldSucceed.Nat) + y.r113 (before.t70 ys.r114) +AbsBinds [alpha.t95] [] [(reverse.t84, ShouldSucceed.reverse)] + {- rec -} + reverse.t84 :: ShouldSucceed.List alpha.t95 -> ShouldSucceed.List alpha.t95 + reverse.t84 + rs.r116 = case rs.r116 of + ShouldSucceed.Nil + -> ShouldSucceed.Nil alpha.t95 + (ShouldSucceed.Cons y.r117 ys.r118) + -> (ShouldSucceed.app alpha.t95) + (reverse.t84 ys.r118) + ((ShouldSucceed.Cons alpha.t95) + y.r117 (ShouldSucceed.Nil alpha.t95)) +AbsBinds [alpha.t108] [] [(flatten.t98, ShouldSucceed.flatten)] + {- rec -} + flatten.t98 :: + ShouldSucceed.Tree alpha.t108 -> ShouldSucceed.List alpha.t108 + flatten.t98 + t.r119 = case t.r119 of + (ShouldSucceed.Leaf x.r120) + -> (ShouldSucceed.Cons alpha.t108) + x.r120 (ShouldSucceed.Nil alpha.t108) + (ShouldSucceed.Node l.r121 r.r122) + -> (ShouldSucceed.app alpha.t108) + (flatten.t98 l.r121) (flatten.t98 r.r122) +AbsBinds [] [] [(sum.t113, ShouldSucceed.sum)] + {- rec -} + sum.t113 :: ShouldSucceed.Tree ShouldSucceed.Nat -> ShouldSucceed.Nat + sum.t113 + t.r123 = case t.r123 of + (ShouldSucceed.Leaf t.r124) + -> t.r124 + (ShouldSucceed.Node l.r125 r.r126) + -> ShouldSucceed.add + (sum.t113 l.r125) (sum.t113 r.r126) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc043.hs b/ghc/compiler/tests/typecheck/should_succeed/tc043.hs new file mode 100644 index 0000000000..727f2886ae --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc043.hs @@ -0,0 +1,18 @@ +module ShouldSucceed where + +--!!! another simple test of class and instance code. + +class A a where + op1 :: a + +instance A Int where + op1 = 2 + +f x = op1 + +class B b where + op2 :: b -> Int + +instance (B a) => B [a] where + op2 [] = 0 + op2 (x:xs) = 1 + op2 xs diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc043.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc043.stderr new file mode 100644 index 0000000000..e6c0b1d32a --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc043.stderr @@ -0,0 +1,44 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.A.op1 = /\ a.t26 -> \{-classdict-} [] [op1.t27] -> op1.t27 +{- nonrec -} +defm.ShouldSucceed.A.op1 = + /\ a.t28 -> + \{-dict-} d.ShouldSucceed.A.t29 -> + (error a.t28) + "No default method for \"ShouldSucceed.A.defm.ShouldSucceed.A.op1\"\n" +{- nonrec -} +ShouldSucceed.B.op2 = /\ b.t30 -> \{-classdict-} [] [op2.t31] -> op2.t31 +{- nonrec -} +defm.ShouldSucceed.B.op2 = + /\ b.t32 -> + \{-dict-} d.ShouldSucceed.B.t33 -> + (error (b.t32 -> Int)) + "No default method for \"ShouldSucceed.B.defm.ShouldSucceed.B.op2\"\n" +{- rec -} +dfun.ShouldSucceed.A.Int = ({-dict-} [] [const.ShouldSucceed.A.Int.op1]) +const.ShouldSucceed.A.Int.op1 :: Int +const.ShouldSucceed.A.Int.op1 = lit.t7 +AbsBinds +[a.t8] +[d.ShouldSucceed.B.t9] +[(d.ShouldSucceed.B.t10, dfun.ShouldSucceed.B.List)] + (d.ShouldSucceed.B.t25, d.ShouldSucceed.B.t10) + (ShouldSucceed.B.op2.t23, ShouldSucceed.B.op2 [a.t8] d.ShouldSucceed.B.t25) + (+.t19, plusInt) + {- rec -} + d.ShouldSucceed.B.t10 = ({-dict-} [] [op2.t11]) + op2.t11 :: [a.t8] -> Int + op2.t11 + [] = lit.t14 + op2.t11 + (x.r14 : xs.r15) + = lit.t21 +.t19 (ShouldSucceed.B.op2.t23 xs.r15) +lit.t7 = MkInt 2# +lit.t14 = MkInt 0# +lit.t21 = MkInt 1# +AbsBinds [ot2, a.t3] [d.ShouldSucceed.A.t5] [(f.t1, ShouldSucceed.f)] + (ShouldSucceed.A.op1.t4, ShouldSucceed.A.op1 a.t3 d.ShouldSucceed.A.t5) + {- nonrec -} + f.t1 :: ot2 -> a.t3 + f.t1 x.r61 = ShouldSucceed.A.op1.t4 diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc044.hs b/ghc/compiler/tests/typecheck/should_succeed/tc044.hs new file mode 100644 index 0000000000..9f98989bb1 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc044.hs @@ -0,0 +1,6 @@ +-- once produced a bug, here as regression test + +module P where + +f _ | otherwise = () + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc044.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc044.stderr new file mode 100644 index 0000000000..ff9d543e1a --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc044.stderr @@ -0,0 +1,6 @@ +Typechecked: +AbsBinds [ot2] [] [(f.t1, P.f)] + {- nonrec -} + f.t1 :: ot2 -> () + f.t1 _ | otherwise = () + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc045.hs b/ghc/compiler/tests/typecheck/should_succeed/tc045.hs new file mode 100644 index 0000000000..fc6a72ea97 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc045.hs @@ -0,0 +1,19 @@ +module H where + +class C a where + op1 :: a -> a + +class (C a) => B a where + op2 :: a -> a -> a + +instance (B a) => B [a] where + op2 xs ys = xs + +instance C [a] where + op1 xs = xs + +{- This was passed by the prototype, but failed hard in the new +typechecker with the message + +Fail:No match in theta_class +-} diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc045.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc045.stderr new file mode 100644 index 0000000000..b44c2a43cd --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc045.stderr @@ -0,0 +1,32 @@ +Typechecked: +{- nonrec -} +H.B.op2 = /\ a.t11 -> \{-classdict-} [d.H.C.t13] [op2.t12] -> op2.t12 +sdsel.H.B.H.C = /\ a.t11 -> \{-classdict-} [d.H.C.t13] [op2.t12] -> d.H.C.t13 +{- nonrec -} +defm.H.B.op2 = + /\ a.t14 -> + \{-dict-} d.H.B.t15 -> + (error (a.t14 -> a.t14 -> a.t14)) + "No default method for \"H.B.defm.H.B.op2\"\n" +{- nonrec -} +H.C.op1 = /\ a.t16 -> \{-classdict-} [] [op1.t17] -> op1.t17 +{- nonrec -} +defm.H.C.op1 = + /\ a.t18 -> + \{-dict-} d.H.C.t19 -> + (error (a.t18 -> a.t18)) + "No default method for \"H.C.defm.H.C.op1\"\n" +AbsBinds [a.t0] [d.H.B.t2, d.H.C.t1] [(d.H.B.t3, dfun.H.B.List)] + {- rec -} + d.H.B.t3 = ({-dict-} [d.H.C.t1] [op2.t4]) + op2.t4 :: [a.t0] -> [a.t0] -> [a.t0] + op2.t4 + xs.r13 ys.r14 + = xs.r13 +AbsBinds [a.t7] [] [(d.H.C.t8, dfun.H.C.List)] + {- rec -} + d.H.C.t8 = ({-dict-} [] [op1.t9]) + op1.t9 :: [a.t7] -> [a.t7] + op1.t9 + xs.r16 = xs.r16 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc046.hs b/ghc/compiler/tests/typecheck/should_succeed/tc046.hs new file mode 100644 index 0000000000..dbbf3a176a --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc046.hs @@ -0,0 +1,9 @@ +module H where + +class C a where + op1 :: a -> a + +class (C a) => B a where + op2 :: a -> a -> a + +{- Failed hard in new tc with "No match in theta_class" -} diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc046.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc046.stderr new file mode 100644 index 0000000000..0626901980 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc046.stderr @@ -0,0 +1,19 @@ +Typechecked: +{- nonrec -} +H.B.op2 = /\ a.t0 -> \{-classdict-} [d.H.C.t2] [op2.t1] -> op2.t1 +sdsel.H.B.H.C = /\ a.t0 -> \{-classdict-} [d.H.C.t2] [op2.t1] -> d.H.C.t2 +{- nonrec -} +defm.H.B.op2 = + /\ a.t3 -> + \{-dict-} d.H.B.t4 -> + (error (a.t3 -> a.t3 -> a.t3)) + "No default method for \"H.B.defm.H.B.op2\"\n" +{- nonrec -} +H.C.op1 = /\ a.t5 -> \{-classdict-} [] [op1.t6] -> op1.t6 +{- nonrec -} +defm.H.C.op1 = + /\ a.t7 -> + \{-dict-} d.H.C.t8 -> + (error (a.t7 -> a.t7)) + "No default method for \"H.C.defm.H.C.op1\"\n" + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc047.hs b/ghc/compiler/tests/typecheck/should_succeed/tc047.hs new file mode 100644 index 0000000000..b8c197d185 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc047.hs @@ -0,0 +1,23 @@ +module ShouldSucceed where + +type OL a = [a] + +-- produces the interface: +-- data OL a = MkOL [a] deriving () +-- ranOAL :: (OL (a, a)) -> [a] +-- this interface was produced by BOTH hbc and nhc + +-- the following bogus type sig. was accepted by BOTH hbc and nhc +f x = ranOAL where -- ranOAL :: OL (a,v) -> [a] +--ranOAL :: OL (a,v) -> [v], the right sig. + ranOAL ( xs) = mp sd xs + + +mp f [] = [] +mp f (x:xs) = (f x) : mp f xs + +sd (f,s) = s + + + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc047.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc047.stderr new file mode 100644 index 0000000000..1dd0462395 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc047.stderr @@ -0,0 +1,29 @@ +Typechecked: +AbsBinds [tt8, tt4] [] [(mp.t1, ShouldSucceed.mp)] + {- rec -} + mp.t1 :: (tt8 -> tt4) -> [tt8] -> [tt4] + mp.t1 + f.r61 [] = [] (tt4) + mp.t1 + f.r62 (x.r63 : xs.r64) + = ((:) tt4) (f.r62 x.r63) (mp.t1 f.r62 xs.r64) +AbsBinds [tt17, tt18] [] [(sd.t14, ShouldSucceed.sd)] + {- nonrec -} + sd.t14 :: (tt17, tt18) -> tt18 + sd.t14 + (f.r65, s.r66) + = s.r66 +AbsBinds [ot21, tt29, tt30] [] [(f.t20, ShouldSucceed.f)] + {- nonrec -} + f.t20 :: ot21 -> [(tt29, tt30)] -> [tt30] + f.t20 + x.r58 = ranOAL.r59 [tt29, tt30] + where + AbsBinds [tt27, tt28] [] [(ranOAL.t23, ranOAL.r59)] + {- nonrec -} + ranOAL.t23 :: [(tt27, tt28)] -> [tt28] + ranOAL.t23 + xs.r60 = (ShouldSucceed.mp [(tt27, tt28), tt28]) + (ShouldSucceed.sd [tt27, tt28]) xs.r60 + {- nonrec -} + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc048.hs b/ghc/compiler/tests/typecheck/should_succeed/tc048.hs new file mode 100644 index 0000000000..eea6f10e79 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc048.hs @@ -0,0 +1,21 @@ +module ShouldSucceed where + +data OL a = MkOL [a] +data FG a b = MkFG (OL (a,b)) +data AFE n a b = MkAFE (OL (n,(FG a b))) + +--ranOAL :: OL (a,v) -> [a] +ranOAL :: OL (a,v) -> [v] +ranOAL (MkOL xs) = mAp sNd xs + +mAp f [] = [] +mAp f (x:xs) = (f x) : mAp f xs + +sNd (f,s) = s + +ranAFE :: AFE n a b -> [FG a b] -- ? +ranAFE (MkAFE nfs) = ranOAL nfs + + + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc048.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc048.stderr new file mode 100644 index 0000000000..1640beb4fb --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc048.stderr @@ -0,0 +1,31 @@ +Typechecked: +AbsBinds [tt8, tt4] [] [(map.t1, ShouldSucceed.map)] + {- rec -} + map.t1 :: (tt8 -> tt4) -> [tt8] -> [tt4] + map.t1 + f.r75 [] = [] (tt4) + map.t1 + f.r76 (x.r77 : xs.r78) + = ((:) tt4) (f.r76 x.r77) (map.t1 f.r76 xs.r78) +AbsBinds [tt17, tt18] [] [(snd.t14, ShouldSucceed.snd)] + {- nonrec -} + snd.t14 :: (tt17, tt18) -> tt18 + snd.t14 + (f.r79, s.r80) + = s.r80 +AbsBinds [a.t21, v.t22] [] [(ranOAL.t20, ShouldSucceed.ranOAL)] + {- nonrec -} + ranOAL.t20 :: ShouldSucceed.OL (a.t21, v.t22) -> [v.t22] + ranOAL.t20 + (ShouldSucceed.MkOL xs.r74) + = (ShouldSucceed.map [(a.t21, v.t22), v.t22]) + (ShouldSucceed.snd [a.t21, v.t22]) xs.r74 +AbsBinds [a.t38, a.t36, b.t37] [] [(ranAFE.t30, ShouldSucceed.ranAFE)] + {- nonrec -} + ranAFE.t30 :: + ShouldSucceed.AFE a.t38 a.t36 b.t37 -> [ShouldSucceed.FG a.t36 b.t37] + ranAFE.t30 + (ShouldSucceed.MkAFE nfs.r81) + = (ShouldSucceed.ranOAL [a.t38, ShouldSucceed.FG a.t36 b.t37]) + nfs.r81 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc049.hs b/ghc/compiler/tests/typecheck/should_succeed/tc049.hs new file mode 100644 index 0000000000..20be6b768b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc049.hs @@ -0,0 +1,39 @@ +module ShouldSucceed where + +fib n = if n <= 2 then n else fib (n-1) + fib (n-2) + +---------------------------------------- + +mem x [] = False +mem x (y:ys) = (x == y) `oR` mem x ys + +a `oR` b = if a then True else b + +---------------------------------------- + +mem1 x [] = False +mem1 x (y:ys) = (x == y) `oR1` mem2 x ys + +a `oR1` b = if a then True else b + +mem2 x [] = False +mem2 x (y:ys) = (x == y) `oR` mem1 x ys + +--------------------------------------- + +mem3 x [] = False +mem3 x (y:ys) = if [x] == [y] then mem4 x ys else False + +mem4 y (x:xs) = mem3 y xs + +--------------------------------------- + +main1 = [[(1,True)]] == [[(2,False)]] + +--------------------------------------- + +main2 = "Hello" == "Goodbye" + +--------------------------------------- + +main3 = [[1],[2]] == [[3]] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc049.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc049.stderr new file mode 100644 index 0000000000..1a5cf4513d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc049.stderr @@ -0,0 +1,123 @@ +Typechecked: +d.Num.t125 = dfun.Num.Integer +d.Num.t133 = dfun.Num.Integer +d.Eq.t130 = sdsel.Num.Eq tt105 d.Num.t125 +d.Eq.t138 = sdsel.Num.Eq tt121 d.Num.t133 +fromInt.t124 = fromInt tt105 d.Num.t125 +lit.t106 = fromInt.t124 (MkInt 2#) +fromInt.t126 = fromInt.t124 +lit.t104 = fromInt.t126 (MkInt 1#) +d.Eq.t131 = dfun.Eq.Bool +d.Eq.t129 = dfun.Eq.Tuple2 [tt105, Bool] [d.Eq.t130, d.Eq.t131] +(==.t128) = (==) (tt105, Bool) d.Eq.t129 +(==.t127) = eqList (tt105, Bool) ==.t128 +(==.t102) = eqList [(tt105, Bool)] ==.t127 +(==.t111) = eqString +fromInt.t132 = fromInt tt121 d.Num.t133 +lit.t122 = fromInt.t132 (MkInt 3#) +fromInt.t134 = fromInt.t132 +lit.t120 = fromInt.t134 (MkInt 2#) +fromInt.t135 = fromInt.t134 +lit.t118 = fromInt.t135 (MkInt 1#) +(==.t137) = (==) tt121 d.Eq.t138 +(==.t136) = eqList tt121 ==.t137 +(==.t116) = eqList [tt121] ==.t136 +AbsBinds [tt19] [d.Num.t24, d.Ord.t28] [(fib.t1, ShouldSucceed.fib)] + (fromInt.t23, fromInt tt19 d.Num.t24) + (lit.t20, fromInt.t23 (MkInt 2#)) + (d.Num.t25, d.Num.t24) + (-.t18, (-) tt19 d.Num.t25) + (fromInt.t26, fromInt.t23) + (lit.t14, fromInt.t26 (MkInt 1#)) + (-.t12, (-.t18)) + (d.Num.t27, d.Num.t25) + (+.t9, (+) tt19 d.Num.t27) + (lit.t6, lit.t20) + (<=.t4, (<=) tt19 d.Ord.t28) + {- rec -} + fib.t1 :: tt19 -> tt19 + fib.t1 + n.r64 = if n.r64 <=.t4 lit.t6 then + n.r64 + else + (fib.t1 (n.r64 -.t12 lit.t14)) + +.t9 (fib.t1 (n.r64 -.t18 lit.t20)) +AbsBinds [] [] [(oR.t30, ShouldSucceed.oR)] + {- nonrec -} + oR.t30 :: Bool -> Bool -> Bool + oR.t30 + a.r69 b.r70 + = if a.r69 then True else b.r70 +AbsBinds [tt41] [d.Eq.t46] [(mem.t34, ShouldSucceed.mem)] + (==.t42, (==) tt41 d.Eq.t46) + {- rec -} + mem.t34 :: tt41 -> [tt41] -> Bool + mem.t34 + x.r65 [] = False + mem.t34 + x.r66 (y.r67 : ys.r68) + = (x.r66 ==.t42 y.r67) `ShouldSucceed.oR` (mem.t34 x.r66 ys.r68) +AbsBinds [] [] [(oR1.t48, ShouldSucceed.oR1)] + {- nonrec -} + oR1.t48 :: Bool -> Bool -> Bool + oR1.t48 + a.r75 b.r76 + = if a.r75 then True else b.r76 +AbsBinds +[tt61] +[d.Eq.t77] +[(mem1.t53, ShouldSucceed.mem1), (mem2.t54, ShouldSucceed.mem2)] + (==.t62, (==) tt61 d.Eq.t77) + (==.t73, (==.t62)) + {- rec -} + mem1.t53 :: tt61 -> [tt61] -> Bool + mem1.t53 + x.r71 [] = False + mem1.t53 + x.r72 (y.r73 : ys.r74) + = (x.r72 ==.t62 y.r73) + `ShouldSucceed.oR1` (mem2.t54 x.r72 ys.r74) + mem2.t54 :: tt61 -> [tt61] -> Bool + mem2.t54 + x.r77 [] = False + mem2.t54 + x.r78 (y.r79 : ys.r80) + = (x.r78 ==.t73 y.r79) + `ShouldSucceed.oR` (mem1.t53 x.r78 ys.r80) +AbsBinds +[tt87] +[d.Eq.t98] +[(mem3.t80, ShouldSucceed.mem3), (mem4.t81, ShouldSucceed.mem4)] + (==.t97, (==) tt87 d.Eq.t98) + (==.t89, eqList tt87 ==.t97) + {- rec -} + mem3.t80 :: tt87 -> [tt87] -> Bool + mem3.t80 + x.r81 [] = False + mem3.t80 + x.r82 (y.r83 : ys.r84) + = if ([x.r82] (tt87)) ==.t89 ([y.r83] (tt87)) then + mem4.t81 x.r82 ys.r84 + else + False + mem4.t81 :: tt87 -> [tt87] -> Bool + mem4.t81 + y.r87 (x.r85 : xs.r86) + = mem3.t80 y.r87 xs.r86 +AbsBinds [] [] [(main1.t100, ShouldSucceed.main1)] + {- nonrec -} + main1.t100 :: Bool + main1.t100 + = ([[(lit.t104, True)] ((tt105, Bool))] ([(tt105, Bool)])) + ==.t102 ([[(lit.t106, False)] ((tt105, Bool))] ([(tt105, Bool)])) +AbsBinds [] [] [(main2.t109, ShouldSucceed.main2)] + {- nonrec -} + main2.t109 :: Bool + main2.t109 = "Hello" ==.t111 "Goodbye" +AbsBinds [] [] [(main3.t114, ShouldSucceed.main3)] + {- nonrec -} + main3.t114 :: Bool + main3.t114 + = ([[lit.t118] (tt121), [lit.t120] (tt121)] ([tt121])) + ==.t116 ([[lit.t122] (tt121)] ([tt121])) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc050.hs b/ghc/compiler/tests/typecheck/should_succeed/tc050.hs new file mode 100644 index 0000000000..ef03b282d9 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc050.hs @@ -0,0 +1,23 @@ +module ShouldSucceed where + +class Foo a where + o_and :: a -> a -> a + + +instance Foo Bool where + o_and False x = False + o_and x False = False + o_and True True = True + + +instance Foo Int where + o_and x 0 = 0 + o_and 0 x = 0 + o_and 1 1 = 1 + + +f x y = o_and x False + +g x y = o_and x 1 + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc050.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc050.stderr new file mode 100644 index 0000000000..dbe227f2e3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc050.stderr @@ -0,0 +1,60 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Foo.o_and = /\ a.t39 -> \{-classdict-} [] [o_and.t40] -> o_and.t40 +{- nonrec -} +defm.ShouldSucceed.Foo.o_and = + /\ a.t41 -> + \{-dict-} d.ShouldSucceed.Foo.t42 -> + (error (a.t41 -> a.t41 -> a.t41)) + "No default method for \"ShouldSucceed.Foo.defm.ShouldSucceed.Foo.o_and\"\n" +{- rec -} +dfun.ShouldSucceed.Foo.Bool = ({-dict-} [] [const.ShouldSucceed.Foo.Bool.o_and]) +const.ShouldSucceed.Foo.Bool.o_and :: Bool -> Bool -> Bool +const.ShouldSucceed.Foo.Bool.o_and + False x.r30 + = False +const.ShouldSucceed.Foo.Bool.o_and + x.r31 False + = False +const.ShouldSucceed.Foo.Bool.o_and + True True + = True +{- rec -} +dfun.ShouldSucceed.Foo.Int = ({-dict-} [] [const.ShouldSucceed.Foo.Int.o_and]) +const.ShouldSucceed.Foo.Int.o_and :: Int -> Int -> Int +const.ShouldSucceed.Foo.Int.o_and + x.r32 0 = lit.t24 +const.ShouldSucceed.Foo.Int.o_and + 0 x.r33 = lit.t30 +const.ShouldSucceed.Foo.Int.o_and + 1 1 = lit.t38 +lit.t21 = MkInt 0# +(==.t22) = eqInt +lit.t24 = lit.t21 +lit.t26 = lit.t21 +(==.t27) = (==.t22) +lit.t30 = lit.t21 +lit.t32 = MkInt 1# +(==.t33) = (==.t22) +lit.t35 = lit.t32 +(==.t36) = (==.t22) +lit.t38 = lit.t32 +AbsBinds [ot3] [] [(f.t1, ShouldSucceed.f)] + (ShouldSucceed.Foo.o_and.t5, const.ShouldSucceed.Foo.Bool.o_and) + {- nonrec -} + f.t1 :: Bool -> ot3 -> Bool + f.t1 x.r61 y.r62 + = ShouldSucceed.Foo.o_and.t5 x.r61 False +AbsBinds +[ot9, a.t10] +[d.Num.t15, d.ShouldSucceed.Foo.t16] +[(g.t7, ShouldSucceed.g)] + (fromInt.t14, fromInt a.t10 d.Num.t15) + (lit.t13, fromInt.t14 (MkInt 1#)) + (ShouldSucceed.Foo.o_and.t11, + ShouldSucceed.Foo.o_and a.t10 d.ShouldSucceed.Foo.t16) + {- nonrec -} + g.t7 :: a.t10 -> ot9 -> a.t10 + g.t7 x.r63 y.r64 + = ShouldSucceed.Foo.o_and.t11 x.r63 lit.t13 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc051.hs b/ghc/compiler/tests/typecheck/should_succeed/tc051.hs new file mode 100644 index 0000000000..7f14282fb8 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc051.hs @@ -0,0 +1,30 @@ +module ShouldSucceed where + +class Eq' a where + doubleeq :: a -> a -> Bool + +class (Eq' a) => Ord' a where + lt :: a -> a -> Bool + +instance Eq' Int where + doubleeq x y = True + +instance (Eq' a) => Eq' [a] where + doubleeq x y = True + +instance Ord' Int where + lt x y = True + +{- +class (Ord a) => Ix a where + range :: (a,a) -> [a] + +instance Ix Int where + range (x,y) = [x,y] +-} + + + + + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc051.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc051.stderr new file mode 100644 index 0000000000..7c9c45e345 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc051.stderr @@ -0,0 +1,49 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq'.doubleeq = + /\ a.t11 -> \{-classdict-} [] [doubleeq.t12] -> doubleeq.t12 +{- nonrec -} +defm.ShouldSucceed.Eq'.doubleeq = + /\ a.t13 -> + \{-dict-} d.ShouldSucceed.Eq'.t14 -> + (error (a.t13 -> a.t13 -> Bool)) + "No default method for \"ShouldSucceed.Eq'.defm.ShouldSucceed.Eq'.doubleeq\"\n" +{- nonrec -} +ShouldSucceed.Ord'.lt = + /\ a.t15 -> \{-classdict-} [d.ShouldSucceed.Eq'.t17] [lt.t16] -> lt.t16 +sdsel.ShouldSucceed.Ord'.ShouldSucceed.Eq' = + /\ a.t15 -> + \{-classdict-} [d.ShouldSucceed.Eq'.t17] [lt.t16] -> + d.ShouldSucceed.Eq'.t17 +{- nonrec -} +defm.ShouldSucceed.Ord'.lt = + /\ a.t18 -> + \{-dict-} d.ShouldSucceed.Ord'.t19 -> + (error (a.t18 -> a.t18 -> Bool)) + "No default method for \"ShouldSucceed.Ord'.defm.ShouldSucceed.Ord'.lt\"\n" +{- rec -} +dfun.ShouldSucceed.Eq'.Int = + ({-dict-} [] [const.ShouldSucceed.Eq'.Int.doubleeq]) +const.ShouldSucceed.Eq'.Int.doubleeq :: Int -> Int -> Bool +const.ShouldSucceed.Eq'.Int.doubleeq + x.r21 y.r22 + = True +AbsBinds +[a.t2] +[d.ShouldSucceed.Eq'.t3] +[(d.ShouldSucceed.Eq'.t4, dfun.ShouldSucceed.Eq'.List)] + {- rec -} + d.ShouldSucceed.Eq'.t4 = ({-dict-} [] [doubleeq.t5]) + doubleeq.t5 :: [a.t2] -> [a.t2] -> Bool + doubleeq.t5 + x.r24 y.r25 + = True +{- rec -} +dfun.ShouldSucceed.Ord'.Int = + ({-dict-} [d.ShouldSucceed.Eq'.t8] [const.ShouldSucceed.Ord'.Int.lt]) +const.ShouldSucceed.Ord'.Int.lt :: Int -> Int -> Bool +const.ShouldSucceed.Ord'.Int.lt + x.r53 y.r54 + = True +d.ShouldSucceed.Eq'.t8 = dfun.ShouldSucceed.Eq'.Int + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc052.hs b/ghc/compiler/tests/typecheck/should_succeed/tc052.hs new file mode 100644 index 0000000000..108ef12046 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc052.hs @@ -0,0 +1,8 @@ +module ShouldSucceed where + +type A a = B a + +type B c = C + +type C = Int + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc052.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc052.stderr new file mode 100644 index 0000000000..72c2f6f06c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc052.stderr @@ -0,0 +1,3 @@ +Typechecked: + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc053.hs b/ghc/compiler/tests/typecheck/should_succeed/tc053.hs new file mode 100644 index 0000000000..865211d917 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc053.hs @@ -0,0 +1,12 @@ +module ShouldSucceed where + +class Eq' a where + deq :: a -> a -> Bool + +instance Eq' Int where + deq x y = True + +instance (Eq' a) => Eq' [a] where + deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False + +f x = deq x [1] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc053.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc053.stderr new file mode 100644 index 0000000000..7b1e699590 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc053.stderr @@ -0,0 +1,45 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq'.deq = /\ a.t29 -> \{-classdict-} [] [deq.t30] -> deq.t30 +{- nonrec -} +defm.ShouldSucceed.Eq'.deq = + /\ a.t31 -> + \{-dict-} d.ShouldSucceed.Eq'.t32 -> + (error (a.t31 -> a.t31 -> Bool)) + "No default method for \"ShouldSucceed.Eq'.defm.ShouldSucceed.Eq'.deq\"\n" +{- rec -} +dfun.ShouldSucceed.Eq'.Int = ({-dict-} [] [const.ShouldSucceed.Eq'.Int.deq]) +const.ShouldSucceed.Eq'.Int.deq :: Int -> Int -> Bool +const.ShouldSucceed.Eq'.Int.deq + x.r29 y.r30 + = True +AbsBinds +[a.t13] +[d.ShouldSucceed.Eq'.t14] +[(d.ShouldSucceed.Eq'.t15, dfun.ShouldSucceed.Eq'.List)] + (d.ShouldSucceed.Eq'.t27, d.ShouldSucceed.Eq'.t15) + (ShouldSucceed.Eq'.deq.t26, + ShouldSucceed.Eq'.deq [a.t13] d.ShouldSucceed.Eq'.t27) + (d.ShouldSucceed.Eq'.t28, d.ShouldSucceed.Eq'.t14) + (ShouldSucceed.Eq'.deq.t24, + ShouldSucceed.Eq'.deq a.t13 d.ShouldSucceed.Eq'.t28) + {- rec -} + d.ShouldSucceed.Eq'.t15 = ({-dict-} [] [deq.t16]) + deq.t16 :: [a.t13] -> [a.t13] -> Bool + deq.t16 + (a.r32 : as.r33) (b.r34 : bs.r35) + = if ShouldSucceed.Eq'.deq.t24 a.r32 b.r34 then + ShouldSucceed.Eq'.deq.t26 as.r33 bs.r35 + else + False +AbsBinds [tt5] [d.Num.t8, d.ShouldSucceed.Eq'.t10] [(f.t1, ShouldSucceed.f)] + (fromInt.t7, fromInt tt5 d.Num.t8) + (lit.t6, fromInt.t7 (MkInt 1#)) + (d.ShouldSucceed.Eq'.t9, + dfun.ShouldSucceed.Eq'.List tt5 d.ShouldSucceed.Eq'.t10) + (ShouldSucceed.Eq'.deq.t4, + ShouldSucceed.Eq'.deq [tt5] d.ShouldSucceed.Eq'.t9) + {- nonrec -} + f.t1 :: [tt5] -> Bool + f.t1 x.r63 = ShouldSucceed.Eq'.deq.t4 x.r63 ([lit.t6] (tt5)) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc054.hs b/ghc/compiler/tests/typecheck/should_succeed/tc054.hs new file mode 100644 index 0000000000..df9deb08aa --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc054.hs @@ -0,0 +1,16 @@ +module ShouldSucceed where + +class Eq' a where + doubleeq :: a -> a -> Bool + +class (Eq' a) => Ord' a where + lt :: a -> a -> Bool + +instance Eq' Int where + doubleeq x y = True + +instance Ord' Int where + lt x y = True + +f x y | lt x 1 = True + | otherwise = False diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc054.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc054.stderr new file mode 100644 index 0000000000..72d4f4f8c2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc054.stderr @@ -0,0 +1,52 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq'.doubleeq = + /\ a.t16 -> \{-classdict-} [] [doubleeq.t17] -> doubleeq.t17 +{- nonrec -} +defm.ShouldSucceed.Eq'.doubleeq = + /\ a.t18 -> + \{-dict-} d.ShouldSucceed.Eq'.t19 -> + (error (a.t18 -> a.t18 -> Bool)) + "No default method for \"ShouldSucceed.Eq'.defm.ShouldSucceed.Eq'.doubleeq\"\n" +{- nonrec -} +ShouldSucceed.Ord'.lt = + /\ a.t20 -> \{-classdict-} [d.ShouldSucceed.Eq'.t22] [lt.t21] -> lt.t21 +sdsel.ShouldSucceed.Ord'.ShouldSucceed.Eq' = + /\ a.t20 -> + \{-classdict-} [d.ShouldSucceed.Eq'.t22] [lt.t21] -> + d.ShouldSucceed.Eq'.t22 +{- nonrec -} +defm.ShouldSucceed.Ord'.lt = + /\ a.t23 -> + \{-dict-} d.ShouldSucceed.Ord'.t24 -> + (error (a.t23 -> a.t23 -> Bool)) + "No default method for \"ShouldSucceed.Ord'.defm.ShouldSucceed.Ord'.lt\"\n" +{- rec -} +dfun.ShouldSucceed.Eq'.Int = + ({-dict-} [] [const.ShouldSucceed.Eq'.Int.doubleeq]) +const.ShouldSucceed.Eq'.Int.doubleeq :: Int -> Int -> Bool +const.ShouldSucceed.Eq'.Int.doubleeq + x.r22 y.r23 + = True +{- rec -} +dfun.ShouldSucceed.Ord'.Int = + ({-dict-} [d.ShouldSucceed.Eq'.t13] [const.ShouldSucceed.Ord'.Int.lt]) +const.ShouldSucceed.Ord'.Int.lt :: Int -> Int -> Bool +const.ShouldSucceed.Ord'.Int.lt + x.r51 y.r52 + = True +d.ShouldSucceed.Eq'.t13 = dfun.ShouldSucceed.Eq'.Int +AbsBinds +[a.t4, ot3] +[d.Num.t9, d.ShouldSucceed.Ord'.t10] +[(f.t1, ShouldSucceed.f)] + (fromInt.t8, fromInt a.t4 d.Num.t9) + (lit.t7, fromInt.t8 (MkInt 1#)) + (ShouldSucceed.Ord'.lt.t5, + ShouldSucceed.Ord'.lt a.t4 d.ShouldSucceed.Ord'.t10) + {- nonrec -} + f.t1 :: a.t4 -> ot3 -> Bool + f.t1 x.r62 y.r63 + | ShouldSucceed.Ord'.lt.t5 x.r62 lit.t7 = True + | otherwise = False + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc055.hs b/ghc/compiler/tests/typecheck/should_succeed/tc055.hs new file mode 100644 index 0000000000..cdbb8f4b4d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc055.hs @@ -0,0 +1,3 @@ +module ShouldSucceed where + +(x,y) = (\p -> p,\q -> q) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc055.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc055.stderr new file mode 100644 index 0000000000..ba7f37f2fa --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc055.stderr @@ -0,0 +1,8 @@ +Typechecked: +AbsBinds [ot6, ot7] [] [(x.t2, ShouldSucceed.x), (y.t3, ShouldSucceed.y)] + {- nonrec -} + (x.t2, y.t3) :: (ot6 -> ot6, ot7 -> ot7) + (x.t2, y.t3) + = (\ p.r55 -> p.r55, + \ q.r56 -> q.r56) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc056.hs b/ghc/compiler/tests/typecheck/should_succeed/tc056.hs new file mode 100644 index 0000000000..f5198f245d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc056.hs @@ -0,0 +1,15 @@ +module ShouldSucceed where + +class Eq' a where + doubleeq :: a -> a -> Bool + +class (Eq' a) => Ord' a where + lt :: a -> a -> Bool + +instance Eq' Int where + doubleeq x y = True + +instance (Eq' a,Eq' a) => Eq' [a] where + doubleeq x y = True + +f x y = doubleeq x [1] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc056.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc056.stderr new file mode 100644 index 0000000000..d075a89e87 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc056.stderr @@ -0,0 +1,57 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq'.doubleeq = + /\ a.t22 -> \{-classdict-} [] [doubleeq.t23] -> doubleeq.t23 +{- nonrec -} +defm.ShouldSucceed.Eq'.doubleeq = + /\ a.t24 -> + \{-dict-} d.ShouldSucceed.Eq'.t25 -> + (error (a.t24 -> a.t24 -> Bool)) + "No default method for \"ShouldSucceed.Eq'.defm.ShouldSucceed.Eq'.doubleeq\"\n" +{- nonrec -} +ShouldSucceed.Ord'.lt = + /\ a.t26 -> \{-classdict-} [d.ShouldSucceed.Eq'.t28] [lt.t27] -> lt.t27 +sdsel.ShouldSucceed.Ord'.ShouldSucceed.Eq' = + /\ a.t26 -> + \{-classdict-} [d.ShouldSucceed.Eq'.t28] [lt.t27] -> + d.ShouldSucceed.Eq'.t28 +{- nonrec -} +defm.ShouldSucceed.Ord'.lt = + /\ a.t29 -> + \{-dict-} d.ShouldSucceed.Ord'.t30 -> + (error (a.t29 -> a.t29 -> Bool)) + "No default method for \"ShouldSucceed.Ord'.defm.ShouldSucceed.Ord'.lt\"\n" +{- rec -} +dfun.ShouldSucceed.Eq'.Int = + ({-dict-} [] [const.ShouldSucceed.Eq'.Int.doubleeq]) +const.ShouldSucceed.Eq'.Int.doubleeq :: Int -> Int -> Bool +const.ShouldSucceed.Eq'.Int.doubleeq + x.r31 y.r32 + = True +AbsBinds +[a.t15] +[d.ShouldSucceed.Eq'.t16, d.ShouldSucceed.Eq'.t17] +[(d.ShouldSucceed.Eq'.t18, dfun.ShouldSucceed.Eq'.List)] + {- rec -} + d.ShouldSucceed.Eq'.t18 = ({-dict-} [] [doubleeq.t19]) + doubleeq.t19 :: [a.t15] -> [a.t15] -> Bool + doubleeq.t19 + x.r34 y.r35 + = True +AbsBinds +[tt6, ot3] +[d.Num.t9, d.ShouldSucceed.Eq'.t11] +[(f.t1, ShouldSucceed.f)] + (fromInt.t8, fromInt tt6 d.Num.t9) + (lit.t7, fromInt.t8 (MkInt 1#)) + (d.ShouldSucceed.Eq'.t12, d.ShouldSucceed.Eq'.t11) + (d.ShouldSucceed.Eq'.t10, + dfun.ShouldSucceed.Eq'.List tt6 + [d.ShouldSucceed.Eq'.t11, d.ShouldSucceed.Eq'.t12]) + (ShouldSucceed.Eq'.doubleeq.t5, + ShouldSucceed.Eq'.doubleeq [tt6] d.ShouldSucceed.Eq'.t10) + {- nonrec -} + f.t1 :: [tt6] -> ot3 -> Bool + f.t1 x.r63 y.r64 + = ShouldSucceed.Eq'.doubleeq.t5 x.r63 ([lit.t7] (tt6)) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc057.hi b/ghc/compiler/tests/typecheck/should_succeed/tc057.hi new file mode 100644 index 0000000000..3613dfacb6 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc057.hi @@ -0,0 +1,7 @@ +interface ShouldSucceed where { +class Eq' a where { deq } +instance <Eq' Int> +instance Eq' a => <Eq' [a]> +dand :: Bool -> Bool -> Bool +f :: Eq' t93 => t93 -> t93 -> Bool +} diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc057.hs b/ghc/compiler/tests/typecheck/should_succeed/tc057.hs new file mode 100644 index 0000000000..cc561b95b8 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc057.hs @@ -0,0 +1,18 @@ +module ShouldSucceed where + +-- See also tcfail060.hs + +class Eq' a where + deq :: a -> a -> Bool + +instance Eq' Int where + deq x y = True + +instance (Eq' a) => Eq' [a] where + deq (a:as) (b:bs) = dand (f a b) (f as bs) + +dand True True = True +dand x y = False + +f :: Eq' a => a -> a -> Bool +f p q = dand (deq p q) (deq [1::Int] [2::Int]) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc057.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc057.stderr new file mode 100644 index 0000000000..accfaee9c8 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc057.stderr @@ -0,0 +1,58 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq'.deq = /\ a.t38 -> \{-classdict-} [] [deq.t39] -> deq.t39 +{- nonrec -} +defm.ShouldSucceed.Eq'.deq = + /\ a.t40 -> + \{-dict-} d.ShouldSucceed.Eq'.t41 -> + (error (a.t40 -> a.t40 -> Bool)) + "No default method for \"ShouldSucceed.Eq'.defm.ShouldSucceed.Eq'.deq\"\n" +{- rec -} +dfun.ShouldSucceed.Eq'.Int = ({-dict-} [] [const.ShouldSucceed.Eq'.Int.deq]) +const.ShouldSucceed.Eq'.Int.deq :: Int -> Int -> Bool +const.ShouldSucceed.Eq'.Int.deq + x.r30 y.r31 + = True +AbsBinds +[a.t22] +[d.ShouldSucceed.Eq'.t23] +[(d.ShouldSucceed.Eq'.t24, dfun.ShouldSucceed.Eq'.List)] + (d.ShouldSucceed.Eq'.t36, d.ShouldSucceed.Eq'.t24) + (ShouldSucceed.f.t35, ShouldSucceed.f [a.t22] d.ShouldSucceed.Eq'.t36) + (d.ShouldSucceed.Eq'.t37, d.ShouldSucceed.Eq'.t23) + (ShouldSucceed.f.t33, ShouldSucceed.f a.t22 d.ShouldSucceed.Eq'.t37) + {- rec -} + d.ShouldSucceed.Eq'.t24 = ({-dict-} [] [deq.t25]) + deq.t25 :: [a.t22] -> [a.t22] -> Bool + deq.t25 + (a.r33 : as.r34) (b.r35 : bs.r36) + = ShouldSucceed.dand + (ShouldSucceed.f.t33 a.r33 b.r35) + (ShouldSucceed.f.t35 as.r34 bs.r36) +lit.t17 = MkInt 2# +lit.t15 = MkInt 1# +d.ShouldSucceed.Eq'.t43 = dfun.ShouldSucceed.Eq'.Int +d.ShouldSucceed.Eq'.t42 = + dfun.ShouldSucceed.Eq'.List Int d.ShouldSucceed.Eq'.t43 +ShouldSucceed.Eq'.deq.t13 = ShouldSucceed.Eq'.deq [Int] d.ShouldSucceed.Eq'.t42 +AbsBinds [] [] [(dand.t1, ShouldSucceed.dand)] + {- nonrec -} + dand.t1 :: Bool -> Bool -> Bool + dand.t1 + True True + = True + dand.t1 + x.r65 y.r66 + = False +AbsBinds [a.t10] [d.ShouldSucceed.Eq'.t7] [(f.t5, ShouldSucceed.f)] + (d.ShouldSucceed.Eq'.t19, d.ShouldSucceed.Eq'.t7) + (ShouldSucceed.Eq'.deq.t11, + ShouldSucceed.Eq'.deq a.t10 d.ShouldSucceed.Eq'.t19) + {- nonrec -} + f.t5 :: a.t10 -> a.t10 -> Bool + f.t5 p.r67 q.r68 + = ShouldSucceed.dand + (ShouldSucceed.Eq'.deq.t11 p.r67 q.r68) + (ShouldSucceed.Eq'.deq.t13 + ([lit.t15] (Int)) ([lit.t17] (Int))) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc058.hs b/ghc/compiler/tests/typecheck/should_succeed/tc058.hs new file mode 100644 index 0000000000..7df1f3bc6d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc058.hs @@ -0,0 +1,18 @@ +module ShouldSucceed where + +class Eq2 a where + doubleeq :: a -> a -> Bool + +class (Eq2 a) => Ord2 a where + lt :: a -> a -> Bool + +instance Eq2 Int where + doubleeq x y = True + +instance Ord2 Int where + lt x y = True + +instance (Eq2 a,Ord2 a) => Eq2 [a] where + doubleeq xs ys = True + +f x y = doubleeq x [1] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc058.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc058.stderr new file mode 100644 index 0000000000..a60f7a43e0 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc058.stderr @@ -0,0 +1,66 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq2.doubleeq = + /\ a.t25 -> \{-classdict-} [] [doubleeq.t26] -> doubleeq.t26 +{- nonrec -} +defm.ShouldSucceed.Eq2.doubleeq = + /\ a.t27 -> + \{-dict-} d.ShouldSucceed.Eq2.t28 -> + (error (a.t27 -> a.t27 -> Bool)) + "No default method for \"ShouldSucceed.Eq2.defm.ShouldSucceed.Eq2.doubleeq\"\n" +{- nonrec -} +ShouldSucceed.Ord2.lt = + /\ a.t29 -> \{-classdict-} [d.ShouldSucceed.Eq2.t31] [lt.t30] -> lt.t30 +sdsel.ShouldSucceed.Ord2.ShouldSucceed.Eq2 = + /\ a.t29 -> + \{-classdict-} [d.ShouldSucceed.Eq2.t31] [lt.t30] -> + d.ShouldSucceed.Eq2.t31 +{- nonrec -} +defm.ShouldSucceed.Ord2.lt = + /\ a.t32 -> + \{-dict-} d.ShouldSucceed.Ord2.t33 -> + (error (a.t32 -> a.t32 -> Bool)) + "No default method for \"ShouldSucceed.Ord2.defm.ShouldSucceed.Ord2.lt\"\n" +{- rec -} +dfun.ShouldSucceed.Eq2.Int = + ({-dict-} [] [const.ShouldSucceed.Eq2.Int.doubleeq]) +const.ShouldSucceed.Eq2.Int.doubleeq :: Int -> Int -> Bool +const.ShouldSucceed.Eq2.Int.doubleeq + x.r31 y.r32 + = True +AbsBinds +[a.t15] +[d.ShouldSucceed.Eq2.t16, d.ShouldSucceed.Ord2.t17] +[(d.ShouldSucceed.Eq2.t18, dfun.ShouldSucceed.Eq2.List)] + {- rec -} + d.ShouldSucceed.Eq2.t18 = ({-dict-} [] [doubleeq.t19]) + doubleeq.t19 :: [a.t15] -> [a.t15] -> Bool + doubleeq.t19 + xs.r34 ys.r35 + = True +{- rec -} +dfun.ShouldSucceed.Ord2.Int = + ({-dict-} [d.ShouldSucceed.Eq2.t22] [const.ShouldSucceed.Ord2.Int.lt]) +const.ShouldSucceed.Ord2.Int.lt :: Int -> Int -> Bool +const.ShouldSucceed.Ord2.Int.lt + x.r54 y.r55 + = True +d.ShouldSucceed.Eq2.t22 = dfun.ShouldSucceed.Eq2.Int +AbsBinds +[tt6, ot3] +[d.Num.t9, d.ShouldSucceed.Ord2.t12] +[(f.t1, ShouldSucceed.f)] + (d.ShouldSucceed.Eq2.t11, + sdsel.ShouldSucceed.Ord2.ShouldSucceed.Eq2 tt6 d.ShouldSucceed.Ord2.t12) + (fromInt.t8, fromInt tt6 d.Num.t9) + (lit.t7, fromInt.t8 (MkInt 1#)) + (d.ShouldSucceed.Eq2.t10, + dfun.ShouldSucceed.Eq2.List tt6 + [d.ShouldSucceed.Eq2.t11, d.ShouldSucceed.Ord2.t12]) + (ShouldSucceed.Eq2.doubleeq.t5, + ShouldSucceed.Eq2.doubleeq [tt6] d.ShouldSucceed.Eq2.t10) + {- nonrec -} + f.t1 :: [tt6] -> ot3 -> Bool + f.t1 x.r65 y.r66 + = ShouldSucceed.Eq2.doubleeq.t5 x.r65 ([lit.t7] (tt6)) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc059.hs b/ghc/compiler/tests/typecheck/should_succeed/tc059.hs new file mode 100644 index 0000000000..f0faac8155 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc059.hs @@ -0,0 +1,15 @@ +module ShouldSucceed where + +class Eq2 a where + deq :: a -> a -> Bool + foo :: a -> a + +instance Eq2 Int where + deq x y = True + foo x = x + +instance (Eq2 a) => Eq2 [a] where + deq (a:as) (b:bs) = if (deq a (foo b)) then (deq as (foo bs)) else False + foo x = x + +f x = deq x [1] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc059.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc059.stderr new file mode 100644 index 0000000000..14098b68a7 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc059.stderr @@ -0,0 +1,70 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq2.deq = + /\ a.t38 -> \{-classdict-} [] [deq.t39 foo.t40] -> deq.t39 +ShouldSucceed.Eq2.foo = + /\ a.t38 -> \{-classdict-} [] [deq.t39 foo.t40] -> foo.t40 +{- nonrec -} +defm.ShouldSucceed.Eq2.deq = + /\ a.t41 -> + \{-dict-} d.ShouldSucceed.Eq2.t42 -> + (error (a.t41 -> a.t41 -> Bool)) + "No default method for \"ShouldSucceed.Eq2.defm.ShouldSucceed.Eq2.deq\"\n" +defm.ShouldSucceed.Eq2.foo = + /\ a.t43 -> + \{-dict-} d.ShouldSucceed.Eq2.t44 -> + (error (a.t43 -> a.t43)) + "No default method for \"ShouldSucceed.Eq2.defm.ShouldSucceed.Eq2.foo\"\n" +{- rec -} +dfun.ShouldSucceed.Eq2.Int = + ({-dict-} + [] + [const.ShouldSucceed.Eq2.Int.deq, const.ShouldSucceed.Eq2.Int.foo]) +const.ShouldSucceed.Eq2.Int.deq :: Int -> Int -> Bool +const.ShouldSucceed.Eq2.Int.deq + x.r29 y.r30 + = True +const.ShouldSucceed.Eq2.Int.foo :: Int -> Int +const.ShouldSucceed.Eq2.Int.foo + x.r31 = x.r31 +AbsBinds +[a.t14] +[d.ShouldSucceed.Eq2.t15] +[(d.ShouldSucceed.Eq2.t16, dfun.ShouldSucceed.Eq2.List)] + (d.ShouldSucceed.Eq2.t34, d.ShouldSucceed.Eq2.t16) + (ShouldSucceed.Eq2.foo.t32, + ShouldSucceed.Eq2.foo [a.t14] d.ShouldSucceed.Eq2.t34) + (d.ShouldSucceed.Eq2.t35, d.ShouldSucceed.Eq2.t34) + (ShouldSucceed.Eq2.deq.t30, + ShouldSucceed.Eq2.deq [a.t14] d.ShouldSucceed.Eq2.t35) + (d.ShouldSucceed.Eq2.t36, d.ShouldSucceed.Eq2.t15) + (ShouldSucceed.Eq2.foo.t28, + ShouldSucceed.Eq2.foo a.t14 d.ShouldSucceed.Eq2.t36) + (d.ShouldSucceed.Eq2.t37, d.ShouldSucceed.Eq2.t36) + (ShouldSucceed.Eq2.deq.t26, + ShouldSucceed.Eq2.deq a.t14 d.ShouldSucceed.Eq2.t37) + {- rec -} + d.ShouldSucceed.Eq2.t16 = ({-dict-} [] [deq.t17, foo.t18]) + deq.t17 :: [a.t14] -> [a.t14] -> Bool + deq.t17 + (a.r33 : as.r34) (b.r35 : bs.r36) + = if ShouldSucceed.Eq2.deq.t26 + a.r33 (ShouldSucceed.Eq2.foo.t28 b.r35) then + ShouldSucceed.Eq2.deq.t30 + as.r34 (ShouldSucceed.Eq2.foo.t32 bs.r36) + else + False + foo.t18 :: [a.t14] -> [a.t14] + foo.t18 + x.r37 = x.r37 +AbsBinds [tt5] [d.Num.t8, d.ShouldSucceed.Eq2.t10] [(f.t1, ShouldSucceed.f)] + (fromInt.t7, fromInt tt5 d.Num.t8) + (lit.t6, fromInt.t7 (MkInt 1#)) + (d.ShouldSucceed.Eq2.t9, + dfun.ShouldSucceed.Eq2.List tt5 d.ShouldSucceed.Eq2.t10) + (ShouldSucceed.Eq2.deq.t4, + ShouldSucceed.Eq2.deq [tt5] d.ShouldSucceed.Eq2.t9) + {- nonrec -} + f.t1 :: [tt5] -> Bool + f.t1 x.r65 = ShouldSucceed.Eq2.deq.t4 x.r65 ([lit.t6] (tt5)) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc060.hs b/ghc/compiler/tests/typecheck/should_succeed/tc060.hs new file mode 100644 index 0000000000..6ae0ca9228 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc060.hs @@ -0,0 +1,12 @@ +module ShouldSucceed where + +class Eq2 a where + deq :: a -> a -> Bool + +instance (Eq2 a) => Eq2 [a] where + deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False + + +instance Eq2 Int where + deq x y = True + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc060.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc060.stderr new file mode 100644 index 0000000000..8027cbed85 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc060.stderr @@ -0,0 +1,35 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq2.deq = /\ a.t18 -> \{-classdict-} [] [deq.t19] -> deq.t19 +{- nonrec -} +defm.ShouldSucceed.Eq2.deq = + /\ a.t20 -> + \{-dict-} d.ShouldSucceed.Eq2.t21 -> + (error (a.t20 -> a.t20 -> Bool)) + "No default method for \"ShouldSucceed.Eq2.defm.ShouldSucceed.Eq2.deq\"\n" +{- rec -} +dfun.ShouldSucceed.Eq2.Int = ({-dict-} [] [const.ShouldSucceed.Eq2.Int.deq]) +const.ShouldSucceed.Eq2.Int.deq :: Int -> Int -> Bool +const.ShouldSucceed.Eq2.Int.deq + x.r28 y.r29 + = True +AbsBinds +[a.t2] +[d.ShouldSucceed.Eq2.t3] +[(d.ShouldSucceed.Eq2.t4, dfun.ShouldSucceed.Eq2.List)] + (d.ShouldSucceed.Eq2.t16, d.ShouldSucceed.Eq2.t4) + (ShouldSucceed.Eq2.deq.t15, + ShouldSucceed.Eq2.deq [a.t2] d.ShouldSucceed.Eq2.t16) + (d.ShouldSucceed.Eq2.t17, d.ShouldSucceed.Eq2.t3) + (ShouldSucceed.Eq2.deq.t13, + ShouldSucceed.Eq2.deq a.t2 d.ShouldSucceed.Eq2.t17) + {- rec -} + d.ShouldSucceed.Eq2.t4 = ({-dict-} [] [deq.t5]) + deq.t5 :: [a.t2] -> [a.t2] -> Bool + deq.t5 + (a.r31 : as.r32) (b.r33 : bs.r34) + = if ShouldSucceed.Eq2.deq.t13 a.r31 b.r33 then + ShouldSucceed.Eq2.deq.t15 as.r32 bs.r34 + else + False + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc061.hs b/ghc/compiler/tests/typecheck/should_succeed/tc061.hs new file mode 100644 index 0000000000..25a8b65f35 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc061.hs @@ -0,0 +1,11 @@ +module ShouldSucceed where + +class Eq1 a where + deq :: a -> a -> Bool + +instance (Eq1 a) => Eq1 [a] where + deq (a:as) (b:bs) = deq a b + +instance Eq1 Int where + deq x y = True + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc061.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc061.stderr new file mode 100644 index 0000000000..90eb6c126b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc061.stderr @@ -0,0 +1,29 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq1.deq = /\ a.t15 -> \{-classdict-} [] [deq.t16] -> deq.t16 +{- nonrec -} +defm.ShouldSucceed.Eq1.deq = + /\ a.t17 -> + \{-dict-} d.ShouldSucceed.Eq1.t18 -> + (error (a.t17 -> a.t17 -> Bool)) + "No default method for \"ShouldSucceed.Eq1.defm.ShouldSucceed.Eq1.deq\"\n" +{- rec -} +dfun.ShouldSucceed.Eq1.Int = ({-dict-} [] [const.ShouldSucceed.Eq1.Int.deq]) +const.ShouldSucceed.Eq1.Int.deq :: Int -> Int -> Bool +const.ShouldSucceed.Eq1.Int.deq + x.r28 y.r29 + = True +AbsBinds +[a.t2] +[d.ShouldSucceed.Eq1.t3] +[(d.ShouldSucceed.Eq1.t4, dfun.ShouldSucceed.Eq1.List)] + (d.ShouldSucceed.Eq1.t14, d.ShouldSucceed.Eq1.t3) + (ShouldSucceed.Eq1.deq.t13, + ShouldSucceed.Eq1.deq a.t2 d.ShouldSucceed.Eq1.t14) + {- rec -} + d.ShouldSucceed.Eq1.t4 = ({-dict-} [] [deq.t5]) + deq.t5 :: [a.t2] -> [a.t2] -> Bool + deq.t5 + (a.r31 : as.r32) (b.r33 : bs.r34) + = ShouldSucceed.Eq1.deq.t13 a.r31 b.r33 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc062.hs b/ghc/compiler/tests/typecheck/should_succeed/tc062.hs new file mode 100644 index 0000000000..fde6c4b1da --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc062.hs @@ -0,0 +1,12 @@ +module ShouldSucceed where + +class Eq1 a where + deq :: a -> a -> Bool + +instance Eq1 Int where + deq x y = True + +instance (Eq1 a) => Eq1 [a] where + deq (a:as) (b:bs) = if (deq a b) then (deq as bs) else False + +f x (y:ys) = deq x ys diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc062.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc062.stderr new file mode 100644 index 0000000000..59cd449ea9 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc062.stderr @@ -0,0 +1,44 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Eq1.deq = /\ a.t28 -> \{-classdict-} [] [deq.t29] -> deq.t29 +{- nonrec -} +defm.ShouldSucceed.Eq1.deq = + /\ a.t30 -> + \{-dict-} d.ShouldSucceed.Eq1.t31 -> + (error (a.t30 -> a.t30 -> Bool)) + "No default method for \"ShouldSucceed.Eq1.defm.ShouldSucceed.Eq1.deq\"\n" +{- rec -} +dfun.ShouldSucceed.Eq1.Int = ({-dict-} [] [const.ShouldSucceed.Eq1.Int.deq]) +const.ShouldSucceed.Eq1.Int.deq :: Int -> Int -> Bool +const.ShouldSucceed.Eq1.Int.deq + x.r29 y.r30 + = True +AbsBinds +[a.t12] +[d.ShouldSucceed.Eq1.t13] +[(d.ShouldSucceed.Eq1.t14, dfun.ShouldSucceed.Eq1.List)] + (d.ShouldSucceed.Eq1.t26, d.ShouldSucceed.Eq1.t14) + (ShouldSucceed.Eq1.deq.t25, + ShouldSucceed.Eq1.deq [a.t12] d.ShouldSucceed.Eq1.t26) + (d.ShouldSucceed.Eq1.t27, d.ShouldSucceed.Eq1.t13) + (ShouldSucceed.Eq1.deq.t23, + ShouldSucceed.Eq1.deq a.t12 d.ShouldSucceed.Eq1.t27) + {- rec -} + d.ShouldSucceed.Eq1.t14 = ({-dict-} [] [deq.t15]) + deq.t15 :: [a.t12] -> [a.t12] -> Bool + deq.t15 + (a.r32 : as.r33) (b.r34 : bs.r35) + = if ShouldSucceed.Eq1.deq.t23 a.r32 b.r34 then + ShouldSucceed.Eq1.deq.t25 as.r33 bs.r35 + else + False +AbsBinds [tt5] [d.ShouldSucceed.Eq1.t9] [(f.t1, ShouldSucceed.f)] + (d.ShouldSucceed.Eq1.t8, + dfun.ShouldSucceed.Eq1.List tt5 d.ShouldSucceed.Eq1.t9) + (ShouldSucceed.Eq1.deq.t7, + ShouldSucceed.Eq1.deq [tt5] d.ShouldSucceed.Eq1.t8) + {- nonrec -} + f.t1 :: [tt5] -> [tt5] -> Bool + f.t1 x.r63 (y.r64 : ys.r65) + = ShouldSucceed.Eq1.deq.t7 x.r63 ys.r65 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc063.hs b/ghc/compiler/tests/typecheck/should_succeed/tc063.hs new file mode 100644 index 0000000000..36affbfdce --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc063.hs @@ -0,0 +1,18 @@ +module ShouldSucceed where + +data X a = Tag a + +class Reps r where + f :: r -> r -> r + +instance Reps (X q) where +-- f (Tag x) (Tag y) = Tag y + f x y = y + +instance Reps Bool where + f True True = True + f x y = False + +g x = f x x + + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc063.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc063.stderr new file mode 100644 index 0000000000..24354a9120 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc063.stderr @@ -0,0 +1,35 @@ +Typechecked: +{- nonrec -} +ShouldSucceed.Reps.f = /\ r.t13 -> \{-classdict-} [] [f.t14] -> f.t14 +{- nonrec -} +defm.ShouldSucceed.Reps.f = + /\ r.t15 -> + \{-dict-} d.ShouldSucceed.Reps.t16 -> + (error (r.t15 -> r.t15 -> r.t15)) + "No default method for \"ShouldSucceed.Reps.defm.ShouldSucceed.Reps.f\"\n" +{- rec -} +dfun.ShouldSucceed.Reps.Bool = ({-dict-} [] [const.ShouldSucceed.Reps.Bool.f]) +const.ShouldSucceed.Reps.Bool.f :: Bool -> Bool -> Bool +const.ShouldSucceed.Reps.Bool.f + True True + = True +const.ShouldSucceed.Reps.Bool.f + x.r50 y.r51 + = False +AbsBinds +[q.t8] +[] +[(d.ShouldSucceed.Reps.t9, dfun.ShouldSucceed.Reps.ShouldSucceed.X)] + {- rec -} + d.ShouldSucceed.Reps.t9 = ({-dict-} [] [f.t10]) + f.t10 :: + ShouldSucceed.X q.t8 -> ShouldSucceed.X q.t8 -> ShouldSucceed.X q.t8 + f.t10 + x.r53 y.r54 + = y.r54 +AbsBinds [r.t3] [d.ShouldSucceed.Reps.t5] [(g.t1, ShouldSucceed.g)] + (ShouldSucceed.Reps.f.t4, ShouldSucceed.Reps.f r.t3 d.ShouldSucceed.Reps.t5) + {- nonrec -} + g.t1 :: r.t3 -> r.t3 + g.t1 x.r64 = ShouldSucceed.Reps.f.t4 x.r64 x.r64 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc064.hs b/ghc/compiler/tests/typecheck/should_succeed/tc064.hs new file mode 100644 index 0000000000..18aecb091d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc064.hs @@ -0,0 +1,7 @@ +module ShouldSucceed where + +data Boolean = FF | TT + +idb :: Boolean -> Boolean +idb x = x + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc064.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc064.stderr new file mode 100644 index 0000000000..1e0adaf00b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc064.stderr @@ -0,0 +1,7 @@ +Typechecked: +AbsBinds [] [] [(idb.t1, ShouldSucceed.idb)] + {- nonrec -} + idb.t1 :: ShouldSucceed.Boolean -> ShouldSucceed.Boolean + idb.t1 + x.r57 = x.r57 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc065.hs b/ghc/compiler/tests/typecheck/should_succeed/tc065.hs new file mode 100644 index 0000000000..96eb4417b8 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc065.hs @@ -0,0 +1,105 @@ +module Digraphs where + +import TheUtils + +data Digraph vertex = MkDigraph [vertex] + +type Edge vertex = (vertex, vertex) +type Cycle vertex = [vertex] + +mkDigraph = MkDigraph + +stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]] +stronglyConnComp es vs + = snd (span_tree (new_range reversed_edges) + ([],[]) + ( snd (dfs (new_range es) ([],[]) vs) ) + ) + where + reversed_edges = map swap es + + swap :: Edge v -> Edge v + swap (x,y) = (y, x) + + new_range [] w = [] + new_range ((x,y):xys) w + = if x==w + then (y : (new_range xys w)) + else (new_range xys w) + + span_tree r (vs,ns) [] = (vs,ns) + span_tree r (vs,ns) (x:xs) + | x `elem` vs = span_tree r (vs,ns) xs + | otherwise = span_tree r (vs',(x:ns'):ns) xs + where + (vs',ns') = dfs r (x:vs,[]) (r x) + +dfs r (vs,ns) [] = (vs,ns) +dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs + | otherwise = dfs r (vs',(x:ns')++ns) xs + where + (vs',ns') = dfs r (x:vs,[]) (r x) + + +isCyclic :: Eq vertex => [Edge vertex] -> [vertex] -> Bool +isCyclic edges [v] = (v,v) `elem` edges +isCyclic edges vs = True + + +topSort :: (Eq vertex) => [Edge vertex] -> [vertex] + -> MaybeErr [vertex] [[vertex]] + + +topSort edges vertices + = case cycles of + [] -> Succeeded [v | [v] <- singletons] + _ -> Failed cycles + where + sccs = stronglyConnComp edges vertices + (cycles, singletons) = partition (isCyclic edges) sccs + + +type FlattenedDependencyInfo vertex name code + = [(vertex, Set name, Set name, code)] + +mkVertices :: FlattenedDependencyInfo vertex name code -> [vertex] +mkVertices info = [ vertex | (vertex,_,_,_) <- info] + +mkEdges :: (Eq vertex, Ord name) => + [vertex] + -> FlattenedDependencyInfo vertex name code + -> [Edge vertex] + +mkEdges vertices flat_info + = [ (source_vertex, target_vertex) + | (source_vertex, _, used_names, _) <- flat_info, + target_name <- setToList used_names, + target_vertex <- vertices_defining target_name flat_info + ] + where + vertices_defining name flat_info + = [ vertex | (vertex, names_defined, _, _) <- flat_info, + name `elementOf` names_defined + ] + +lookupVertex :: (Eq vertex, Ord name) => + FlattenedDependencyInfo vertex name code + -> vertex + -> code + +lookupVertex flat_info vertex + = head code_list + where + code_list = [ code | (vertex',_,_,code) <- flat_info, vertex == vertex'] + + +isRecursiveCycle :: (Eq vertex) => Cycle vertex -> [Edge vertex] -> Bool +isRecursiveCycle [vertex] edges = (vertex, vertex) `elem` edges +isRecursiveCycle cycle edges = True + + + +-- may go to TheUtils + +data MaybeErr a b = Succeeded a | Failed b + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc065.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc065.stderr new file mode 100644 index 0000000000..10c73c1d9e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc065.stderr @@ -0,0 +1,4 @@ +"tc065.hs", line 5: import directory list is: + .:/users/fp/grasp/ghc/imports:/users/fp/grasp/ghc/./driver/.././lib/prelude:/users/fp/grasp/ghc/./driver/.././runtimes/standard + Can't find .hi file for module `TheUtils'; on input: \n +ghc2: execution of the Haskell parser had trouble diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc066.hs b/ghc/compiler/tests/typecheck/should_succeed/tc066.hs new file mode 100644 index 0000000000..7c929516bc --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc066.hs @@ -0,0 +1,4 @@ +module ShouldSucceed where + +data Pair a b = MkPair a b +f x = [ a | (MkPair c a) <- x ] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc066.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc066.stderr new file mode 100644 index 0000000000..4400cdfa57 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc066.stderr @@ -0,0 +1,6 @@ +Typechecked: +AbsBinds [a.t5, b.t6] [] [(f.t1, ShouldSucceed.f)] + {- nonrec -} + f.t1 :: [ShouldSucceed.Pair a.t5 b.t6] -> [b.t6] + f.t1 x.r58 = [ a.r59 | (ShouldSucceed.MkPair c.r60 a.r59) <- x.r58 ] + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc067.hs b/ghc/compiler/tests/typecheck/should_succeed/tc067.hs new file mode 100644 index 0000000000..59df10316c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc067.hs @@ -0,0 +1,4 @@ +module ShouldSucc where + +f [] = [] +f (x:xs) = x : (f xs) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc067.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc067.stderr new file mode 100644 index 0000000000..8922b32e1b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc067.stderr @@ -0,0 +1,8 @@ +Typechecked: +AbsBinds [tt3] [] [(f.t1, ShouldSucc.f)] + {- rec -} + f.t1 :: [tt3] -> [tt3] + f.t1 [] = [] (tt3) + f.t1 (x.r54 : xs.r55) + = ((:) tt3) x.r54 (f.t1 xs.r55) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc068.hs b/ghc/compiler/tests/typecheck/should_succeed/tc068.hs new file mode 100644 index 0000000000..01f2d872e6 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc068.hs @@ -0,0 +1,18 @@ +module ShouldSucc where + +data T a = D (B a) | C +data B b = X | Y b + +instance (Eq a) => Eq (T a) where + (D x) == (D y) = x == y + C == C = True + a == b = False + + a /= b = not (a == b) + +instance (Eq b) => Eq (B b) where + X == X = True + (Y a) == (Y b) = a == b + a == b = False + + a /= b = not (a == b) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc068.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc068.stderr new file mode 100644 index 0000000000..eb4c9c9f44 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc068.stderr @@ -0,0 +1,45 @@ +Typechecked: +AbsBinds [b.t0] [d.Eq.t1] [(d.Eq.t2, dfun.Eq.ShouldSucc.B)] + (d.Eq.t21, d.Eq.t1) + (==.t12, (==) b.t0 d.Eq.t21) + (d.Eq.t22, d.Eq.t2) + (==.t19, (==) (ShouldSucc.B b.t0) d.Eq.t22) + {- rec -} + d.Eq.t2 = ({-dict-} [] [==.t3, /=.t4]) + (==.t3) :: ShouldSucc.B b.t0 -> ShouldSucc.B b.t0 -> Bool + (==.t3) + ShouldSucc.X ShouldSucc.X + = True + (==.t3) + (ShouldSucc.Y a.r17) (ShouldSucc.Y b.r18) + = a.r17 ==.t12 b.r18 + (==.t3) + a.r19 b.r20 + = False + (/=.t4) :: ShouldSucc.B b.t0 -> ShouldSucc.B b.t0 -> Bool + (/=.t4) + a.r21 b.r22 + = not (a.r21 ==.t19 b.r22) +AbsBinds [a.t23] [d.Eq.t24] [(d.Eq.t25, dfun.Eq.ShouldSucc.T)] + (d.Eq.t45, d.Eq.t24) + (d.Eq.t44, dfun.Eq.ShouldSucc.B a.t23 d.Eq.t45) + (==.t33, (==) (ShouldSucc.B a.t23) d.Eq.t44) + (d.Eq.t46, d.Eq.t25) + (==.t42, (==) (ShouldSucc.T a.t23) d.Eq.t46) + {- rec -} + d.Eq.t25 = ({-dict-} [] [==.t26, /=.t27]) + (==.t26) :: ShouldSucc.T a.t23 -> ShouldSucc.T a.t23 -> Bool + (==.t26) + (ShouldSucc.D x.r24) (ShouldSucc.D y.r25) + = x.r24 ==.t33 y.r25 + (==.t26) + ShouldSucc.C ShouldSucc.C + = True + (==.t26) + a.r26 b.r27 + = False + (/=.t27) :: ShouldSucc.T a.t23 -> ShouldSucc.T a.t23 -> Bool + (/=.t27) + a.r28 b.r29 + = not (a.r28 ==.t42 b.r29) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc069.hs b/ghc/compiler/tests/typecheck/should_succeed/tc069.hs new file mode 100644 index 0000000000..115af278b3 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc069.hs @@ -0,0 +1,4 @@ + + +x = 'a' +(y:ys) = ['a','b','c'] where p = x diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc069.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc069.stderr new file mode 100644 index 0000000000..df629a9878 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc069.stderr @@ -0,0 +1,16 @@ +Typechecked: +AbsBinds [] [] [(x.t1, Main.x)] + {- nonrec -} + x.t1 :: Char + x.t1 = 'a' +AbsBinds [] [] [(y.t4, Main.y), (ys.t5, Main.ys)] + {- nonrec -} + (y.t4 : ys.t5) :: [Char] + (y.t4 : ys.t5) = ['a', 'b', 'c'] (Char) + where + AbsBinds [] [] [(p.t8, p.r56)] + {- nonrec -} + p.t8 :: Char + p.t8 = Main.x + {- nonrec -} + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc070.hs b/ghc/compiler/tests/typecheck/should_succeed/tc070.hs new file mode 100644 index 0000000000..3ef920f2af --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc070.hs @@ -0,0 +1,7 @@ + +data Boolean = FF | TT + + +idb :: Boolean -> Boolean +idb x = x + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc070.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc070.stderr new file mode 100644 index 0000000000..16a0ba9fcb --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc070.stderr @@ -0,0 +1,7 @@ +Typechecked: +AbsBinds [] [] [(idb.t1, Main.idb)] + {- nonrec -} + idb.t1 :: Main.Boolean -> Main.Boolean + idb.t1 + x.r57 = x.r57 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc073.hs b/ghc/compiler/tests/typecheck/should_succeed/tc073.hs new file mode 100644 index 0000000000..ea4cb74675 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc073.hs @@ -0,0 +1,5 @@ + +module ShouldSucc where + +f [] = [] +f (x:xs) = x : (f xs) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc073.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc073.stderr new file mode 100644 index 0000000000..8922b32e1b --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc073.stderr @@ -0,0 +1,8 @@ +Typechecked: +AbsBinds [tt3] [] [(f.t1, ShouldSucc.f)] + {- rec -} + f.t1 :: [tt3] -> [tt3] + f.t1 [] = [] (tt3) + f.t1 (x.r54 : xs.r55) + = ((:) tt3) x.r54 (f.t1 xs.r55) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc074.hs b/ghc/compiler/tests/typecheck/should_succeed/tc074.hs new file mode 100644 index 0000000000..01f2d872e6 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc074.hs @@ -0,0 +1,18 @@ +module ShouldSucc where + +data T a = D (B a) | C +data B b = X | Y b + +instance (Eq a) => Eq (T a) where + (D x) == (D y) = x == y + C == C = True + a == b = False + + a /= b = not (a == b) + +instance (Eq b) => Eq (B b) where + X == X = True + (Y a) == (Y b) = a == b + a == b = False + + a /= b = not (a == b) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc074.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc074.stderr new file mode 100644 index 0000000000..eb4c9c9f44 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc074.stderr @@ -0,0 +1,45 @@ +Typechecked: +AbsBinds [b.t0] [d.Eq.t1] [(d.Eq.t2, dfun.Eq.ShouldSucc.B)] + (d.Eq.t21, d.Eq.t1) + (==.t12, (==) b.t0 d.Eq.t21) + (d.Eq.t22, d.Eq.t2) + (==.t19, (==) (ShouldSucc.B b.t0) d.Eq.t22) + {- rec -} + d.Eq.t2 = ({-dict-} [] [==.t3, /=.t4]) + (==.t3) :: ShouldSucc.B b.t0 -> ShouldSucc.B b.t0 -> Bool + (==.t3) + ShouldSucc.X ShouldSucc.X + = True + (==.t3) + (ShouldSucc.Y a.r17) (ShouldSucc.Y b.r18) + = a.r17 ==.t12 b.r18 + (==.t3) + a.r19 b.r20 + = False + (/=.t4) :: ShouldSucc.B b.t0 -> ShouldSucc.B b.t0 -> Bool + (/=.t4) + a.r21 b.r22 + = not (a.r21 ==.t19 b.r22) +AbsBinds [a.t23] [d.Eq.t24] [(d.Eq.t25, dfun.Eq.ShouldSucc.T)] + (d.Eq.t45, d.Eq.t24) + (d.Eq.t44, dfun.Eq.ShouldSucc.B a.t23 d.Eq.t45) + (==.t33, (==) (ShouldSucc.B a.t23) d.Eq.t44) + (d.Eq.t46, d.Eq.t25) + (==.t42, (==) (ShouldSucc.T a.t23) d.Eq.t46) + {- rec -} + d.Eq.t25 = ({-dict-} [] [==.t26, /=.t27]) + (==.t26) :: ShouldSucc.T a.t23 -> ShouldSucc.T a.t23 -> Bool + (==.t26) + (ShouldSucc.D x.r24) (ShouldSucc.D y.r25) + = x.r24 ==.t33 y.r25 + (==.t26) + ShouldSucc.C ShouldSucc.C + = True + (==.t26) + a.r26 b.r27 + = False + (/=.t27) :: ShouldSucc.T a.t23 -> ShouldSucc.T a.t23 -> Bool + (/=.t27) + a.r28 b.r29 + = not (a.r28 ==.t42 b.r29) + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc075.hs b/ghc/compiler/tests/typecheck/should_succeed/tc075.hs new file mode 100644 index 0000000000..f7c31d8926 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc075.hs @@ -0,0 +1,8 @@ +module ShouldSucceed where + +--!!! giving methods in a pattern binding (for no v good reason...) + +data Foo = MkFoo Int + +instance Eq Foo where + ((==), (/=)) = (\x -> \y -> True, \x -> \y -> False) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc075.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc075.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc075.stderr diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc076.hs b/ghc/compiler/tests/typecheck/should_succeed/tc076.hs new file mode 100644 index 0000000000..5bf422e5c9 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc076.hs @@ -0,0 +1,8 @@ +--!!! scoping in list comprehensions right way 'round? +-- a bug reported by Jon Hill +-- +module ShouldSucceed where + +x = [[True]] +xs :: [Bool] +xs = [x | x <- x, x <- x] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc076.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc076.stderr new file mode 100644 index 0000000000..dd887a260d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc076.stderr @@ -0,0 +1,10 @@ +Typechecked: +AbsBinds [] [] [(x.t1, ShouldSucceed.x)] + {- nonrec -} + x.t1 :: [[Bool]] + x.t1 = [[True] (Bool)] ([Bool]) +AbsBinds [] [] [(xs.t3, ShouldSucceed.xs)] + {- nonrec -} + xs.t3 :: [Bool] + xs.t3 = [ x.r56 | x.r55 <- ShouldSucceed.x, x.r56 <- x.r55 ] + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc077.hs b/ghc/compiler/tests/typecheck/should_succeed/tc077.hs new file mode 100644 index 0000000000..45ef89229d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc077.hs @@ -0,0 +1,9 @@ +--!!! make sure context of EQ is minimised in interface file. +-- +module M where + +data NUM = ONE | TWO +class (Num a) => ORD a + +class (ORD a, Text a) => EQ a where + (===) :: a -> a -> Bool diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc077.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc077.stderr new file mode 100644 index 0000000000..cf45bb017c --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc077.stderr @@ -0,0 +1,25 @@ +Typechecked: +{- nonrec -} +(M.EQ.===) = + /\ a.t0 -> \{-classdict-} [d.M.ORD.t2 d.Text.t3] [===.t1] -> (===.t1) +sdsel.M.EQ.M.ORD = + /\ a.t0 -> \{-classdict-} [d.M.ORD.t2 d.Text.t3] [===.t1] -> d.M.ORD.t2 +sdsel.M.EQ.Text = + /\ a.t0 -> \{-classdict-} [d.M.ORD.t2 d.Text.t3] [===.t1] -> d.Text.t3 +{- nonrec -} +defm.M.EQ.=== = + /\ a.t4 -> + \{-dict-} d.M.EQ.t5 -> + (error (a.t4 -> a.t4 -> Bool)) + "No default method for \"M.EQ.defm.M.EQ.===\"\n" +{- nonrec -} +sdsel.M.ORD.Num = /\ a.t6 -> \{-classdict-} [d.Num.t7] [] -> d.Num.t7 +{- nonrec -} + +=-=-=-=-=INTERFACE STARTS HERE=-=-=-=-= M +interface M where +class (ORD a, Text a) => EQ a where (===) :: a -> a -> Bool +class (Num a) => ORD a +data NUM = ONE | TWO +=-=-=-=-=INTERFACE STOPS HERE=-=-=-=-= + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc078.hs b/ghc/compiler/tests/typecheck/should_succeed/tc078.hs new file mode 100644 index 0000000000..a35afef81e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc078.hs @@ -0,0 +1,8 @@ +--!!! instance decls with no binds +-- +module M where + +data Bar a = MkBar Int a + +instance Eq a => Eq (Bar a) +instance Ord a => Ord (Bar a) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc078.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc078.stderr new file mode 100644 index 0000000000..93d41fb0ff --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc078.stderr @@ -0,0 +1,27 @@ +Typechecked: +AbsBinds [a.t0] [d.Eq.t1] [(d.Eq.t2, dfun.Eq.M.Bar)] + {- rec -} + d.Eq.t2 = ({-dict-} [] [==.t3, /=.t4]) + (==.t3) = defm.== (M.Bar a.t0) d.Eq.t2 + (/=.t4) = defm./= (M.Bar a.t0) d.Eq.t2 +AbsBinds [a.t5] [d.Ord.t7, d.Eq.t6] [(d.Ord.t8, dfun.Ord.M.Bar)] + {- rec -} + d.Ord.t8 = + ({-dict-} + [d.Eq.t6] + [<.t9, <=.t10, >=.t11, >.t12, max.t13, min.t14, cmp3.t15]) + (<.t9) = defm.< (M.Bar a.t5) d.Ord.t8 + (<=.t10) = defm.<= (M.Bar a.t5) d.Ord.t8 + (>=.t11) = defm.>= (M.Bar a.t5) d.Ord.t8 + (>.t12) = defm.> (M.Bar a.t5) d.Ord.t8 + max.t13 = defm.max (M.Bar a.t5) d.Ord.t8 + min.t14 = defm.min (M.Bar a.t5) d.Ord.t8 + cmp3.t15 = /\ tt16 -> defm.cmp3 [M.Bar a.t5, tt16] d.Ord.t8 + +=-=-=-=-=INTERFACE STARTS HERE=-=-=-=-= M +interface M where +data Bar a = MkBar Int a +instance Eq a => Eq (Bar a) +instance Ord a => Ord (Bar a) +=-=-=-=-=INTERFACE STOPS HERE=-=-=-=-= + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc079.hs b/ghc/compiler/tests/typecheck/should_succeed/tc079.hs new file mode 100644 index 0000000000..c0845f7842 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc079.hs @@ -0,0 +1,14 @@ +--!!! small class decl with local polymorphism; +--!!! "easy" to check default methods and such... +--!!! (this is the example given in TcClassDcl) +-- +class Foo a where + op1 :: a -> Bool + op2 :: Ord b => a -> b -> b -> b + + op1 x = True + op2 x y z = if (op1 x) && (y < z) then y else z + +instance Foo Int where {} + +instance Foo a => Foo [a] where {} diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc079.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc079.stderr new file mode 100644 index 0000000000..908c3dc23a --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc079.stderr @@ -0,0 +1,42 @@ +Typechecked: +{- nonrec -} +Main.Foo.op1 = /\ a.t7 -> \{-classdict-} [] [op1.t8 op2.t9] -> op1.t8 +Main.Foo.op2 = + /\ a.t7 b.t10 -> \{-classdict-} [] [op1.t8 op2.t9] -> op2.t9 b.t10 +{- nonrec -} +defm.Main.Foo.op1 = + let + AbsBinds [a.t11] [d.Main.Foo.t12] [(op1.t13, op1.t14)] + {- nonrec -} + op1.t13 :: a.t11 -> Bool + op1.t13 + x.r11 = True + in op1.t14 +defm.Main.Foo.op2 = + let + AbsBinds [a.t16, b.t17] [d.Main.Foo.t18, d.Ord.t19] [(op2.t20, op2.t21)] + (d.Ord.t31, d.Ord.t19) + (<.t28, (<) b.t17 d.Ord.t31) + (d.Main.Foo.t32, d.Main.Foo.t18) + (Main.Foo.op1.t26, Main.Foo.op1 a.t16 d.Main.Foo.t32) + {- nonrec -} + op2.t20 :: a.t16 -> b.t17 -> b.t17 -> b.t17 + op2.t20 + x.r12 y.r13 z.r14 + = if (Main.Foo.op1.t26 x.r12) && (y.r13 <.t28 z.r14) then + y.r13 + else + z.r14 + in op2.t21 +{- rec -} +dfun.Main.Foo.Int = + ({-dict-} [] [const.Main.Foo.Int.op1, const.Main.Foo.Int.op2]) +const.Main.Foo.Int.op1 = defm.Main.Foo.op1 Int dfun.Main.Foo.Int +const.Main.Foo.Int.op2 = + /\ b.t0 -> defm.Main.Foo.op2 [Int, b.t0] dfun.Main.Foo.Int +AbsBinds [a.t1] [d.Main.Foo.t2] [(d.Main.Foo.t3, dfun.Main.Foo.List)] + {- rec -} + d.Main.Foo.t3 = ({-dict-} [] [op1.t4, op2.t5]) + op1.t4 = defm.Main.Foo.op1 [a.t1] d.Main.Foo.t3 + op2.t5 = /\ b.t6 -> defm.Main.Foo.op2 [[a.t1], b.t6] d.Main.Foo.t3 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc080.hs b/ghc/compiler/tests/typecheck/should_succeed/tc080.hs new file mode 100644 index 0000000000..d9ad6e9902 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc080.hs @@ -0,0 +1,53 @@ +--module Parse(Parse(..),whiteSpace,seperatedBy) where +--import StdLib +class Parse a where + parseFile :: String -> [a] + parseFile string | all forced x = x + where x = map parseLine (lines' string) + parseLine :: String -> a + parseLine = pl.parse where pl (a,_) = a + parse :: String -> (a,String) + parse = parseType.whiteSpace + parseType :: String -> (a,String) + forced :: a -> Bool + forced x = True + +instance Parse Int where + parseType str = pl (span' isDigit str) + where pl (l,r) = (strToInt l,r) + forced n | n>=0 = True + +instance Parse Char where + parseType (ch:str) = (ch,str) + forced n = True + +instance (Parse a) => Parse [a] where + parseType more = (map parseLine (seperatedBy ',' (l++",")),out) + where (l,']':out) = span' (\x->x/=']') (tail more) + forced = all forced + +seperatedBy :: Char -> String -> [String] +seperatedBy ch [] = [] +seperatedBy ch xs = twaddle ch (span' (\x->x/=ch) xs) + where twaddle ch (l,_:r) = l:seperatedBy ch r + +whiteSpace :: String -> String +whiteSpace = dropWhile isSpace + +span' :: (a->Bool) -> [a] -> ([a],[a]) +span' p [] = ([],[]) +span' p (x:xs') | p x = fixLeak x (span' p xs') where fixLeak x (xs,ys) = (x:xs,ys) +span' _ xs = ([],xs) + +lines' :: [Char] -> [[Char]] +lines' "" = [] +lines' s = plumb (span' ((/=) '\n') s) + where plumb (l,s') = l:if null s' then [] else lines' (tail s') + +strToInt :: String -> Int +strToInt x = strToInt' (length x-1) x + where strToInt' _ [] = 0 + strToInt' x (a:l) = (charToInt a)*(10^x) + (strToInt' (x-1) l) + +charToInt :: Char -> Int +charToInt x = (ord x - ord '0') diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc080.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc080.stderr new file mode 100644 index 0000000000..1818071b4e --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc080.stderr @@ -0,0 +1,303 @@ +Typechecked: +{- nonrec -} +Main.Parse.parseFile = + /\ a.t177 -> + \{-classdict-} [] [parseFile.t178 + parseLine.t179 + parse.t180 + parseType.t181 + forced.t182] -> parseFile.t178 +Main.Parse.parseLine = + /\ a.t177 -> + \{-classdict-} [] [parseFile.t178 + parseLine.t179 + parse.t180 + parseType.t181 + forced.t182] -> parseLine.t179 +Main.Parse.parse = + /\ a.t177 -> + \{-classdict-} [] [parseFile.t178 + parseLine.t179 + parse.t180 + parseType.t181 + forced.t182] -> parse.t180 +Main.Parse.parseType = + /\ a.t177 -> + \{-classdict-} [] [parseFile.t178 + parseLine.t179 + parse.t180 + parseType.t181 + forced.t182] -> parseType.t181 +Main.Parse.forced = + /\ a.t177 -> + \{-classdict-} [] [parseFile.t178 + parseLine.t179 + parse.t180 + parseType.t181 + forced.t182] -> forced.t182 +{- nonrec -} +defm.Main.Parse.parseFile = + let + AbsBinds [a.t183] [d.Main.Parse.t184] [(parseFile.t185, parseFile.t186)] + (d.Main.Parse.t197, d.Main.Parse.t184) + (Main.Parse.parseLine.t193, + Main.Parse.parseLine a.t183 d.Main.Parse.t197) + (d.Main.Parse.t198, d.Main.Parse.t197) + (Main.Parse.forced.t196, Main.Parse.forced a.t183 d.Main.Parse.t198) + {- nonrec -} + parseFile.t185 :: String -> [a.t183] + parseFile.t185 + string.r23 + | (all a.t183) Main.Parse.forced.t196 x.r24 = x.r24 + where + AbsBinds [] [] [(x.t189, x.r24)] + {- nonrec -} + x.t189 :: [a.t183] + x.t189 + = (map [String, a.t183]) + Main.Parse.parseLine.t193 + (Main.lines' string.r23) + {- nonrec -} + in parseFile.t186 +defm.Main.Parse.parseLine = + let + AbsBinds [a.t199] [d.Main.Parse.t200] [(parseLine.t201, parseLine.t202)] + (d.Main.Parse.t217, d.Main.Parse.t200) + (Main.Parse.parse.t215, Main.Parse.parse a.t199 d.Main.Parse.t217) + {- nonrec -} + parseLine.t201 :: String -> a.t199 + parseLine.t201 + = ((.) [String, (a.t199, String), a.t199]) + (pl.r25 [String, a.t199]) Main.Parse.parse.t215 + where + AbsBinds [tt208, tt207] [] [(pl.t204, pl.r25)] + {- nonrec -} + pl.t204 :: (tt207, tt208) -> tt207 + pl.t204 + (a.r26, _) + = a.r26 + {- nonrec -} + in parseLine.t202 +defm.Main.Parse.parse = + let + AbsBinds [a.t218] [d.Main.Parse.t219] [(parse.t220, parse.t221)] + (d.Main.Parse.t228, d.Main.Parse.t219) + (Main.Parse.parseType.t226, + Main.Parse.parseType a.t218 d.Main.Parse.t228) + {- nonrec -} + parse.t220 :: String -> (a.t218, String) + parse.t220 + = ((.) [String, String, (a.t218, String)]) + Main.Parse.parseType.t226 Main.whiteSpace + in parse.t221 +defm.Main.Parse.forced = + let + AbsBinds [a.t229] [d.Main.Parse.t230] [(forced.t231, forced.t232)] + {- nonrec -} + forced.t231 :: a.t229 -> Bool + forced.t231 + x.r27 = True + in forced.t232 +defm.Main.Parse.parseType = + /\ a.t234 -> + \{-dict-} d.Main.Parse.t235 -> + (error (String -> (a.t234, String))) + "No default method for \"Main.Parse.defm.Main.Parse.parseType\"\n" +{- rec -} +dfun.Main.Parse.Char = + ({-dict-} + [] + [const.Main.Parse.Char.parseFile, + const.Main.Parse.Char.parseLine, + const.Main.Parse.Char.parse, + const.Main.Parse.Char.parseType, + const.Main.Parse.Char.forced]) +const.Main.Parse.Char.parseType :: String -> (Char, String) +const.Main.Parse.Char.parseType + (ch.r64 : str.r65) + = (ch.r64, str.r65) +const.Main.Parse.Char.forced :: Char -> Bool +const.Main.Parse.Char.forced + n.r66 = True +const.Main.Parse.Char.parseFile = + defm.Main.Parse.parseFile Char dfun.Main.Parse.Char +const.Main.Parse.Char.parseLine = + defm.Main.Parse.parseLine Char dfun.Main.Parse.Char +const.Main.Parse.Char.parse = defm.Main.Parse.parse Char dfun.Main.Parse.Char +{- rec -} +dfun.Main.Parse.Int = + ({-dict-} + [] + [const.Main.Parse.Int.parseFile, + const.Main.Parse.Int.parseLine, + const.Main.Parse.Int.parse, + const.Main.Parse.Int.parseType, + const.Main.Parse.Int.forced]) +const.Main.Parse.Int.parseType :: String -> (Int, String) +const.Main.Parse.Int.parseType + str.r67 = (pl.r68 [Char]) ((Main.span' Char) isDigit str.r67) + where + AbsBinds [tt135] [] [(pl.t131, pl.r68)] + {- nonrec -} + pl.t131 :: (String, tt135) -> (Int, tt135) + pl.t131 + (l.r69, r.r70) + = (Main.strToInt l.r69, r.r70) + {- nonrec -} +const.Main.Parse.Int.forced :: Int -> Bool +const.Main.Parse.Int.forced + n.r71 | n.r71 >=.t140 lit.t142 = True +const.Main.Parse.Int.parseFile = + defm.Main.Parse.parseFile Int dfun.Main.Parse.Int +const.Main.Parse.Int.parseLine = + defm.Main.Parse.parseLine Int dfun.Main.Parse.Int +const.Main.Parse.Int.parse = defm.Main.Parse.parse Int dfun.Main.Parse.Int +AbsBinds +[a.t173] +[d.Main.Parse.t145] +[(d.Main.Parse.t146, dfun.Main.Parse.List)] + (/=.t163, neChar) + (d.Main.Parse.t175, d.Main.Parse.t145) + (Main.Parse.parseLine.t169, Main.Parse.parseLine a.t173 d.Main.Parse.t175) + (d.Main.Parse.t176, d.Main.Parse.t175) + (Main.Parse.forced.t174, Main.Parse.forced a.t173 d.Main.Parse.t176) + {- rec -} + d.Main.Parse.t146 = + ({-dict-} + [] + [parseFile.t147, parseLine.t148, parse.t149, parseType.t150, forced.t151]) + parseType.t150 :: String -> ([a.t173], String) + parseType.t150 + more.r73 = ((map [String, a.t173]) + Main.Parse.parseLine.t169 + (Main.seperatedBy ',' (((++) Char) l.r74 ",")), + out.r75) + where + AbsBinds [] [] [(l.t155, l.r74), (out.t156, out.r75)] + {- nonrec -} + (l.t155, (']' : out.t156)) :: ([Char], [Char]) + (l.t155, (']' : out.t156)) + = (Main.span' Char) + (\ x.r76 -> x.r76 /=.t163 ']') + ((tail Char) more.r73) + {- nonrec -} + forced.t151 :: [a.t173] -> Bool + forced.t151 = (all a.t173) Main.Parse.forced.t174 + parseFile.t147 = defm.Main.Parse.parseFile [a.t173] d.Main.Parse.t146 + parseLine.t148 = defm.Main.Parse.parseLine [a.t173] d.Main.Parse.t146 + parse.t149 = defm.Main.Parse.parse [a.t173] d.Main.Parse.t146 +lit.t87 = MkInt 0# +lit.t100 = MkInt 10# +lit.t122 = MkInt 1# +lit.t142 = lit.t87 +(>=.t140) = geInt +AbsBinds [a.t2] [] [(span'.t1, Main.span')] + {- rec -} + span'.t1 :: (a.t2 -> Bool) -> [a.t2] -> ([a.t2], [a.t2]) + span'.t1 + p.r95 [] = ([] (a.t2), [] (a.t2)) + span'.t1 + p.r96 (x.r97 : xs'.r98) + | p.r96 x.r97 = + (fixLeak.r99 [a.t2, [a.t2]]) x.r97 (span'.t1 p.r96 xs'.r98) + where + AbsBinds [tt18, tt17] [] [(fixLeak.t12, fixLeak.r99)] + {- nonrec -} + fixLeak.t12 :: tt18 -> ([tt18], tt17) -> ([tt18], tt17) + fixLeak.t12 + x.r100 (xs.r101, ys.r102) + = (((:) tt18) x.r100 xs.r101, ys.r102) + {- nonrec -} + span'.t1 + _ xs.r103 + = ([] (a.t2), xs.r103) +AbsBinds [] [] [(seperatedBy.t28, Main.seperatedBy)] + (/=.t49, neChar) + {- rec -} + seperatedBy.t28 :: Char -> String -> [String] + seperatedBy.t28 + ch.r87 [] + = [] (String) + seperatedBy.t28 + ch.r88 xs.r89 + = twaddle.r90 + ch.r88 + ((Main.span' Char) + (\ x.r94 -> x.r94 /=.t49 ch.r88) + xs.r89) + where + AbsBinds [] [] [(twaddle.t35, twaddle.r90)] + {- nonrec -} + twaddle.t35 :: Char -> (String, [Char]) -> [String] + twaddle.t35 + ch.r91 (l.r92, (_ : r.r93)) + = ((:) String) + l.r92 (seperatedBy.t28 ch.r91 r.r93) + {- nonrec -} +AbsBinds [] [] [(whiteSpace.t52, Main.whiteSpace)] + {- nonrec -} + whiteSpace.t52 :: String -> String + whiteSpace.t52 = (dropWhile Char) isSpace +AbsBinds [] [] [(lines'.t55, Main.lines')] + (/=.t72, neChar) + {- rec -} + lines'.t55 :: [Char] -> [[Char]] + lines'.t55 + "" = [] ([Char]) + lines'.t55 + s.r104 = plumb.r105 ((Main.span' Char) ((/=.t72) '\n') s.r104) + where + AbsBinds [] [] [(plumb.t59, plumb.r105)] + {- nonrec -} + plumb.t59 :: ([Char], [Char]) -> [[Char]] + plumb.t59 + (l.r106, s'.r107) + = ((:) [Char]) + l.r106 + (if (null Char) s'.r107 then + [] ([Char]) + else + lines'.t55 ((tail Char) s'.r107)) + {- nonrec -} +AbsBinds [] [] [(charToInt.t74, Main.charToInt)] + (-.t77, minusInt) + {- nonrec -} + charToInt.t74 :: Char -> Int + charToInt.t74 + x.r113 = (ord x.r113) -.t77 (ord '0') +AbsBinds [] [] [(strToInt.t80, Main.strToInt)] + (-.t119, minusInt) + (d.Integral.t124, dfun.Integral.Int) + {- nonrec -} + strToInt.t80 :: String -> Int + strToInt.t80 + x.r108 = strToInt'.r109.t117 + (((length Char) x.r108) -.t119 lit.t122) x.r108 + where + AbsBinds + [a.t96] + [d.Integral.t114] + [(strToInt'.t83, strToInt'.r109)] + (d.Real.t115, sdsel.Integral.Real a.t96 d.Integral.t114) + (d.Num.t111, sdsel.Real.Num a.t96 d.Real.t115) + (fromInt.t110, fromInt a.t96 d.Num.t111) + (lit.t107, fromInt.t110 (MkInt 1#)) + (d.Num.t112, d.Num.t111) + (-.t105, (-) a.t96 d.Num.t112) + (d.Num.t113, dfun.Num.Int) + (^.t98, (^) [a.t96, Int] [d.Num.t113, d.Integral.t114]) + (*.t95, timesInt) + (+.t93, plusInt) + {- rec -} + strToInt'.t83 :: a.t96 -> [Char] -> Int + strToInt'.t83 + _ [] = lit.t87 + strToInt'.t83 + x.r112 (a.r110 : l.r111) + = ((Main.charToInt a.r110) + *.t95 (lit.t100 ^.t98 x.r112)) + +.t93 (strToInt'.t83 + (x.r112 -.t105 lit.t107) l.r111) + {- nonrec -} + strToInt'.r109.t117 = strToInt'.r109 Int d.Integral.t124 + diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc081.hs b/ghc/compiler/tests/typecheck/should_succeed/tc081.hs new file mode 100644 index 0000000000..27c29329ae --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc081.hs @@ -0,0 +1,27 @@ +--!!! an example Simon made up +-- + +f x = (x+1, x<3, g True, g 'c') + where + g y = if x>2 then [] else [y] +{- +Here the type-check of g will yield an LIE with an Ord dict +for x. g still has type forall a. a -> [a]. The dictionary is +free, bound by the x. + +It should be ok to add the signature: +-} + +f2 x = (x+1, x<3, g2 True, g2 'c') + where + -- NB: this sig: + g2 :: a -> [a] + g2 y = if x>2 then [] else [y] +{- +or to write: +-} + +f3 x = (x+1, x<3, g3 True, g3 'c') + where + -- NB: this line: + g3 = (\ y -> if x>2 then [] else [y])::(a -> [a]) diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc081.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc081.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc081.stderr diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc082.hs b/ghc/compiler/tests/typecheck/should_succeed/tc082.hs new file mode 100644 index 0000000000..f2ccb36736 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc082.hs @@ -0,0 +1,12 @@ +--!!! tc082: an instance for functions +-- +module N where + +class Normal a + where + normal :: a -> Bool + +instance Normal ( a -> b ) where + normal _ = True + +f x = normal id diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc082.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc082.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc082.stderr diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc083.hs b/ghc/compiler/tests/typecheck/should_succeed/tc083.hs new file mode 100644 index 0000000000..1c5321e631 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc083.hs @@ -0,0 +1,10 @@ +--!!! instances with no binds; +--!!! be sure we get a legit .hi file +-- +module Bar where + +import ClassFoo + +instance Foo Int + +instance Foo a => Foo [a] diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc083.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc083.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc083.stderr diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc084.hs b/ghc/compiler/tests/typecheck/should_succeed/tc084.hs new file mode 100644 index 0000000000..572bbe31dc --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc084.hs @@ -0,0 +1,23 @@ +{- This program shows up a bug in the handling of + the monomorphism restriction in an earlier version of + ghc. With ghc 0.18 and before, f gets a type with + an unbound type variable, which shows up in the + interface file. Reason: it was being monomorphised. + + Simon PJ +-} + +module Foo where + + +g :: Num a => Bool -> a -> b -> a +g b x y = if b then x+x else x-x + +-- Everything is ok if this signature is put in +-- but the program should be perfectly legal without it. +-- f :: Num a => a -> b -> a +f = g True + +h y x = f (x::Int) y + -- This use of f binds the overloaded monomorphic + -- type to Int diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc084.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc084.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc084.stderr diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc085.hs b/ghc/compiler/tests/typecheck/should_succeed/tc085.hs new file mode 100644 index 0000000000..fcdf1af55d --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc085.hs @@ -0,0 +1,9 @@ +--! From a bug report from Satnam. +--! To do with re-exporting importees from PreludeGla* modules. +module Foo ( PreludePrimIO.., {-PreludeGlaIO..,-} Foo..) where + +--OLD: import PreludeGlaIO +import PreludePrimIO + +type FooType = Int +data FooData = FooData diff --git a/ghc/compiler/tests/typecheck/should_succeed/tc085.stderr b/ghc/compiler/tests/typecheck/should_succeed/tc085.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ghc/compiler/tests/typecheck/should_succeed/tc085.stderr diff --git a/ghc/compiler/tests/typecheck/stress/tcstress001.hs b/ghc/compiler/tests/typecheck/stress/tcstress001.hs new file mode 100644 index 0000000000..7024aad6cd --- /dev/null +++ b/ghc/compiler/tests/typecheck/stress/tcstress001.hs @@ -0,0 +1,71 @@ + +module Prims where + +one = one + +head (x:xs) = x + +bottom = head + +absIf a b c = a + +absAnd a b = head [a,b] + +fac_rec fac0 n a + = (absIf (absAnd (s_3_0 n) one) + (s_2_0 a) + (fac0 (absAnd (s_3_2 n) one) (absAnd (s_3_1 n) (s_2_1 a)))) + +f_rec f0 a + = (f0 (s_1_0 a)) + +g_rec g0 g1 x y z p + = (absIf (absAnd (s_3_0 p) one) + (absAnd (s_1_0 x) (s_3_0 z)) + (absAnd + (g0 (s_1_0 y) one one (absAnd (s_3_1 p) one)) + (g1 (s_3_2 z) (s_3_1 z) one (absAnd (s_3_2 p) one)))) + +s_2_0 (v0,v1) = v0 +s_2_1 (v0,v1) = v1 +s_1_0 v0 = v0 +s_3_0 (v0,v1,v2) = v0 +s_3_1 (v0,v1,v2) = v1 +s_3_2 (v0,v1,v2) = v2 + +fac n a + = (fac_rec fac_rec4 n a) + +fac_rec4 n a = (fac_rec fac_rec3 n a) +fac_rec3 n a = (fac_rec fac_rec2 n a) +fac_rec2 n a = (fac_rec fac_rec1 n a) +fac_rec1 n a = (fac_rec fac_rec0 n a) +fac_rec0 n a = (bottom [n,a]) + +f a + = (f_rec f_rec2 a) + +f_rec2 a = (f_rec f_rec1 a) +f_rec1 a = (f_rec f_rec0 a) +f_rec0 a = (bottom [a]) + +g x y z p + = (g_rec g_rec16 g_rec16 x y z p) + +g_rec16 x y z p = (g_rec g_rec15 g_rec15 x y z p) +g_rec15 x y z p = (g_rec g_rec14 g_rec14 x y z p) +g_rec14 x y z p = (g_rec g_rec13 g_rec13 x y z p) +g_rec13 x y z p = (g_rec g_rec12 g_rec12 x y z p) +g_rec12 x y z p = (g_rec g_rec11 g_rec11 x y z p) +g_rec11 x y z p = (g_rec g_rec10 g_rec10 x y z p) +g_rec10 x y z p = (g_rec g_rec9 g_rec9 x y z p) +g_rec9 x y z p = (g_rec g_rec8 g_rec8 x y z p) +g_rec8 x y z p = (g_rec g_rec7 g_rec7 x y z p) +g_rec7 x y z p = (g_rec g_rec6 g_rec6 x y z p) +g_rec6 x y z p = (g_rec g_rec5 g_rec5 x y z p) +g_rec5 x y z p = (g_rec g_rec4 g_rec4 x y z p) +g_rec4 x y z p = (g_rec g_rec3 g_rec3 x y z p) +g_rec3 x y z p = (g_rec g_rec2 g_rec2 x y z p) +g_rec2 x y z p = (g_rec g_rec1 g_rec1 x y z p) +g_rec1 x y z p = (g_rec g_rec0 g_rec0 x y z p) +g_rec0 x y z p = (bottom [x,y,z,p]) diff --git a/ghc/compiler/tests/validation-misc/Echo.hs b/ghc/compiler/tests/validation-misc/Echo.hs new file mode 100644 index 0000000000..8711420239 --- /dev/null +++ b/ghc/compiler/tests/validation-misc/Echo.hs @@ -0,0 +1,8 @@ +import MiniPrel + +main = (ccall getchar) `thenU` ( \ ch -> + case ch of + -1# -> (ccall exit 0#) + _ -> (ccall putchar ch) `thenU` ( \ _ -> + main ) + ) diff --git a/ghc/compiler/tests/validation-misc/Jmakefile b/ghc/compiler/tests/validation-misc/Jmakefile new file mode 100644 index 0000000000..cdc330e55c --- /dev/null +++ b/ghc/compiler/tests/validation-misc/Jmakefile @@ -0,0 +1,11 @@ +all:: /* so we do not fall into runtests by default */ + @echo "making all in $(CURRENT_DIR) done" + +TESTGHC=$(GHC) + +runtests:: + @echo '###############################################################' + @echo '# The stuff that was here has been moved to ../*/ #' + @echo '###############################################################' + +ExtraStuffToBeVeryClean( $(STD_VERY_CLEAN) ) diff --git a/ghc/compiler/tests/validation-misc/dotests b/ghc/compiler/tests/validation-misc/dotests new file mode 100644 index 0000000000..5e2e80bc8e --- /dev/null +++ b/ghc/compiler/tests/validation-misc/dotests @@ -0,0 +1,27 @@ +#! /usr/local/bin/perl +# +@Make_args = (); +@Range_args = (); + +while ($_ = $ARGV[0]) { + shift; + if (/^-/ || /^[A-Z_]+=/) { + push(@Make_args, $_); + } else { + push(@Range_args,$_); + } +} + +if ($#Range_args != 1) { + print STDERR "usage: dotest [make-args] from-test to-test\n"; + exit(1); +} +$test = $Range_args[0]; +$last_test = $Range_args[1]; +if ($test gt $last_test) { + print STDERR "_from_ test $test _to_ test $last_test?\n"; +} +while ($test le $last_test) { + system("make @Make_args runtest_$test"); + $test++; # string incr +} diff --git a/ghc/compiler/tests/validation-misc/naming001.hs b/ghc/compiler/tests/validation-misc/naming001.hs new file mode 100644 index 0000000000..2d23bdc6da --- /dev/null +++ b/ghc/compiler/tests/validation-misc/naming001.hs @@ -0,0 +1 @@ +Prelude = 42 diff --git a/ghc/compiler/tests/validation-misc/naming002.hs b/ghc/compiler/tests/validation-misc/naming002.hs new file mode 100644 index 0000000000..2cd8b3dbab --- /dev/null +++ b/ghc/compiler/tests/validation-misc/naming002.hs @@ -0,0 +1 @@ +(+) x y = x diff --git a/ghc/compiler/tests/validation-misc/naming003.hs b/ghc/compiler/tests/validation-misc/naming003.hs new file mode 100644 index 0000000000..052d8c82e5 --- /dev/null +++ b/ghc/compiler/tests/validation-misc/naming003.hs @@ -0,0 +1 @@ +x = [1..10] where enumFromTo x y = x diff --git a/ghc/compiler/tests/validation-misc/naming004.hs b/ghc/compiler/tests/validation-misc/naming004.hs new file mode 100644 index 0000000000..aa4710ec6f --- /dev/null +++ b/ghc/compiler/tests/validation-misc/naming004.hs @@ -0,0 +1,2 @@ +data Bogus = True | False +True = (3 == 3) diff --git a/ghc/compiler/tests/validation-misc/naming005.hs b/ghc/compiler/tests/validation-misc/naming005.hs new file mode 100644 index 0000000000..a005e60a3b --- /dev/null +++ b/ghc/compiler/tests/validation-misc/naming005.hs @@ -0,0 +1 @@ +x x = x diff --git a/ghc/compiler/tests/validation-misc/testexpr.hs b/ghc/compiler/tests/validation-misc/testexpr.hs new file mode 100644 index 0000000000..bcaef3f6df --- /dev/null +++ b/ghc/compiler/tests/validation-misc/testexpr.hs @@ -0,0 +1,103 @@ +-- literal +----- + +x = 'a' -- 1 + +----- + +x = "123" -- 2 + +----- + +x = 1 -- 3 + +----- + +x = 1.2 + +----- + +-- exprs + +----- + +x = x -- 5 + +----- + +x = True -- 6 + +----- + +x = () -- 7 + +----- + +(x:y) = [1,2] -- 8 + +----- + +(x:y) = [1,'a'] -- 9 + +----- + +(x,y) = (1,'a') -- 10 + +----- + +(x,y) = (1,2,3) -- 11 + +----- + +(x:y) = (1,'a') -- 12 + +----- + +x = 1+x -- 13 + +----- + +x = 1+2 -- 14 + +----- + +f x = y where y = 2 -- 15 + +----- + + +f x = y+2 where y = x+3 + +----- + +f x = a where a = x:a + +----- + +(x:y) = case (if True then True else False) of -- 18 + True -> (True,1) + False -> (1,True) + +----- + +f x = \ (y,z) -> x -- 19 + +----- + +(x:y) = [y+1 | (y,z) <- [(1,2)]] -- 20 + +----- + +x = if True then 1 else 2 + +----- + +(z@(q,w)) = if True then (1,2) else (1,3) + +----- + +x = [1..2] + +----- + + diff --git a/ghc/compiler/tests/validation-misc/testgrhss.hs b/ghc/compiler/tests/validation-misc/testgrhss.hs new file mode 100644 index 0000000000..73f1901eac --- /dev/null +++ b/ghc/compiler/tests/validation-misc/testgrhss.hs @@ -0,0 +1,16 @@ +-- grhss +----- + +f x | True = x+1 -- 1 + | False = True + +----- + +x | True = x+1 -- 2 + | False = x + +----- + + + + diff --git a/ghc/compiler/tests/validation-misc/testmatches.hs b/ghc/compiler/tests/validation-misc/testmatches.hs new file mode 100644 index 0000000000..eb10ad9e28 --- /dev/null +++ b/ghc/compiler/tests/validation-misc/testmatches.hs @@ -0,0 +1,12 @@ +-- matches +----- +f x = case x of + True -> True + False -> x + +----- + +f ((x:a),y) = x +f (a,b) = 2 + +----- diff --git a/ghc/compiler/tests/validation-misc/testmonobinds.hs b/ghc/compiler/tests/validation-misc/testmonobinds.hs new file mode 100644 index 0000000000..d6dd8148bc --- /dev/null +++ b/ghc/compiler/tests/validation-misc/testmonobinds.hs @@ -0,0 +1,45 @@ +-- monobinds +----- + +a = 1:a + +----- + +a = 2 + +b = 1:a:c + +c = 0:b + +----- + +a = 1 + +b = a+a + +----- + +f = \ y -> y + +g x = x + +----- + +f True = 1 + +f False = 0 + +----- + +f (x:y) = x + +f z = z + +----- + +f (True,x) = x + +f (False,y) = y+1 + +----- + diff --git a/ghc/compiler/tests/validation-misc/testmrule.hs b/ghc/compiler/tests/validation-misc/testmrule.hs new file mode 100644 index 0000000000..9d617a0da1 --- /dev/null +++ b/ghc/compiler/tests/validation-misc/testmrule.hs @@ -0,0 +1,7 @@ +-- mrule +----- + +x = \ (y:z) -> z+2 + +----- + diff --git a/ghc/compiler/tests/validation-misc/testpats.hs b/ghc/compiler/tests/validation-misc/testpats.hs new file mode 100644 index 0000000000..ba09f2133d --- /dev/null +++ b/ghc/compiler/tests/validation-misc/testpats.hs @@ -0,0 +1,26 @@ +-- pats +----- + +_ = 2 -- + +----- + +x = 2 -- + +----- + +(z@(x:y)) = z -- + +----- + +~(x,y) = x -- + +----- + +f True = 1 + +f False = 0 + +----- + + diff --git a/ghc/compiler/tests/wdp-array.hs b/ghc/compiler/tests/wdp-array.hs new file mode 100644 index 0000000000..f3432c2bdc --- /dev/null +++ b/ghc/compiler/tests/wdp-array.hs @@ -0,0 +1,4 @@ +import MiniPrel + +a :: Array Int Int +a = array (1,100) ((1 := 1) : [i := i * a!(i-1) | i <- [2..100]]) diff --git a/ghc/compiler/tests/wdp-otherwise.hs b/ghc/compiler/tests/wdp-otherwise.hs new file mode 100644 index 0000000000..c59b949a48 --- /dev/null +++ b/ghc/compiler/tests/wdp-otherwise.hs @@ -0,0 +1,11 @@ +-- this is legal, I think (WDP) + +module Confused where + +import Prelude hiding (otherwise) + +otherwise = False + +f x | otherwise = 1 + +g otherwise | otherwise = 2 diff --git a/ghc/compiler/tests/wdp-ppr.hs b/ghc/compiler/tests/wdp-ppr.hs new file mode 100644 index 0000000000..563e752b90 --- /dev/null +++ b/ghc/compiler/tests/wdp-ppr.hs @@ -0,0 +1,13 @@ +{- +From: Kubiak Ryszard <fozzie> +To: partain +Subject: You may test the new pretty-printer on the following text: +Date: Wed, 2 Oct 91 18:06:05 BST +-} + +data LList alpha = Nill | Conss alpha (LList alpha) + +append :: LList a -> LList a -> LList a +append xs ys = case xs of + Nill -> ys + (Conss z zs) -> Conss z (append zs ys) diff --git a/ghc/compiler/tests/wdp-prel-insts.hs b/ghc/compiler/tests/wdp-prel-insts.hs new file mode 100644 index 0000000000..00a06cbece --- /dev/null +++ b/ghc/compiler/tests/wdp-prel-insts.hs @@ -0,0 +1,8 @@ +-- what error do you get if you redefined PreludeCore instances? + +module Test where + +f x@(a,b) y@(c,d) = x == y + +instance Eq (a,b) where + (m,n) == (o,p) = m == o |