X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsUtils.lhs;h=bd1fc21293620ea09e41abafde8f8e06fb73d9a3;hb=5b9a21bf48e3197816981575aeb1ab72544ed2ad;hp=51925f8b9dc64cf98e2b4e9437f7c2f6eaa4df50;hpb=382cae3ae9f2c05fcb043fa9ae403d9ff966cee5;p=ghc-hetmet.git diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 51925f8..bd1fc21 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} @@ -428,23 +430,3 @@ collect_pat (TuplePat pats _ _) acc = foldr collect_lpat acc pats collect_pat (ConPatIn c ps) acc = foldr collect_lpat acc (hsConArgs 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}