Whitespace only (TcInstDcls)

[ghc-hetmet.git] / compiler / typecheck / Inst.lhs

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index db61c6d..0c18a01 100644 (file)
--- 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,21 +473,25 @@ 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))
+  | isWordTy ty && inWordRange i = Just (mkLit wordDataCon (HsWordPrim 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 (mkLit floatDataCon  (HsFloatPrim f))
+  | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim f))
+  | otherwise     = Nothing
   where
-    mk_lit con lit = HsApp (nlHsVar (dataConWrapId con)) (nlHsLit lit)
+
+mkLit :: DataCon -> HsLit -> HsExpr Id
+mkLit con lit = HsApp (nlHsVar (dataConWrapId con)) (nlHsLit lit)
 
 shortCutStringLit :: FastString -> TcType -> Maybe (HsExpr TcId)
 shortCutStringLit s ty
@@ -727,11 +731,11 @@ traceDFuns ispecs
 
 funDepErr ispec ispecs
   = addDictLoc ispec $
-    addErr (hang (ptext SLIT("Functional dependencies conflict between instance declarations:"))
+    addErr (hang (ptext (sLit "Functional dependencies conflict between instance declarations:"))
               2 (pprInstances (ispec:ispecs)))
 dupInstErr ispec dup_ispec
   = addDictLoc ispec $
-    addErr (hang (ptext SLIT("Duplicate instance declarations:"))
+    addErr (hang (ptext (sLit "Duplicate instance declarations:"))
               2 (pprInstances [ispec, dup_ispec]))
 
 addDictLoc ispec thing_inside
@@ -823,7 +827,7 @@ lookupSimpleInst (Dict {tci_pred = pred, tci_loc = loc})
            Just (dfun_id, mb_inst_tys) -> do
 
     { use_stage <- getStage
-    ; checkWellStaged (ptext SLIT("instance for") <+> quotes (ppr pred))
+    ; checkWellStaged (ptext (sLit "instance for") <+> quotes (ppr pred))
                      (topIdLvl dfun_id) use_stage
 
        -- It's possible that not all the tyvars are in
@@ -964,10 +968,10 @@ tcSyntaxName orig ty (std_nm, user_nm_expr) = do
 syntaxNameCtxt name orig ty tidy_env = do
     inst_loc <- getInstLoc orig
     let
-       msg = vcat [ptext SLIT("When checking that") <+> quotes (ppr name) <+> 
-                               ptext SLIT("(needed by a syntactic construct)"),
-                   nest 2 (ptext SLIT("has the required type:") <+> ppr (tidyType tidy_env ty)),
-                   nest 2 (ptext SLIT("arising from") <+> pprInstLoc inst_loc)]
+       msg = vcat [ptext (sLit "When checking that") <+> quotes (ppr name) <+> 
+                               ptext (sLit "(needed by a syntactic construct)"),
+                   nest 2 (ptext (sLit "has the required type:") <+> ppr (tidyType tidy_env ty)),
+                   nest 2 (ptext (sLit "arising from") <+> pprInstLoc inst_loc)]
     
     return (tidy_env, msg)
 \end{code}