X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FConvert.lhs;h=42aa001f7c9773192788854c45729f2ef57e7c3f;hb=579bc757533c8c9e5beabe5b21daddd922c1af75;hp=84a61ffc268bd064781ec2b98132dd4cc7f2af9d;hpb=972c3fc8b0771d72141b85f2735e5d9d6b452137;p=ghc-hetmet.git diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs index 84a61ff..42aa001 100644 --- a/compiler/hsSyn/Convert.lhs +++ b/compiler/hsSyn/Convert.lhs @@ -16,8 +16,6 @@ This module converts Template Haskell syntax into HsSyn module Convert( convertToHsExpr, convertToPat, convertToHsDecls, convertToHsType, thRdrName ) where -#include "HsVersions.h" - import HsSyn as Hs import qualified Class import RdrName @@ -53,14 +51,14 @@ convertToHsDecls loc ds = initCvt loc (mapM cvtTop ds) convertToHsExpr :: SrcSpan -> TH.Exp -> Either Message (LHsExpr RdrName) convertToHsExpr loc e = case initCvt loc (cvtl e) of - Left msg -> Left (msg $$ (ptext SLIT("When converting TH expression") + Left msg -> Left (msg $$ (ptext (sLit "When converting TH expression") <+> text (show e))) Right res -> Right res convertToPat :: SrcSpan -> TH.Pat -> Either Message (LPat RdrName) convertToPat loc e = case initCvt loc (cvtPat e) of - Left msg -> Left (msg $$ (ptext SLIT("When converting TH pattern") + Left msg -> Left (msg $$ (ptext (sLit "When converting TH pattern") <+> text (show e))) Right res -> Right res @@ -97,7 +95,7 @@ force a = a `seq` return a failWith :: Message -> CvtM a failWith m = CvtM (\_ -> Left full_msg) where - full_msg = m $$ ptext SLIT("When splicing generated code into the program") + full_msg = m $$ ptext (sLit "When splicing generated code into the program") returnL :: a -> CvtM (Located a) returnL x = CvtM (\loc -> Right (L loc x)) @@ -239,7 +237,7 @@ cvtForD (ImportF callconv safety from nm ty) ; return $ ForeignImport nm' ty' i } | otherwise - = failWith $ text (show from)<+> ptext SLIT("is not a valid ccall impent") + = failWith $ text (show from)<+> ptext (sLit "is not a valid ccall impent") where safety' = case safety of Unsafe -> PlayRisky @@ -341,7 +339,7 @@ cvtBind (TH.ValD p body ds) pat_rhs_ty = void, bind_fvs = placeHolderNames } } cvtBind d - = failWith (sep [ptext SLIT("Illegal kind of declaration in where clause"), + = failWith (sep [ptext (sLit "Illegal kind of declaration in where clause"), nest 2 (text (TH.pprint d))]) cvtClause :: TH.Clause -> CvtM (Hs.LMatch RdrName) @@ -457,6 +455,7 @@ cvtOverLit (StringL s) = do { let { s' = mkFastString s }; force s'; return $ cvtLit :: Lit -> CvtM HsLit cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim i } +cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim w } cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim f } cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim f } cvtLit (CharL c) = do { force c; return $ HsChar c } @@ -512,7 +511,7 @@ cvtPred ty ; case head of ConT tc -> do { tc' <- tconName tc; returnL $ HsClassP tc' tys' } VarT tv -> do { tv' <- tName tv; returnL $ HsClassP tv' tys' } - _ -> failWith (ptext SLIT("Malformed predicate") <+> text (TH.pprint ty)) } + _ -> failWith (ptext (sLit "Malformed predicate") <+> text (TH.pprint ty)) } cvtType :: TH.Type -> CvtM (LHsType RdrName) cvtType ty = do { (head, tys') <- split_ty_app ty @@ -529,7 +528,7 @@ cvtType ty = do { (head, tys') <- split_ty_app ty ; cxt' <- cvtContext cxt ; ty' <- cvtType ty ; returnL $ mkExplicitHsForAllTy tvs' cxt' ty' } - _ -> failWith (ptext SLIT("Malformed type") <+> text (show ty)) + _ -> failWith (ptext (sLit "Malformed type") <+> text (show ty)) } where mk_apps head [] = returnL head @@ -593,8 +592,8 @@ okOcc ns str@(c:_) badOcc :: OccName.NameSpace -> String -> SDoc badOcc ctxt_ns occ - = ptext SLIT("Illegal") <+> pprNameSpace ctxt_ns - <+> ptext SLIT("name:") <+> quotes (text occ) + = ptext (sLit "Illegal") <+> pprNameSpace ctxt_ns + <+> ptext (sLit "name:") <+> quotes (text occ) thRdrName :: OccName.NameSpace -> String -> TH.NameFlavour -> RdrName -- This turns a Name into a RdrName