From 3632c7eecf1178bb96e3c6d2b3d9ea9c05b9f79e Mon Sep 17 00:00:00 2001
From: bringert <bringert@cs.chalmers.se>
Date: Mon, 28 Nov 2005 23:02:04 +0000
Subject: [PATCH] Transfer compiler: extended variable removal to variables
 bound in case expressions.

---
 src/Transfer/SyntaxToCore.hs | 12 +++++++++---
 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
+