diff -rN -u old-ghc/compiler/deSugar/Check.lhs new-ghc/compiler/deSugar/Check.lhs --- old-ghc/compiler/deSugar/Check.lhs 2007-04-04 10:18:30.000000000 -0400 +++ new-ghc/compiler/deSugar/Check.lhs 2007-04-04 10:18:32.000000000 -0400 @@ -656,8 +656,8 @@ where mk_char_lit c = mkPrefixConPat charDataCon [nlLitPat (HsCharPrim c)] charTy -simplify_pat (LitPat lit) = tidyLitPat lit -simplify_pat (NPat lit mb_neg eq lit_ty) = tidyNPat lit mb_neg eq lit_ty +simplify_pat pat@(LitPat lit) = pat +simplify_pat pat@(NPat lit mb_neg eq lit_ty) = pat simplify_pat (NPlusKPat id hslit hsexpr1 hsexpr2) = WildPat (idType (unLoc id)) diff -rN -u old-ghc/compiler/deSugar/Match.lhs new-ghc/compiler/deSugar/Match.lhs --- old-ghc/compiler/deSugar/Match.lhs 2007-04-04 10:18:30.000000000 -0400 +++ new-ghc/compiler/deSugar/Match.lhs 2007-04-04 10:18:32.000000000 -0400 @@ -457,14 +457,6 @@ num_of_d_and_ms = length dicts + length methods dict_and_method_pats = map nlVarPat (dicts ++ methods) --- LitPats: we *might* be able to replace these w/ a simpler form -tidy1 v (LitPat lit) - = returnDs (idDsWrapper, tidyLitPat lit) - --- NPats: we *might* be able to replace these w/ a simpler form -tidy1 v (NPat lit mb_neg eq lit_ty) - = returnDs (idDsWrapper, tidyNPat lit mb_neg eq lit_ty) - -- Everything else goes through unchanged... tidy1 v non_interesting_pat diff -rN -u old-ghc/compiler/deSugar/MatchLit.lhs new-ghc/compiler/deSugar/MatchLit.lhs --- old-ghc/compiler/deSugar/MatchLit.lhs 2007-04-04 10:18:30.000000000 -0400 +++ new-ghc/compiler/deSugar/MatchLit.lhs 2007-04-04 10:18:32.000000000 -0400 @@ -7,7 +7,6 @@ \begin{code} module MatchLit ( dsLit, dsOverLit, hsLitKey, hsOverLitKey, - tidyLitPat, tidyNPat, matchLiterals, matchNPlusKPats, matchNPats ) where #include "HsVersions.h" @@ -125,62 +124,6 @@ %************************************************************************ %* * - Tidying lit pats -%* * -%************************************************************************ - -\begin{code} -tidyLitPat :: HsLit -> Pat Id --- Result has only the following HsLits: --- HsIntPrim, HsCharPrim, HsFloatPrim --- HsDoublePrim, HsStringPrim, HsString --- * HsInteger, HsRat, HsInt can't show up in LitPats --- * We get rid of HsChar right here -tidyLitPat (HsChar c) = unLoc (mkCharLitPat c) -tidyLitPat (HsString s) - | lengthFS s <= 1 -- Short string literals only - = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] stringTy) - (mkNilPat stringTy) (unpackFS s) - -- The stringTy is the type of the whole pattern, not - -- the type to instantiate (:) or [] with! -tidyLitPat lit = LitPat lit - ----------------- -tidyNPat :: HsOverLit Id -> Maybe (SyntaxExpr Id) -> SyntaxExpr Id - -> Type -> Pat Id -tidyNPat over_lit mb_neg eq lit_ty - | isIntTy lit_ty = mk_con_pat intDataCon (HsIntPrim int_val) - | isFloatTy lit_ty = mk_con_pat floatDataCon (HsFloatPrim rat_val) - | isDoubleTy lit_ty = mk_con_pat doubleDataCon (HsDoublePrim rat_val) --- | isStringTy lit_ty = mk_con_pat stringDataCon (HsStringPrim str_val) - | otherwise = NPat over_lit mb_neg eq lit_ty - where - mk_con_pat :: DataCon -> HsLit -> Pat Id - mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] lit_ty) - neg_lit = case (mb_neg, over_lit) of - (Nothing, _) -> over_lit - (Just _, HsIntegral i s) -> HsIntegral (-i) s - (Just _, HsFractional f s) -> HsFractional (-f) s - - int_val :: Integer - int_val = case neg_lit of - HsIntegral i _ -> i - HsFractional f _ -> panic "tidyNPat" - - rat_val :: Rational - rat_val = case neg_lit of - HsIntegral i _ -> fromInteger i - HsFractional f _ -> f - - str_val :: FastString - str_val = case neg_lit of - HsIsString s _ -> s - _ -> error "tidyNPat" -\end{code} - - -%************************************************************************ -%* * Pattern matching on LitPat %* * %************************************************************************ diff -rN -u old-ghc/compiler/main/DynFlags.hs new-ghc/compiler/main/DynFlags.hs --- old-ghc/compiler/main/DynFlags.hs 2007-04-04 10:18:30.000000000 -0400 +++ new-ghc/compiler/main/DynFlags.hs 2007-04-04 10:18:32.000000000 -0400 @@ -392,7 +392,7 @@ extCoreName = "", verbosity = 0, optLevel = 0, - maxSimplIterations = 4, + maxSimplIterations = 5, ruleCheck = Nothing, specThreshold = 200, stolen_x86_regs = 4, @@ -727,7 +727,7 @@ -- Phase 0: allow all Ids to be inlined now -- This gets foldr inlined before strictness analysis - MaxSimplifierIterations 3 + MaxSimplifierIterations 4 -- At least 3 iterations because otherwise we land up with -- huge dead expressions because of an infelicity in the -- simpifier. diff -rN -u old-ghc/compiler/typecheck/Inst.lhs new-ghc/compiler/typecheck/Inst.lhs --- old-ghc/compiler/typecheck/Inst.lhs 2007-04-04 10:18:30.000000000 -0400 +++ new-ghc/compiler/typecheck/Inst.lhs 2007-04-04 10:18:32.000000000 -0400 @@ -17,7 +17,7 @@ newDictBndr, newDictBndrs, newDictBndrsO, instCall, instStupidTheta, cloneDict, - shortCutFracLit, shortCutIntLit, shortCutStringLit, newIPDict, + newIPDict, newMethod, newMethodFromName, newMethodWithGivenTy, tcInstClassOp, tcSyntaxName, isHsVar, @@ -419,30 +419,6 @@ \end{code} \begin{code} -shortCutIntLit :: DynFlags -> Integer -> TcType -> Maybe (HsExpr TcId) -shortCutIntLit dflags i ty - | isIntTy ty && inIntRange dflags i -- Short cut for Int - = Just (HsLit (HsInt i)) - | isIntegerTy ty -- Short cut for Integer - = Just (HsLit (HsInteger i ty)) - | otherwise = Nothing - -shortCutFracLit :: Rational -> TcType -> Maybe (HsExpr TcId) -shortCutFracLit f ty - | isFloatTy ty - = Just (mk_lit floatDataCon (HsFloatPrim f)) - | isDoubleTy ty - = Just (mk_lit doubleDataCon (HsDoublePrim f)) - | otherwise = Nothing - where - mk_lit con lit = HsApp (nlHsVar (dataConWrapId con)) (nlHsLit lit) - -shortCutStringLit :: FastString -> TcType -> Maybe (HsExpr TcId) -shortCutStringLit s ty - | isStringTy ty -- Short cut for String - = Just (HsLit (HsString s)) - | otherwise = Nothing - mkIntegerLit :: Integer -> TcM (LHsExpr TcId) mkIntegerLit i = tcMetaTy integerTyConName `thenM` \ integer_ty -> @@ -698,31 +674,16 @@ span = instLocSpan loc --------------------- Literals ------------------------ --- Look for short cuts first: if the literal is *definitely* a --- int, integer, float or a double, generate the real thing here. --- This is essential (see nofib/spectral/nucleic). --- [Same shortcut as in newOverloadedLit, but we --- may have done some unification by now] - lookupSimpleInst (LitInst {tci_lit = HsIntegral i from_integer_name, tci_ty = ty, tci_loc = loc}) - = getDOpts `thenM` \ dflags -> - case shortCutIntLit dflags i ty of { - Just expr -> returnM (GenInst [] (noLoc expr)); - Nothing -> - ASSERT( from_integer_name `isHsVar` fromIntegerName ) -- A LitInst invariant + = ASSERT( from_integer_name `isHsVar` fromIntegerName ) -- A LitInst invariant tcLookupId fromIntegerName `thenM` \ from_integer -> tcInstClassOp loc from_integer [ty] `thenM` \ method_inst -> mkIntegerLit i `thenM` \ integer_lit -> returnM (GenInst [method_inst] (mkHsApp (L (instLocSpan loc) (HsVar (instToId method_inst))) integer_lit)) - } lookupSimpleInst (LitInst {tci_lit = HsFractional f from_rat_name, tci_ty = ty, tci_loc = loc}) - | Just expr <- shortCutFracLit f ty - = returnM (GenInst [] (noLoc expr)) - - | otherwise = ASSERT( from_rat_name `isHsVar` fromRationalName ) -- A LitInst invariant tcLookupId fromRationalName `thenM` \ from_rational -> tcInstClassOp loc from_rational [ty] `thenM` \ method_inst -> @@ -731,9 +692,6 @@ (HsVar (instToId method_inst))) rat_lit)) lookupSimpleInst (LitInst {tci_lit = HsIsString s from_string_name, tci_ty = ty, tci_loc = loc}) - | Just expr <- shortCutStringLit s ty - = returnM (GenInst [] (noLoc expr)) - | otherwise = ASSERT( from_string_name `isHsVar` fromStringName ) -- A LitInst invariant tcLookupId fromStringName `thenM` \ from_string -> tcInstClassOp loc from_string [ty] `thenM` \ method_inst -> diff -rN -u old-ghc/compiler/typecheck/TcPat.lhs new-ghc/compiler/typecheck/TcPat.lhs --- old-ghc/compiler/typecheck/TcPat.lhs 2007-04-04 10:18:30.000000000 -0400 +++ new-ghc/compiler/typecheck/TcPat.lhs 2007-04-04 10:18:32.000000000 -0400 @@ -769,11 +769,6 @@ %* * %************************************************************************ -In tcOverloadedLit we convert directly to an Int or Integer if we -know that's what we want. This may save some time, by not -temporarily generating overloaded literals, but it won't catch all -cases (the rest are caught in lookupInst). - \begin{code} tcOverloadedLit :: InstOrigin -> HsOverLit Name @@ -790,12 +785,8 @@ ; return (HsIntegral i (HsApp (noLoc fi') (nlHsLit (HsInteger i integer_ty)))) } | otherwise - = do { dflags <- getDOpts - ; case shortCutIntLit dflags i res_ty of { Just expr -> - return (HsIntegral i expr) - ; _ -> - do { expr <- newLitInst orig lit res_ty - ; return (HsIntegral i expr) } } } + = do { expr <- newLitInst orig lit res_ty + ; return (HsIntegral i expr) } tcOverloadedLit orig lit@(HsFractional r fr) res_ty | not (fr `isHsVar` fromRationalName) -- c.f. HsIntegral case @@ -807,9 +798,6 @@ -- However this'll be picked up by tcSyntaxOp if necessary ; return (HsFractional r (HsApp (noLoc fr') (nlHsLit (HsRat r rat_ty)))) } - | Just expr <- shortCutFracLit r res_ty - = return (HsFractional r expr) - | otherwise = do { expr <- newLitInst orig lit res_ty ; return (HsFractional r expr) } @@ -820,9 +808,6 @@ ; fr' <- tcSyntaxOp orig fr (mkFunTy str_ty res_ty) ; return (HsIsString s (HsApp (noLoc fr') (nlHsLit (HsString s)))) } - | Just expr <- shortCutStringLit s res_ty - = return (HsIsString s expr) - | otherwise = do { expr <- newLitInst orig lit res_ty ; return (HsIsString s expr) }