[add traverseHsExp_, make TypeSig collection use generic traversal routines
John Meacham <john@repetae.net>**20060408004012] hunk ./FrontEnd/Syn/Traverse.hs 8
+
+traverseHsExp_ :: MonadSetSrcLoc m => (HsExp -> m ()) -> HsExp -> m ()
+traverseHsExp_ fn e = traverseHsExp (\e -> fn e >> return e) e >> return ()
+
hunk ./FrontEnd/TypeSigs.hs 4
-
hunk ./FrontEnd/TypeSigs.hs 5
-
hunk ./FrontEnd/TypeSigs.hs 6
-
-        Primary Authors:        Bernie Pope
-
+        Primary Authors:        Bernie Pope, John Meacham
hunk ./FrontEnd/TypeSigs.hs 17
+import Control.Monad.Writer
+import qualified Data.Map as Map
hunk ./FrontEnd/TypeSigs.hs 21
-import Name.Name
+import FrontEnd.Syn.Traverse
hunk ./FrontEnd/TypeSigs.hs 23
-
+import FrontEnd.SrcLoc
hunk ./FrontEnd/TypeSigs.hs 25
-import qualified Data.Map as Map
+import Name.Name
+
+newtype SC a = SC (Writer [HsDecl] a)
+    deriving(Monad)
+
+fromSC :: SC () -> [HsDecl]
+fromSC (SC m) = execWriter m
+
+addSigs :: [HsDecl] -> SC ()
+addSigs ds = SC $ tell ds
+
+instance MonadSrcLoc SC where
+instance MonadSetSrcLoc SC where
+    withSrcLoc _ a = a
hunk ./FrontEnd/TypeSigs.hs 40
---------------------------------------------------------------------------------
hunk ./FrontEnd/TypeSigs.hs 50
-
hunk ./FrontEnd/TypeSigs.hs 51
-
hunk ./FrontEnd/TypeSigs.hs 52
-
hunk ./FrontEnd/TypeSigs.hs 53
-
hunk ./FrontEnd/TypeSigs.hs 57
-
hunk ./FrontEnd/TypeSigs.hs 60
-
-collectSigsFromDecls (_:ds)
-   = collectSigsFromDecls ds
+collectSigsFromDecls (_:ds) = collectSigsFromDecls ds
hunk ./FrontEnd/TypeSigs.hs 63
-
hunk ./FrontEnd/TypeSigs.hs 68
-
-collectSigsFromRhs (HsUnGuardedRhs e)
-   = collectSigsFromExp e
-
-collectSigsFromRhs (HsGuardedRhss rhss)
-   = concatMap collectSigsFromGuardedRhs rhss
+collectSigsFromRhs (HsUnGuardedRhs e) = collectSigsFromExp e
+collectSigsFromRhs (HsGuardedRhss rhss) = concatMap collectSigsFromGuardedRhs rhss
hunk ./FrontEnd/TypeSigs.hs 72
-
hunk ./FrontEnd/TypeSigs.hs 76
-collectSigsFromExp :: (HsExp) -> [(HsDecl)]
-
-
-collectSigsFromExp (HsVar {}) = []
-
-collectSigsFromExp (HsCon {}) = []
-
-collectSigsFromExp (HsLit {}) = []
-
-collectSigsFromExp (HsInfixApp e1 e2 e3)
-   = collectSigsFromExp e1 ++
-     collectSigsFromExp e2 ++
-     collectSigsFromExp e3
-
-collectSigsFromExp (HsApp e1 e2)
-   = collectSigsFromExp e1 ++
-     collectSigsFromExp e2
-
-collectSigsFromExp (HsNegApp e)
-   = collectSigsFromExp e
-
-collectSigsFromExp (HsLambda _sloc _ e)
-   = collectSigsFromExp e
+collectSigsFromExp :: HsExp -> [HsDecl]
+collectSigsFromExp e = fromSC (collectExp e)
hunk ./FrontEnd/TypeSigs.hs 79
-collectSigsFromExp (HsLet decls e)
-   = collectSigsFromDecls decls ++
-     collectSigsFromExp e
-
-collectSigsFromExp (HsIf e1 e2 e3)
-   = collectSigsFromExp e1 ++
-     collectSigsFromExp e2 ++
-     collectSigsFromExp e3
-
-collectSigsFromExp (HsCase e alts)
-   = collectSigsFromExp e ++
-     concatMap collectSigsFromAlt alts
-
-collectSigsFromExp (HsDo stmts)
-   = concatMap collectSigsFromStmt stmts
-
-collectSigsFromExp (HsTuple exps)
-   = concatMap collectSigsFromExp exps
-
-collectSigsFromExp (HsList exps)
-   = concatMap collectSigsFromExp exps
-
-collectSigsFromExp (HsParen e)
-   = collectSigsFromExp e
-
-collectSigsFromExp (HsLeftSection e1 e2)
-   = collectSigsFromExp e1 ++
-     collectSigsFromExp e2
-
-collectSigsFromExp (HsRightSection e1 e2)
-   = collectSigsFromExp e1 ++
-     collectSigsFromExp e2
-
-collectSigsFromExp (HsRecConstr _ fs) = concat [ collectSigsFromExp e | HsFieldUpdate _ e <- fs ]
---   = error "collectSigsFromExp (HsRecConstr _ _) not implemented yet"
-
-collectSigsFromExp (HsRecUpdate e fs) =  concat $ collectSigsFromExp e:[ collectSigsFromExp e | HsFieldUpdate _ e <- fs ]
---   = error "collectSigsFromExp (HsRecUpdate _ _) not implemented yet"
-
-collectSigsFromExp (HsEnumFrom e)
-   = collectSigsFromExp e
-
-collectSigsFromExp (HsEnumFromTo e1 e2)
-   = collectSigsFromExp e1 ++
-     collectSigsFromExp e2
-
-collectSigsFromExp (HsEnumFromThen e1 e2)
-   = collectSigsFromExp e1 ++
-     collectSigsFromExp e2
-
-collectSigsFromExp (HsEnumFromThenTo e1 e2 e3)
-   = collectSigsFromExp e1 ++
-     collectSigsFromExp e2 ++
-     collectSigsFromExp e3
-
-collectSigsFromExp (HsListComp e stmts)
-   = collectSigsFromExp e ++
-     concatMap collectSigsFromStmt stmts
-
-collectSigsFromExp (HsExpTypeSig _ e _)
-   = collectSigsFromExp e
-
-collectSigsFromExp (HsAsPat _ e)
-   = collectSigsFromExp e
-
-collectSigsFromExp (HsWildCard _) = []
-
-collectSigsFromExp (HsIrrPat e)
-   = collectSigsFromExp e
+collectExp :: HsExp -> SC ()
+collectExp (HsLet decls e) = do
+    addSigs (collectSigsFromDecls decls)
+    collectExp e
+collectExp (HsCase e alts) = do
+    collectExp e
+    addSigs $ concatMap collectSigsFromAlt alts
+collectExp (HsDo stmts) = addSigs $ concatMap collectSigsFromStmt stmts
+collectExp (HsListComp e stmts) = do
+    collectExp e
+    addSigs $ concatMap collectSigsFromStmt stmts
+collectExp e =  traverseHsExp_ collectExp e
hunk ./FrontEnd/TypeSigs.hs 93
-
hunk ./FrontEnd/TypeSigs.hs 96
-
hunk ./FrontEnd/TypeSigs.hs 101
-
hunk ./FrontEnd/TypeSigs.hs 106
-
-collectSigsFromStmt (HsGenerator _ _ e)
-   = collectSigsFromExp e
-
-collectSigsFromStmt (HsQualifier e)
-   = collectSigsFromExp e
-
-collectSigsFromStmt (HsLetStmt decls)
-   = collectSigsFromDecls decls
+collectSigsFromStmt (HsGenerator _ _ e) = collectSigsFromExp e
+collectSigsFromStmt (HsQualifier e) = collectSigsFromExp e
+collectSigsFromStmt (HsLetStmt decls) = collectSigsFromDecls decls