Improve Haddock-markup for HsDecls module.

[ghc-hetmet.git] / compiler / hsSyn / Convert.lhs

diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 5b3c5e8..48844dd 100644 (file)
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -51,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 splicing 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 splicing TH pattern:")
                                     <+> text (show e)))
         Right res -> Right res
 
@@ -146,7 +146,7 @@ cvtTop (InstanceD tys ty decs)
        ; L loc pred' <- cvtPred ty
        ; inst_ty' <- returnL $ mkImplicitHsForAllTy ctxt' (L loc (HsPredTy pred'))
        ; returnL $ InstD (InstDecl inst_ty' binds' sigs' [])
-                                                      -- ^^no ATs in TH
+                                       -- no ATs in TH   ^^
        }
 
 cvtTop (ForeignD ford) = do { ford' <- cvtForD ford; returnL $ ForD ford' }
@@ -412,6 +412,8 @@ cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; retur
 
 cvtHsDo :: HsStmtContext Name.Name -> [TH.Stmt] -> CvtM (HsExpr RdrName)
 cvtHsDo do_or_lc stmts
+  | null stmts = failWith (ptext (sLit "Empty stmt list in do-block"))
+  | otherwise
   = do { stmts' <- cvtStmts stmts
        ; let body = case last stmts' of
                        L _ (ExprStmt body _ _) -> body
@@ -591,8 +593,8 @@ cvtName ctxt_ns (TH.Name occ flavour)
 okOcc :: OccName.NameSpace -> String -> Bool
 okOcc _  []      = False
 okOcc ns str@(c:_) 
-  | OccName.isVarName ns = startsVarId c || startsVarSym c
-  | otherwise           = startsConId c || startsConSym c || str == "[]"
+  | OccName.isVarNameSpace ns = startsVarId c || startsVarSym c
+  | otherwise                = startsConId c || startsConSym c || str == "[]"
 
 badOcc :: OccName.NameSpace -> String -> SDoc
 badOcc ctxt_ns occ 
@@ -634,8 +636,8 @@ isBuiltInOcc ctxt_ns occ
     go_tuple _ _            = Nothing
 
     tup_name n 
-       | OccName.isTcClsName ctxt_ns = Name.getName (tupleTyCon Boxed n)
-       | otherwise                   = Name.getName (tupleCon Boxed n)
+       | OccName.isTcClsNameSpace ctxt_ns = Name.getName (tupleTyCon Boxed n)
+       | otherwise                        = Name.getName (tupleCon Boxed n)
 
 mk_uniq_occ :: OccName.NameSpace -> String -> Int# -> OccName.OccName
 mk_uniq_occ ns occ uniq