X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize%2FNormalizeTools.hs;h=0402d9327c9463055ec7ff8bdd8c8dbcadcfe008;hb=bcaa7ec85a9025a95c431f550bb5ea0cf5af5375;hp=b1ca36900cd5a37220052ac2687e685ce6141814;hpb=3deb1d21f696f8495cd99345c9677210e2a2fc79;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" index b1ca369..0402d93 100644 --- "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" +++ "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" @@ -57,27 +57,27 @@ applyboth first (name, second) context expr = do -- expression itself. subeverywhere :: Transform -> Transform subeverywhere trans c (App a b) = do - a' <- trans (Other:c) a - b' <- trans (Other:c) b + a' <- trans (AppFirst:c) a + b' <- trans (AppSecond:c) b return $ App a' b' subeverywhere trans c (Let (NonRec b bexpr) expr) = do - bexpr' <- trans (Other:c) bexpr - expr' <- trans (Other:c) expr + bexpr' <- trans (LetBinding:c) bexpr + expr' <- trans (LetBody:c) expr return $ Let (NonRec b bexpr') expr' subeverywhere trans c (Let (Rec binds) expr) = do - expr' <- trans (Other:c) expr + expr' <- trans (LetBody:c) expr binds' <- mapM transbind binds return $ Let (Rec binds') expr' where transbind :: (CoreBndr, CoreExpr) -> TransformMonad (CoreBndr, CoreExpr) transbind (b, e) = do - e' <- trans (Other:c) e + e' <- trans (LetBinding:c) e return (b, e') subeverywhere trans c (Lam x expr) = do - expr' <- trans (Other:c) expr + expr' <- trans (LambdaBody:c) expr return $ Lam x expr' subeverywhere trans c (Case scrut b t alts) = do @@ -100,23 +100,6 @@ subeverywhere trans c (Cast expr ty) = do subeverywhere trans c expr = error $ "\nNormalizeTools.subeverywhere: Unsupported expression: " ++ show expr --- Apply the given transformation to all expressions, except for direct --- arguments of an application -notappargs :: (String, Transform) -> Transform -notappargs trans = applyboth (subnotappargs trans) trans - --- Apply the given transformation to all (direct and indirect) subexpressions --- (but not the expression itself), except for direct arguments of an --- application -subnotappargs :: (String, Transform) -> Transform -subnotappargs trans c (App a b) = do - a' <- subnotappargs trans (Other:c) a - b' <- subnotappargs trans (Other:c) b - return $ App a' b' - --- Let subeverywhere handle all other expressions -subnotappargs trans c expr = subeverywhere (notappargs trans) c expr - -- Runs each of the transforms repeatedly inside the State monad. dotransforms :: [Transform] -> CoreExpr -> TranslatorSession CoreExpr dotransforms transs expr = do