made a proper version of CExp substitution

1 files changed, 17 insertions, 3 deletions

diff --git a/haskell/app/Lift.hs b/haskell/app/Lift.hs
index bf2dcb1..64fa0f6 100644
--- a/haskell/app/Lift.hs
+++ b/haskell/app/Lift.hs
@@ -95,11 +95,12 @@ subVarsAExp (env, rest) = fmap (env,) rest
 subVarsCExp :: ([String], [String], CExpF a) -> CExpF ([String], [String], a)
 subVarsCExp (env, queue, LetF name fc rest) =
     let
-        (newName, newFC) =
+        (newName, oldNames) =
             foldr
-                (\m (n, f) -> if n == m then (n ++ "_", replaceVarsFC n f) else (n, f)) -- repeatedly replace variables in the function call
-                (name, fc)
+                (\m (n, ns) -> if n == m then (n ++ "_", n:ns) else (n, ns)) -- repeatedly replace variables in the function call
+                (name, [])
                 queue -- make sure to do oldest first!
+        newFC = foldr replaceVarsFC fc $ oldNames \\ [newName]
      in
         LetF newName newFC (if name `elem` env then (env, newName : queue, rest) else (name : env, name : queue, rest))
 subVarsCExp (env, queue, IfF cond thenPart elsePart) =
@@ -108,3 +109,16 @@ subVarsCExp (env, queue, IfF cond thenPart elsePart) =
         (env, queue, thenPart)
         (env, queue, elsePart)
 subVarsCExp (env, queue, FCF fc) = FCF $ foldr replaceVarsFC fc queue
+
+
+unsafeCotransverse n = ana (n . fmap project)
+
+subVarsCExp' (env, LetF name fc body) 
+            | name `elem` env =
+              let
+                newName = name ++ "_"
+                newFC = replaceVarsFC newName fc
+                newBody = cata replaceVarsCExp body name
+              in LetF newName newFC (newName : env, newBody)
+            | otherwise = LetF name fc (name : env, body)
+subVarsCExp' (env, rest) = fmap (env,) rest