X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=NormalizeTools.hs;h=f016cfa9fc34684604a8efe487ac8f254297d5c3;hb=969b7ddd86b69d2fc61b101961affcca0364749c;hp=14e3faca07543f497da404cd8e5cb317c7e6d099;hpb=cccb87b1cdff39f45148b525bd8e426b6bf667ad;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/NormalizeTools.hs b/NormalizeTools.hs index 14e3fac..f016cfa 100644 --- a/NormalizeTools.hs +++ b/NormalizeTools.hs @@ -119,6 +119,11 @@ subeverywhere trans (App a b) = do b' <- trans b return $ App a' b' +subeverywhere trans (Let (NonRec b bexpr) expr) = do + bexpr' <- trans bexpr + expr' <- trans expr + return $ Let (NonRec b bexpr') expr' + subeverywhere trans (Let (Rec binds) expr) = do expr' <- trans expr binds' <- mapM transbind binds @@ -142,26 +147,33 @@ subeverywhere trans (Case scrut b t alts) = do transalt (con, binders, expr) = do expr' <- trans expr return (con, binders, expr') - -subeverywhere trans expr = return expr +subeverywhere trans (Var x) = return $ Var x +subeverywhere trans (Lit x) = return $ Lit x +subeverywhere trans (Type x) = return $ Type x + +subeverywhere trans (Cast expr ty) = do + expr' <- trans expr + return $ Cast expr' ty + +subeverywhere trans expr = error $ "NormalizeTools.subeverywhere Unsupported expression: " ++ show expr --- Apply the given transformation to all expressions, except for every first --- argument of an application. -notapplied :: (String, Transform) -> Transform -notapplied trans = applyboth (subnotapplied trans) trans +-- 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 the first argument of an --- applicfirst argument of an application -subnotapplied :: (String, Transform) -> Transform -subnotapplied trans (App a b) = do - a' <- subnotapplied trans a - b' <- notapplied trans b +-- (but not the expression itself), except for direct arguments of an +-- application +subnotappargs :: (String, Transform) -> Transform +subnotappargs trans (App a b) = do + a' <- subnotappargs trans a + b' <- subnotappargs trans b return $ App a' b' -- Let subeverywhere handle all other expressions -subnotapplied trans expr = subeverywhere (notapplied trans) expr +subnotappargs trans expr = subeverywhere (notappargs trans) expr -- Runs each of the transforms repeatedly inside the State monad. dotransforms :: [Transform] -> CoreExpr -> TransformSession CoreExpr