X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsDecls.lhs;h=8827f3ab64269240c623cda24af62b5541384be7;hp=baf6eca76fd80199d1190f595559110c9a371c90;hb=6ea06bbf08517d9805feb82df65cc56ecbaf23a4;hpb=302e2e29f2e1074bfba561e077a484dc4e1d15f6

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index baf6eca..8827f3a 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -24,7 +24,7 @@ module HsDecls (
   -- ** Class or type declarations
   TyClDecl(..), LTyClDecl,
   isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
-  isFamInstDecl, tcdName, tyClDeclNames, tyClDeclTyVars,
+  isFamInstDecl, tcdName, tyClDeclTyVars,
   countTyClDecls,
   -- ** Instance declarations
   InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
@@ -43,7 +43,7 @@ module HsDecls (
   CImportSpec(..),
   -- ** Data-constructor declarations
   ConDecl(..), LConDecl, ResType(..), 
-  HsConDeclDetails, hsConDeclArgTys, hsConDeclsNames,
+  HsConDeclDetails, hsConDeclArgTys, 
   -- ** Document comments
   DocDecl(..), LDocDecl, docDeclDoc,
   -- ** Deprecations
@@ -126,7 +126,12 @@ data HsDecl id
 data HsGroup id
   = HsGroup {
 	hs_valds  :: HsValBinds id,
-	hs_tyclds :: [LTyClDecl id],
+
+	hs_tyclds :: [[LTyClDecl id]],	
+		-- A list of mutually-recursive groups
+		-- Parser generates a singleton list;
+		-- renamer does dependency analysis
+
 	hs_instds :: [LInstDecl id],
         hs_derivds :: [LDerivDecl id],
 
@@ -221,16 +226,27 @@ instance OutputableBndr name => Outputable (HsGroup name) where
 		   hs_fords  = foreign_decls,
 		   hs_defds  = default_decls,
 		   hs_ruleds = rule_decls })
-	= vcat [ppr_ds fix_decls, ppr_ds default_decls, 
-		ppr_ds deprec_decls, ppr_ds ann_decls,
-		ppr_ds rule_decls,
-		ppr val_decls,
-		ppr_ds tycl_decls, ppr_ds inst_decls,
-                ppr_ds deriv_decls,
-		ppr_ds foreign_decls]
+	= vcat_mb empty 
+            [ppr_ds fix_decls, ppr_ds default_decls, 
+	     ppr_ds deprec_decls, ppr_ds ann_decls,
+	     ppr_ds rule_decls,
+	     if isEmptyValBinds val_decls 
+                then Nothing 
+                else Just (ppr val_decls),
+	     ppr_ds (concat tycl_decls), 
+             ppr_ds inst_decls,
+             ppr_ds deriv_decls,
+	     ppr_ds foreign_decls]
 	where
-	  ppr_ds [] = empty
-	  ppr_ds ds = blankLine $$ vcat (map ppr ds)
+          ppr_ds :: Outputable a => [a] -> Maybe SDoc
+	  ppr_ds [] = Nothing
+	  ppr_ds ds = Just (vcat (map ppr ds))
+
+          vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
+	  -- Concatenate vertically with white-space between non-blanks
+          vcat_mb _    []             = empty
+          vcat_mb gap (Nothing : ds) = vcat_mb gap ds
+          vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
 
 data SpliceDecl id 
   = SpliceDecl			-- Top level splice
@@ -544,23 +560,6 @@ Dealing with names
 tcdName :: TyClDecl name -> name
 tcdName decl = unLoc (tcdLName decl)
 
-tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
--- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
--- The first one is guaranteed to be the name of the decl. For record fields
--- mentioned in multiple constructors, the SrcLoc will be from the first
--- occurence.  We use the equality to filter out duplicate field names
-
-tyClDeclNames (TyFamily    {tcdLName = name})    = [name]
-tyClDeclNames (TySynonym   {tcdLName = name})    = [name]
-tyClDeclNames (ForeignType {tcdLName = name})    = [name]
-
-tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
-  = cls_name : 
-    concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
-
-tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
-  = tc_name : hsConDeclsNames cons
-
 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
 tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
@@ -644,6 +643,7 @@ instance OutputableBndr name
         top_matter    =     ptext (sLit "class") 
 		        <+> pp_decl_head (unLoc context) lclas tyvars Nothing
 		        <+> pprFundeps (map unLoc fds)
+        ppr_semi :: Outputable a => a -> SDoc
 	ppr_semi decl = ppr decl <> semi
 
 pp_decl_head :: OutputableBndr name
@@ -757,24 +757,6 @@ instance OutputableBndr name => Outputable (ResType name) where
    ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
 \end{code}
 
-\begin{code}
-hsConDeclsNames :: (Eq name) => [LConDecl name] -> [Located name]
-  -- See tyClDeclNames for what this does
-  -- The function is boringly complicated because of the records
-  -- And since we only have equality, we have to be a little careful
-hsConDeclsNames cons
-  = snd (foldl do_one ([], []) cons)
-  where
-    do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
-	= (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
-	where
-	  new_flds = filterOut (\f -> unLoc f `elem` flds_seen) 
-			       (map cd_fld_name flds)
-
-    do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
-	= (flds_seen, lname:acc)
-\end{code}
-  
 
 \begin{code}
 instance (OutputableBndr name) => Outputable (ConDecl name) where
@@ -837,8 +819,8 @@ instance (OutputableBndr name) => Outputable (InstDecl name) where
 
 -- Extract the declarations of associated types from an instance
 --
-instDeclATs :: InstDecl name -> [LTyClDecl name]
-instDeclATs (InstDecl _ _ _ ats) = ats
+instDeclATs :: [LInstDecl name] -> [LTyClDecl name]
+instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats]
 \end{code}
 
 %************************************************************************
@@ -921,7 +903,7 @@ data ForeignImport = -- import of a C entity
 		     --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
 		     --
 		     CImport  CCallConv	      -- ccall or stdcall
-			      Safety	      -- safe or unsafe
+			      Safety	      -- interruptible, safe or unsafe
 			      FastString      -- name of C header
 			      CImportSpec     -- details of the C entity
   deriving (Data, Typeable)