X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FInst.lhs;h=0c18a014bc225577bcbcb2d966488a6e617369e5;hb=11db0bc8cd2eee13339578ca447c0a2d97f453c3;hp=91e409fe286dddc33a1076932adf53cdfe23852e;hpb=30c122df62ec75f9ed7f392f24c2925675bf1d06;p=ghc-hetmet.git diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs index 91e409f..0c18a01 100644 --- a/compiler/typecheck/Inst.lhs +++ b/compiler/typecheck/Inst.lhs @@ -474,6 +474,7 @@ newMethod inst_loc id tys = do shortCutIntLit :: Integer -> TcType -> Maybe (HsExpr TcId) shortCutIntLit i ty | 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 @@ -484,11 +485,13 @@ shortCutIntLit i ty 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)) + | 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 @@ -728,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 @@ -824,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 @@ -965,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}