diff --git a/haskell/app/Lift.hs b/haskell/app/Lift.hs
index 64fa0f6..b503665 100644
--- a/haskell/app/Lift.hs
+++ b/haskell/app/Lift.hs
@@ -21,6 +21,22 @@ factorial =
)
)
+three :: CExp
+three =
+ ( Let
+ "n"
+ (Atom (Number 1))
+ ( Let
+ "n"
+ (Atom (AAdd (Ident "n") (Number 1)))
+ ( Let
+ "n"
+ (Atom (AAdd (Ident "n") (Number 1)))
+ (FC (Atom (Ident "n")))
+ )
+ )
+ )
+
liftArgs :: AExp -> AExp
liftArgs lam@(Lam args body) = Lam (args ++ cata findVarsAExp lam) body
liftArgs rest = rest
@@ -97,7 +113,7 @@ subVarsCExp (env, queue, LetF name fc rest) =
let
(newName, oldNames) =
foldr
- (\m (n, ns) -> if n == m then (n ++ "_", n:ns) else (n, ns)) -- repeatedly replace variables in the function call
+ (\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]
@@ -110,15 +126,24 @@ subVarsCExp (env, queue, IfF cond thenPart elsePart) =
(env, queue, elsePart)
subVarsCExp (env, queue, FCF fc) = FCF $ foldr replaceVarsFC fc queue
-
+unsafeCotransverse ::
+ (Corecursive t, Recursive a, Functor f) =>
+ (f (Base a a) -> Base t (f a)) ->
+ f a ->
+ t
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' :: ([String], CExpF CExp) -> CExpF ([String], CExp)
+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
+
+substitute :: CExp -> CExp
+substitute = unsafeCotransverse subVarsCExp' . ([],)
|
