[use generic HsExp traversal routine in TypeSyns
John Meacham <john@repetae.net>**20060408005044] hunk ./FrontEnd/TypeSyns.hs 13
+import FrontEnd.Syn.Traverse
hunk ./FrontEnd/TypeSyns.hs 33
-setSrcLoc e = modify (\s -> s { srcLoc = e `mappend` srcLoc s})
+instance MonadSrcLoc ScopeSM where
+    getSrcLoc = gets srcLoc
+instance MonadSetSrcLoc ScopeSM where
+    withSrcLoc sl a = modify (\s -> s { srcLoc = sl `mappend` srcLoc s}) >> a
hunk ./FrontEnd/TypeSyns.hs 95
-renameHsDecl (HsPatBind srcLoc hsPat hsRhs {-where-} hsDecls) subTable = do
-    setSrcLoc srcLoc
+renameHsDecl (HsPatBind srcLoc hsPat hsRhs {-where-} hsDecls) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 102
-renameHsDecl (HsForeignDecl a b c d n t) subTable = do
-    setSrcLoc a
+renameHsDecl (HsForeignDecl a b c d n t) subTable = withSrcLoc a $ do
hunk ./FrontEnd/TypeSyns.hs 111
-renameHsDecl (HsTypeSig srcLoc hsNames hsQualType) subTable = do
-    setSrcLoc srcLoc
+renameHsDecl (HsTypeSig srcLoc hsNames hsQualType) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 123
-renameHsDecl (HsTypeDecl srcLoc name hsNames t) subTable = do
-    setSrcLoc srcLoc
+renameHsDecl (HsTypeDecl srcLoc name hsNames t) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 128
-renameHsDecl (HsNewTypeDecl srcLoc hsContext hsName hsNames1 hsConDecl hsNames2) subTable = do
-    setSrcLoc srcLoc
+renameHsDecl (HsNewTypeDecl srcLoc hsContext hsName hsNames1 hsConDecl hsNames2) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 134
-renameHsDecl (HsClassDecl srcLoc hsQualType hsDecls) subTable = do
-    setSrcLoc srcLoc
+renameHsDecl (HsClassDecl srcLoc hsQualType hsDecls) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 138
-renameHsDecl (HsInstDecl srcLoc hsQualType hsDecls) subTable = do
-    setSrcLoc srcLoc
+renameHsDecl (HsInstDecl srcLoc hsQualType hsDecls) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 142
-renameHsDecl (HsInfixDecl srcLoc assoc int hsNames) subTable = do
-    setSrcLoc srcLoc
+renameHsDecl (HsInfixDecl srcLoc assoc int hsNames) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 145
-renameHsDecl prules@HsPragmaRules { hsDeclSrcLoc = srcLoc, hsDeclFreeVars = fvs, hsDeclLeftExpr = e1, hsDeclRightExpr = e2 } subTable = do
-    setSrcLoc srcLoc
+renameHsDecl prules@HsPragmaRules { hsDeclSrcLoc = srcLoc, hsDeclFreeVars = fvs, hsDeclLeftExpr = e1, hsDeclRightExpr = e2 } subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 150
-renameHsDecl prules@HsPragmaSpecialize { hsDeclSrcLoc = srcLoc, hsDeclName = n, hsDeclType = t } subTable = do
-    setSrcLoc srcLoc
+renameHsDecl prules@HsPragmaSpecialize { hsDeclSrcLoc = srcLoc, hsDeclName = n, hsDeclType = t } subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 153
-
hunk ./FrontEnd/TypeSyns.hs 177
-renameHsConDecl cd@(HsConDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclConArg = hsBangTypes }) subTable = do
-    setSrcLoc srcLoc
+renameHsConDecl cd@(HsConDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclConArg = hsBangTypes }) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 181
-renameHsConDecl cd@HsRecDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclRecArg = stuff} subTable = do
-    setSrcLoc srcLoc
+renameHsConDecl cd@HsRecDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclRecArg = stuff} subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 237
-renameHsMatch (HsMatch srcLoc hsName hsPats hsRhs {-where-} hsDecls) subTable = do
-    setSrcLoc srcLoc
+renameHsMatch (HsMatch srcLoc hsName hsPats hsRhs {-where-} hsDecls) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 327
-renameHsExp (HsAsPat n e) s = renameHsExp e s >>= \e -> return (HsAsPat n e)
-renameHsExp (HsVar hsName) subTable = do
-    hsName' <- renameHsName hsName subTable
-    return (HsVar hsName' )
-renameHsExp (HsCon hsName) subTable = do
-    hsName' <- renameHsName hsName subTable
-    return (HsCon hsName')
-renameHsExp i@(HsLit _) _ = do
-    return $ i
-renameHsExp (HsInfixApp hsExp1 hsExp2 hsExp3) subTable = do
-    hsExp1' <- renameHsExp hsExp1 subTable
-    hsExp2' <- renameHsExp hsExp2 subTable
-    hsExp3' <- renameHsExp hsExp3 subTable
-    return (HsInfixApp hsExp1' hsExp2' hsExp3')
-renameHsExp (HsApp hsExp1 hsExp2) subTable = do
-    hsExp1' <- renameHsExp hsExp1 subTable
-    hsExp2' <- renameHsExp hsExp2 subTable
-    return (HsApp hsExp1' hsExp2')
-renameHsExp (HsNegApp hsExp) subTable = do
-    hsExp' <- renameHsExp hsExp subTable
-    return (HsNegApp hsExp')
-renameHsExp (HsLambda srcLoc hsPats hsExp) subTable = do
-    setSrcLoc srcLoc
+renameHsExp (HsLambda srcLoc hsPats hsExp) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 337
-renameHsExp (HsIf hsExp1 hsExp2 hsExp3) subTable = do
-    hsExp1' <- renameHsExp hsExp1 subTable
-    hsExp2' <- renameHsExp hsExp2 subTable
-    hsExp3' <- renameHsExp hsExp3 subTable
-    return (HsIf hsExp1' hsExp2' hsExp3')
hunk ./FrontEnd/TypeSyns.hs 344
-    --(hsStmts',_) <- renameHsStmts hsStmts subTable
-    --return (doToExp hsStmts')
-renameHsExp (HsTuple hsExps) subTable = do
-    hsExps' <- renameHsExps hsExps subTable
-    return (HsTuple hsExps')
-renameHsExp (HsList hsExps) subTable = do
-    hsExps' <- renameHsExps hsExps subTable
-    return (HsList hsExps')
-renameHsExp (HsParen hsExp) subTable = do
-    hsExp' <- renameHsExp hsExp subTable
-    return (HsParen hsExp')
-renameHsExp (HsLeftSection hsExp1 hsExp2) subTable = do
-    hsExp1' <- renameHsExp hsExp1 subTable
-    hsExp2' <- renameHsExp hsExp2 subTable
-    return (HsLeftSection hsExp1' hsExp2')
-renameHsExp (HsRightSection hsExp1 hsExp2) subTable = do
-    hsExp1' <- renameHsExp hsExp1 subTable
-    hsExp2' <- renameHsExp hsExp2 subTable
-    return (HsRightSection hsExp1' hsExp2')
--- XXX I'm not 100% sure that this bit works.
hunk ./FrontEnd/TypeSyns.hs 352
-renameHsExp (HsEnumFrom hsExp) subTable = do
-    let x = desugarEnum "enumFrom" [hsExp]
-    hsExp' <- renameHsExp x subTable
-    --return (HsEnumFrom hsExp')
-    return ( hsExp')
-renameHsExp (HsEnumFromTo hsExp1 hsExp2) subTable = do
-    let x = desugarEnum "enumFromTo" [hsExp1, hsExp2]
-    hsExp' <- renameHsExp x subTable
-    return ( hsExp')
-    --hsExp' <- renameHsExp x subTable
-    --hsExp1' <- renameHsExp hsExp1 subTable
-    --hsExp2' <- renameHsExp hsExp2 subTable
-    --return (HsEnumFromTo hsExp1' hsExp2')
-renameHsExp (HsEnumFromThen hsExp1 hsExp2) subTable = do
-    let x = desugarEnum "enumFromThen" [hsExp1, hsExp2]
-    hsExp' <- renameHsExp x subTable
-    return ( hsExp')
-    --hsExp1' <- renameHsExp hsExp1 subTable
-    --hsExp2' <- renameHsExp hsExp2 subTable
-    --return (HsEnumFromThen hsExp1' hsExp2')
-renameHsExp (HsEnumFromThenTo hsExp1 hsExp2 hsExp3) subTable = do
-    let x = desugarEnum "enumFromThenTo" [hsExp1, hsExp2, hsExp3]
-    hsExp' <- renameHsExp x subTable
-    return ( hsExp')
-    --hsExp1' <- renameHsExp hsExp1 subTable
-    --hsExp2' <- renameHsExp hsExp2 subTable
-    --hsExp3' <- renameHsExp hsExp3 subTable
-    --return (HsEnumFromThenTo hsExp1' hsExp2' hsExp3')
hunk ./FrontEnd/TypeSyns.hs 361
-renameHsExp (HsAsPat hsName hsExp) subTable = do
-    hsName' <- renameHsName hsName subTable
-    hsExp' <- renameHsExp hsExp subTable
-    return (HsAsPat hsName' hsExp')
-renameHsExp (HsWildCard x) _ = do return (HsWildCard x)
-renameHsExp (HsIrrPat hsExp) subTable = do
-    hsExp' <- renameHsExp hsExp subTable
-    return (HsIrrPat hsExp')
-
-desugarEnum s as = foldl HsApp (HsVar (UnQual $ HsIdent s)) as
+renameHsExp e subTable = traverseHsExp (flip renameHsExp subTable) e
hunk ./FrontEnd/TypeSyns.hs 369
-renameHsAlt (HsAlt srcLoc hsPat hsGuardedAlts {-where-} hsDecls) subTable = do
-    setSrcLoc srcLoc
+renameHsAlt (HsAlt srcLoc hsPat hsGuardedAlts {-where-} hsDecls) subTable = withSrcLoc srcLoc $ do
hunk ./FrontEnd/TypeSyns.hs 389
-renameHsGuardedRhs (HsGuardedRhs srcLoc hsExp1 hsExp2) subTable = do
-    setSrcLoc srcLoc
+renameHsGuardedRhs (HsGuardedRhs srcLoc hsExp1 hsExp2) subTable = withSrcLoc srcLoc $ do