diff options
| author | bringert <bringert@cs.chalmers.se> | 2005-11-28 23:02:04 +0000 |
|---|---|---|
| committer | bringert <bringert@cs.chalmers.se> | 2005-11-28 23:02:04 +0000 |
| commit | 967891cfd7eec5e90185b1b8b5c5819885a032ea (patch) | |
| tree | ed332bebdb7eb4ead8b6a6c058af4a6a549b670c | |
| parent | 884055566e82c1ab9829c75f674838d272ff099f (diff) | |
Transfer compiler: extended variable removal to variables bound in case expressions.
| -rw-r--r-- | src/Transfer/SyntaxToCore.hs | 12 | ||||
| -rw-r--r-- | transfer/examples/layout.tr | 4 |
2 files changed, 13 insertions, 3 deletions
diff --git a/src/Transfer/SyntaxToCore.hs b/src/Transfer/SyntaxToCore.hs index 308a8a582..ff11b35b6 100644 --- a/src/Transfer/SyntaxToCore.hs +++ b/src/Transfer/SyntaxToCore.hs @@ -32,8 +32,8 @@ declsToCore_ = deriveDecls >>> optimize optimize :: [Decl] -> C [Decl] -optimize = removeUselessMatch - >>> removeUnusedVariables +optimize = removeUnusedVariables + >>> removeUselessMatch >>> betaReduce newState :: CState @@ -237,7 +237,6 @@ removeUselessMatch = return . map f -- * Change varibles which are not used to wildcards. -- --- FIXME: extend to variables bound in case expressions. removeUnusedVariables :: [Decl] -> C [Decl] removeUnusedVariables = return . map f where @@ -245,7 +244,14 @@ removeUnusedVariables = return . map f f x = case x of EAbs (VVar id) e | not (id `isFreeIn` e) -> EAbs VWild (f e) EPi (VVar id) t e | not (id `isFreeIn` e) -> EPi VWild (f t) (f e) + Case p e -> Case (g (freeVars e) p) (f e) _ -> composOp f x + -- replace pattern variables not in the given set with wildcards + g :: Set Ident -> Tree a -> Tree a + g keep x = case x of + PVar id | not (id `Set.member` keep) -> PWild + _ -> composOp (g keep) x + -- -- * Remove simple syntactic sugar. -- diff --git a/transfer/examples/layout.tr b/transfer/examples/layout.tr index 15f0aac3a..46adf5631 100644 --- a/transfer/examples/layout.tr +++ b/transfer/examples/layout.tr @@ -3,3 +3,7 @@ x = let x : T = y in case y of f -> q _ -> a + +f = \x -> case x of + { r = _ } -> 0 + |