Fix Haddock errors.

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

diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 84a61ff..5a5bb1b 100644 (file)
--- 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))
@@ -148,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' }
@@ -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)
@@ -368,7 +366,7 @@ cvtl e = wrapL (cvt e)
     cvt (AppE x y)     = do { x' <- cvtl x; y' <- cvtl y; return $ HsApp x' y' }
     cvt (LamE ps e)    = do { ps' <- cvtPats ps; e' <- cvtl e 
                            ; return $ HsLam (mkMatchGroup [mkSimpleMatch ps' e']) }
-    cvt (TupE [e])     = cvt e
+    cvt (TupE [e])     = cvt e -- Singleton tuples treated like nothing (just parens)
     cvt (TupE es)      = do { es' <- mapM cvtl es; return $ ExplicitTuple es' Boxed }
     cvt (CondE x y z)  = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z
                            ; return $ HsIf x' y' z' }
@@ -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,13 +511,16 @@ 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
-               ; case head of
-                   TupleT n | length tys' == n -> returnL (HsTupleTy Boxed tys')
-                            | n == 0    -> mk_apps (HsTyVar (getRdrName unitTyCon)) tys'
+cvtType ty = do { (head_ty, tys') <- split_ty_app ty
+               ; case head_ty of
+                   TupleT n | length tys' == n         -- Saturated
+                            -> if n==1 then return (head tys') -- Singleton tuples treated 
+                                                               -- like nothing (ie just parens)
+                                       else returnL (HsTupleTy Boxed tys')
+                            | n == 1    -> failWith (ptext (sLit "Illegal 1-tuple type constructor"))
                             | otherwise -> mk_apps (HsTyVar (getRdrName (tupleTyCon Boxed n))) tys'
                    ArrowT | [x',y'] <- tys' -> returnL (HsFunTy x' y')
                    ListT  | [x']    <- tys' -> returnL (HsListTy x')
@@ -529,11 +531,12 @@ 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
-    mk_apps head (ty:tys) = do { head' <- returnL head; mk_apps (HsAppTy head' ty) tys }
+    mk_apps head_ty []       = returnL head_ty
+    mk_apps head_ty (ty:tys) = do { head_ty' <- returnL head_ty
+                                 ; mk_apps (HsAppTy head_ty' ty) tys }
 
 split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsType RdrName])
 split_ty_app ty = go ty []
@@ -593,8 +596,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