From 5ded005cb6dab79c96e84e67ba6f4f7eddda17d6 Mon Sep 17 00:00:00 2001 From: Erik Oosting Date: Wed, 31 Jan 2024 18:02:42 +0100 Subject: made a proper version of CExp substitution --- haskell/app/Lift.hs | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) (limited to 'haskell') 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 -- cgit 1.4.1-2-gfad0