From 18ea7b6804e09b1ae604b7fb9eadd542677f172d Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Sat, 23 May 2020 11:41:50 +0200
Subject: Only rewrite _free_ variables in rewall

---
 src/Haskell/AST.hs | 19 +++++++++++++++++++
 src/Main.hs        | 10 ++++++----
 2 files changed, 25 insertions(+), 4 deletions(-)

diff --git a/src/Haskell/AST.hs b/src/Haskell/AST.hs
index 072fd97..2238b6d 100644
--- a/src/Haskell/AST.hs
+++ b/src/Haskell/AST.hs
@@ -1,6 +1,7 @@
 module Haskell.AST where
 
 import Data.List
+import qualified Data.Set as Set
 import Pretty
 
 
@@ -134,3 +135,21 @@ instance AllRefs Expr where
 
 instance AllRefs Inst where
     allRefs (Inst _ _ ds) = nub $ concatMap allRefs ds
+
+
+boundVars :: Pat -> Set.Set Name
+boundVars PatAny = mempty
+boundVars (PatVar n) = Set.singleton n
+boundVars (PatCon _ ps) = Set.unions (map boundVars ps)
+boundVars (PatTup ps) = Set.unions (map boundVars ps)
+
+freeVariables :: Expr -> Set.Set Name
+freeVariables (App e es) = freeVariables e <> Set.unions (map freeVariables es)
+freeVariables (Ref n) = Set.singleton n
+freeVariables (Con _) = mempty
+freeVariables (Num _) = mempty
+freeVariables (Tup es) = Set.unions (map freeVariables es)
+freeVariables (Lam ns e) = freeVariables e Set.\\ Set.fromList ns
+freeVariables (Case e pairs) =
+    freeVariables e <> Set.unions [freeVariables e' Set.\\ boundVars p
+                                  | (p, e') <- pairs]
diff --git a/src/Main.hs b/src/Main.hs
index a6d80b3..f406f1b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -3,6 +3,11 @@ module Main where
 import Control.Monad
 import Data.List
 import Data.Maybe
+import qualified Data.Set as Set
+import System.Environment
+import System.Exit
+import System.IO
+
 import Haskell.AST
 import Haskell.Env
 import Haskell.Env.Cmd
@@ -10,9 +15,6 @@ import Haskell.Env.Context
 import Haskell.Rewrite
 import Haskell.Parser
 import Pretty
-import System.Environment
-import System.Exit
-import System.IO
 import Util
 
 
@@ -115,7 +117,7 @@ applyUserCmd appstate = \case
             Just focus ->
                 let nextStep ctx done =
                         let orig = fromRight (get (topEnv ctx) focus)
-                        in case filter (isRight . get (topEnv ctx)) $ allRefs orig \\ done of
+                        in case filter (isRight . get (topEnv ctx)) $ Set.toList (freeVariables orig) \\ done of
                             [] -> Right ctx
                             (name:_) -> case apply ctx (Action (CRewrite name) focus) of
                                 Left err   -> Left ("Error rewriting '" ++ name ++ "': " ++ err)
-- 
cgit v1.2.3