A little more debug printing

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

diff --git a/ghc/compiler/hsSyn/Convert.lhs b/ghc/compiler/hsSyn/Convert.lhs
index 96623bb..6c14c11 100644 (file)
--- a/ghc/compiler/hsSyn/Convert.lhs
+++ b/ghc/compiler/hsSyn/Convert.lhs
@@ -20,7 +20,8 @@ import qualified Name ( Name, mkInternalName, getName )
 import Module   ( Module, mkModule )
 import RdrHsSyn        ( mkClassDecl, mkTyData )
 import qualified OccName
-import OccName ( startsVarId, startsVarSym, startsConId, startsConSym )
+import OccName ( startsVarId, startsVarSym, startsConId, startsConSym,
+                 pprNameSpace )
 import SrcLoc  ( Located(..), SrcSpan )
 import Type    ( Type )
 import TysWiredIn ( unitTyCon, tupleTyCon, tupleCon, trueDataCon, nilDataCon, consDataCon )
@@ -291,24 +292,24 @@ cvtBind :: TH.Dec -> CvtM (LHsBind RdrName)
 cvtBind (TH.ValD (TH.VarP s) body ds) 
   = do { s' <- vNameL s
        ; cl' <- cvtClause (Clause [] body ds)
-       ; returnL $ FunBind s' False (mkMatchGroup [cl']) placeHolderNames }
+       ; returnL $ mkFunBind s' [cl'] }
 
 cvtBind (TH.FunD nm cls)
   = do { nm' <- vNameL nm
        ; cls' <- mapM cvtClause cls
-       ; returnL $ FunBind nm' False (mkMatchGroup cls') placeHolderNames }
+       ; returnL $ mkFunBind nm' cls' }
 
 cvtBind (TH.ValD p body ds)
   = do { p' <- cvtPat p
        ; g' <- cvtGuard body
        ; ds' <- cvtDecs ds
-       ; returnL $ PatBind p' (GRHSs g' ds') void placeHolderNames }
+       ; returnL $ PatBind { pat_lhs = p', pat_rhs = GRHSs g' ds', 
+                             pat_rhs_ty = void, bind_fvs = placeHolderNames } }
 
 cvtBind d 
   = failWith (sep [ptext SLIT("Illegal kind of declaration in where clause"),
                   nest 2 (text (TH.pprint d))])
 
-
 cvtClause :: TH.Clause -> CvtM (Hs.LMatch RdrName)
 cvtClause (Clause ps body wheres)
   = do { ps' <- cvtPats ps
@@ -436,7 +437,7 @@ cvtp (TH.LitP l)
   | otherwise        = do { l' <- cvtLit l; return $ Hs.LitPat l' }
 cvtp (TH.VarP s)      = do { s' <- vName s; return $ Hs.VarPat s' }
 cvtp (TupP [p])       = cvtp p
-cvtp (TupP ps)        = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed }
+cvtp (TupP ps)        = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed void }
 cvtp (ConP s ps)      = do { s' <- cNameL s; ps' <- cvtPats ps; return $ ConPatIn s' (PrefixCon ps') }
 cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
                           ; return $ ConPatIn s' (InfixCon p1' p2') }
@@ -550,7 +551,7 @@ okOcc ns str@(c:_)
 
 badOcc :: OccName.NameSpace -> String -> SDoc
 badOcc ctxt_ns occ 
-  = ptext SLIT("Illegal") <+> text (OccName.nameSpaceString ctxt_ns) 
+  = ptext SLIT("Illegal") <+> pprNameSpace ctxt_ns
        <+> ptext SLIT("name:") <+> quotes (text occ)
 
 thRdrName :: OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
@@ -605,7 +606,7 @@ mk_uniq_occ ns occ uniq
 
 -- The packing and unpacking is rather turgid :-(
 mk_occ :: OccName.NameSpace -> String -> OccName.OccName
-mk_occ ns occ = OccName.mkOccFS ns (mkFastString occ)
+mk_occ ns occ = OccName.mkOccNameFS ns (mkFastString occ)
 
 mk_ghc_ns :: TH.NameSpace -> OccName.NameSpace
 mk_ghc_ns TH.DataName  = OccName.dataName