X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FInst.lhs;h=91e409fe286dddc33a1076932adf53cdfe23852e;hb=4c6a3f787abcaed009a574196d82237d9ae64fc8;hp=6bcd3a3a87f3766f9cded3a8fa7db67214131dec;hpb=f84b83e59ee9b893dacc4e4c3bd49e00eae957b1;p=ghc-hetmet.git

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 6bcd3a3..91e409f 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -60,7 +60,7 @@ module Inst (
 import {-# SOURCE #-}	TcExpr( tcPolyExpr )
 import {-# SOURCE #-}	TcUnify( boxyUnify, unifyType )
 
-import FastString(FastString)
+import FastString
 import HsSyn
 import TcHsSyn
 import TcRnMonad
@@ -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)
 
@@ -603,15 +604,13 @@ pprInst i@(EqInst {tci_left = ty1, tci_right = ty2, tci_co = co})
 		(\covar -> text "Wanted" <+> ppr (TyVarTy covar) <+> dcolon <+> ppr (EqPred ty1 ty2))
 		(\co    -> text "Given"  <+> ppr co              <+> dcolon <+> ppr (EqPred ty1 ty2))
 pprInst inst = ppr name <> braces (pprUnique (getUnique name)) <+> dcolon 
-		<+> (braces (ppr (instType inst) <> implicWantedEqs) $$
-		     ifPprDebug implic_stuff)
+		<+> braces (ppr (instType inst) <> implicWantedEqs)
   where
     name = instName inst
-    (implic_stuff, implicWantedEqs) 
-      | isImplicInst inst = (ppr (tci_reft inst),
-                            text " &" <+> 
-                            ppr (filter isEqInst (tci_wanted inst)))
-      | otherwise	  = (empty, empty)
+    implicWantedEqs
+      | isImplicInst inst = text " &" <+> 
+                            ppr (filter isEqInst (tci_wanted inst))
+      | otherwise	  = empty
 
 pprInstInFull inst@(EqInst {}) = pprInst inst
 pprInstInFull inst = sep [quotes (pprInst inst), nest 2 (pprInstArising inst)]