import {-# SOURCE #-} TcExpr( tcPolyExpr )
import {-# SOURCE #-} TcUnify( boxyUnify, unifyType )
-import FastString(FastString)
+import FastString
import HsSyn
import TcHsSyn
import TcRnMonad
\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
(\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)]
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
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
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}