diff options
| -rw-r--r-- | haskell/app/Lift.hs | 20 |
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 |