summary refs log tree commit diff
path: root/haskell/app
diff options
context:
space:
mode:
authorErik Oosting2024-01-31 18:02:42 +0100
committerErik Oosting2024-01-31 18:02:42 +0100
commit5ded005cb6dab79c96e84e67ba6f4f7eddda17d6 (patch)
tree6f4c8daec6a028e66086d49783591e609da85a1a /haskell/app
parent07c38414dc9816b56d27a3d86b856ffe23caff11 (diff)
made a proper version of CExp substitution
Diffstat (limited to 'haskell/app')
-rw-r--r--haskell/app/Lift.hs20
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