X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=NormalizeTools.hs;h=8e57ba8f2ec2446301ebcf22ec83e03f577470b7;hb=019e55a763768d778d0e62b4dc5e49f3c7e06a0f;hp=14e3faca07543f497da404cd8e5cb317c7e6d099;hpb=daba7a870fe4808faf6e54b26572a707237ec3c2;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/NormalizeTools.hs b/NormalizeTools.hs index 14e3fac..8e57ba8 100644 --- a/NormalizeTools.hs +++ b/NormalizeTools.hs @@ -142,26 +142,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 --- 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 +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 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