X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsUtils.lhs;h=e16a0bde838a8adad6b0db3b23963a2e3f3cf729;hb=4bc7e71805c4c90c06a323cf2fcff7c218e300bd;hp=51925f8b9dc64cf98e2b4e9437f7c2f6eaa4df50;hpb=382cae3ae9f2c05fcb043fa9ae403d9ff966cee5;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 51925f8..e16a0bd 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -22,7 +22,6 @@ import HsExpr
 import HsPat
 import HsTypes	
 import HsLit
-import HsDecls
 
 import RdrName
 import Var
@@ -118,6 +117,7 @@ mkSimpleHsAlt pat expr
 
 mkHsIntegral   i       = HsIntegral   i  noSyntaxExpr
 mkHsFractional f       = HsFractional f  noSyntaxExpr
+mkHsIsString   s       = HsIsString   s  noSyntaxExpr
 mkHsDo ctxt stmts body = HsDo ctxt stmts body placeHolderType
 
 mkNPat lit neg     = NPat lit neg noSyntaxExpr placeHolderType
@@ -319,22 +319,24 @@ collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds
 %************************************************************************
 
 \begin{code}
-collectLStmtsBinders :: [LStmt id] -> [Located id]
+collectLStmtsBinders :: OutputableBndr id => [LStmt id] -> [Located id]
 collectLStmtsBinders = concatMap collectLStmtBinders
 
-collectStmtsBinders :: [Stmt id] -> [Located id]
+collectStmtsBinders :: OutputableBndr id => [Stmt id] -> [Located id]
 collectStmtsBinders = concatMap collectStmtBinders
 
-collectLStmtBinders :: LStmt id -> [Located id]
+collectLStmtBinders :: OutputableBndr id => LStmt id -> [Located id]
 collectLStmtBinders = collectStmtBinders . unLoc
 
-collectStmtBinders :: Stmt id -> [Located id]
+collectStmtBinders :: OutputableBndr id => Stmt id -> [Located id]
   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
 collectStmtBinders (BindStmt pat _ _ _) = collectLocatedPatBinders pat
 collectStmtBinders (LetStmt binds)      = collectLocalBinders binds
-collectStmtBinders (ExprStmt _ _ _)   	= []
-collectStmtBinders (RecStmt ss _ _ _ _)	= collectLStmtsBinders ss
-collectStmtBinders other              	= panic "collectStmtBinders"
+collectStmtBinders (ExprStmt _ _ _)     = []
+collectStmtBinders (ParStmt xs)         = collectLStmtsBinders
+                                        $ concatMap fst xs
+collectStmtBinders (RecStmt ss _ _ _ _) = collectLStmtsBinders ss
+collectStmtBinders s                    = pprPanic "collectStmtBinders" (ppr s)
 \end{code}
 
 
@@ -381,8 +383,8 @@ collectl (L l pat) bndrs
     go (PArrPat pats _)    	  = foldr collectl bndrs pats
     go (TuplePat pats _ _)  	  = foldr collectl bndrs pats
 				  
-    go (ConPatIn c ps)   	  = foldr collectl bndrs (hsConArgs ps)
-    go (ConPatOut {pat_args=ps})  = foldr collectl bndrs (hsConArgs ps)
+    go (ConPatIn c ps)   	  = foldr collectl bndrs (hsConPatArgs ps)
+    go (ConPatOut {pat_args=ps})  = foldr collectl bndrs (hsConPatArgs ps)
 	-- See Note [Dictionary binders in ConPatOut]
     go (LitPat _)	      	  = bndrs
     go (NPat _ _ _ _)		  = bndrs
@@ -391,8 +393,6 @@ collectl (L l pat) bndrs
     go (SigPatIn pat _)	 	  = collectl pat bndrs
     go (SigPatOut pat _)	  = collectl pat bndrs
     go (TypePat ty)               = bndrs
-    go (DictPat ids1 ids2)        = map noLoc ids1 ++ map noLoc ids2
-				    ++ bndrs
     go (CoPat _ pat ty)           = collectl (noLoc pat) bndrs
 \end{code}
 
@@ -425,26 +425,6 @@ collect_pat (ParPat  pat)      	acc = collect_lpat pat acc
 collect_pat (ListPat pats _)   	acc = foldr collect_lpat acc pats
 collect_pat (PArrPat pats _)   	acc = foldr collect_lpat acc pats
 collect_pat (TuplePat pats _ _) acc = foldr collect_lpat acc pats
-collect_pat (ConPatIn c ps)     acc = foldr collect_lpat acc (hsConArgs ps)
+collect_pat (ConPatIn c ps)     acc = foldr collect_lpat acc (hsConPatArgs ps)
 collect_pat other	        acc = acc 	-- Literals, vars, wildcard
 \end{code}
-
-%************************************************************************
-%*									*
-%* 	Getting the main binder name of a top declaration
-%*									*
-%************************************************************************
-
-\begin{code}
-
-getMainDeclBinder :: HsDecl name -> Maybe name
-getMainDeclBinder (TyClD d) = Just (tcdName d)
-getMainDeclBinder (ValD d)
-   = case collectAcc d [] of
-        []       -> Nothing   -- see rn003
-        (name:_) -> Just (unLoc name)
-getMainDeclBinder (SigD d) = sigNameNoLoc d
-getMainDeclBinder (ForD (ForeignImport name _ _)) = Just (unLoc name)
-getMainDeclBinder (ForD (ForeignExport name _ _)) = Nothing
-getMainDeclBinder _ = Nothing
-\end{code}