From: simonpj@microsoft.com <unknown>
Date: Thu, 6 Mar 2008 13:47:34 +0000 (+0000)
Subject: Fix Trac #783: improve short-cutting literals in the type checker
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=0a8ad35fdcee761755e53270b2474c9b13a055dd

Fix Trac #783: improve short-cutting literals in the type checker

The Inst.shortCutIntLit mechanism in the type checker was missing cases
where a floating-point literal was given without an explicit decimal point.

As a result, programs with lots of floating-point literals (without decimals)
ended up with massive Static Reference Tables.  This is not cool.  See
comments with Trac #783 for details.
---

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index db61c6d..d507bdd 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -473,19 +473,20 @@ newMethod inst_loc id tys = do
 \begin{code}
 shortCutIntLit :: Integer -> TcType -> Maybe (HsExpr TcId)
 shortCutIntLit i ty
-  | isIntTy ty && inIntRange i 		-- Short cut for Int
-  = Just (HsLit (HsInt i))
-  | isIntegerTy ty 			-- Short cut for Integer
-  = Just (HsLit (HsInteger i ty))
-  | otherwise = Nothing
+  | isIntTy ty && inIntRange i = Just (HsLit (HsInt i))
+  | isIntegerTy ty 	       = Just (HsLit (HsInteger i ty))
+  | otherwise		       = shortCutFracLit (fromInteger i) ty
+	-- The 'otherwise' case is important
+	-- Consider (3 :: Float).  Syntactically it looks like an IntLit,
+	-- so we'll call shortCutIntLit, but of course it's a float
+	-- This can make a big difference for programs with a lot of
+	-- literals, compiled without -O
 
 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
+  | 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)