X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=NormalizeTools.hs;h=923b54567767e68d7ccc68bfda2c0db9c70114f2;hb=f20ebcfe03b2f3493be450761c8b3a26c2e0cd30;hp=82da086a260f07c8b7fb23967a2c0322e4781a7e;hpb=7a315b7e40f3cb5e4e705c87953a89b2e858b325;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/NormalizeTools.hs b/NormalizeTools.hs index 82da086..923b545 100644 --- a/NormalizeTools.hs +++ b/NormalizeTools.hs @@ -63,11 +63,16 @@ applyboth first (name, second) expr = do expr' <- first expr -- Apply the second (expr'', changed) <- Writer.listen $ second expr' - if Monoid.getAny changed + if Monoid.getAny $ + -- trace ("Trying to apply transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $ + changed then - trace ("Transform " ++ name ++ " changed from:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n" ++ "\nTo:\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n" ++ "Type: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr'') ++ "\n" ) $ - applyboth first (name, second) expr'' +-- trace ("Applying transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $ + -- trace ("Result of applying " ++ name ++ ":\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n" ++ "Type: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr'') ++ "\n" ) $ + applyboth first (name, second) $ + expr'' else + -- trace ("No changes") $ return expr'' -- Apply the given transformation to all direct subexpressions (only), not the @@ -163,7 +168,7 @@ mkUnique = Trans.lift $ do -- given expression. substitute :: [(CoreBndr, CoreExpr)] -> CoreExpr -> CoreExpr substitute replace expr = CoreSubst.substExpr subs expr - where subs = foldl (\s (b, e) -> CoreSubst.extendIdSubst s b e) CoreSubst.emptySubst replace + where subs = foldl (\s (b, e) -> CoreSubst.extendSubst s b e) CoreSubst.emptySubst replace -- Run a given TransformSession. Used mostly to setup the right calls and -- an initial state.