From d32b6479b052557d54d2baaeffa1d43e0da3f5e6 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 24 Jan 2024 12:57:56 +0100
Subject: [PATCH 1/6] recursors

---
 .../Compiler/Asm/Translation/FromTree.hs      |   2 +-
 .../Compiler/Core/Extra/Recursors/Classes.hs  |  41 +++
 .../Core/Extra/Recursors/Collector.hs         |  12 +-
 .../Compiler/Core/Extra/Recursors/Map.hs      |  47 ----
 .../Core/Extra/Recursors/Map/Named.hs         |   1 +
 .../Compiler/Core/Extra/Recursors/Recur.hs    |  19 ++
 src/Juvix/Compiler/Tree/Extra/Base.hs         | 247 ++++++++++++++++++
 .../Compiler/Tree/Extra/Recursors/Base.hs     |  12 +
 .../Compiler/Tree/Extra/Recursors/Map.hs      |  65 +++++
 .../Tree/Extra/Recursors/Map/Named.hs         | 141 ++++++++++
 .../Compiler/Tree/Extra/Recursors/Recur.hs    |  29 ++
 src/Juvix/Compiler/Tree/Language.hs           |   9 +-
 src/Juvix/Compiler/Tree/Pretty/Base.hs        |   2 +-
 .../Compiler/Tree/Translation/FromAsm.hs      |   4 +-
 .../Compiler/Tree/Translation/FromCore.hs     |   3 +-
 .../Compiler/Tree/Translation/FromSource.hs   |   4 +-
 16 files changed, 577 insertions(+), 61 deletions(-)
 create mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs
 create mode 100644 src/Juvix/Compiler/Tree/Extra/Recursors/Base.hs
 create mode 100644 src/Juvix/Compiler/Tree/Extra/Recursors/Map.hs
 create mode 100644 src/Juvix/Compiler/Tree/Extra/Recursors/Map/Named.hs
 create mode 100644 src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs

diff --git a/src/Juvix/Compiler/Asm/Translation/FromTree.hs b/src/Juvix/Compiler/Asm/Translation/FromTree.hs
index 63670ddfd8..7b63a4ee7a 100644
--- a/src/Juvix/Compiler/Asm/Translation/FromTree.hs
+++ b/src/Juvix/Compiler/Asm/Translation/FromTree.hs
@@ -212,7 +212,7 @@ genCode fi =
         ( Save
             CmdSave
               { _cmdSaveInfo = emptyInfo,
-                _cmdSaveName = _nodeSaveName,
+                _cmdSaveName = _nodeSaveTempVarInfo ^. Tree.tempVarInfoName,
                 _cmdSaveIsTail = isTail,
                 _cmdSaveCode = DL.toList $ go isTail _nodeSaveBody
               }
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs
new file mode 100644
index 0000000000..678ee41963
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Juvix.Compiler.Core.Extra.Recursors.Classes where
+
+import Data.Functor.Identity
+import Data.Kind qualified as GHC
+import Juvix.Compiler.Core.Extra.Base
+import Juvix.Compiler.Core.Language.Base
+
+type OverIdentity' :: GHC.Type -> GHC.Type
+type family OverIdentity' t = res where
+  OverIdentity' (a -> b) = a -> OverIdentity' b
+  OverIdentity' leaf = Identity leaf
+
+type OverIdentity :: GHC.Type -> GHC.Type
+type family OverIdentity t = res where
+  OverIdentity ((), b) = ((), OverIdentity' b)
+  OverIdentity (BinderList b', b) = (BinderList b', OverIdentity' b)
+  OverIdentity (Index, b) = (Index, OverIdentity' b)
+  OverIdentity leaf = OverIdentity' leaf
+
+class EmbedIdentity a where
+  embedIden :: a -> OverIdentity a
+
+class EmbedIdentity' a where
+  embedIden' :: a -> OverIdentity' a
+
+instance (EmbedIdentity' b) => EmbedIdentity' (a -> b) where
+  embedIden' f = embedIden' . f
+
+instance (EmbedIdentity' b) => EmbedIdentity ((), b) where
+  embedIden (a, b) = (a, embedIden' b)
+
+instance (EmbedIdentity' b) => EmbedIdentity (Index, b) where
+  embedIden (a, b) = (a, embedIden' b)
+
+instance (EmbedIdentity' b) => EmbedIdentity (BinderList b', b) where
+  embedIden (a, b) = (a, embedIden' b)
+
+instance (EmbedIdentity' b) => EmbedIdentity (a -> b) where
+  embedIden a = embedIden' a
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Collector.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Collector.hs
index 366e9cc666..696a49d95f 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Collector.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Collector.hs
@@ -2,7 +2,7 @@ module Juvix.Compiler.Core.Extra.Recursors.Collector where
 
 import Juvix.Compiler.Core.Data.BinderList (BinderList)
 import Juvix.Compiler.Core.Data.BinderList qualified as BL
-import Juvix.Compiler.Core.Language
+import Juvix.Compiler.Core.Language.Base
 
 -- | a collector collects information top-down on a single path in the program
 -- tree
@@ -16,21 +16,21 @@ makeLenses ''Collector
 unitCollector :: Collector a ()
 unitCollector = Collector () (\_ _ -> ())
 
-binderInfoCollector' :: BinderList Binder -> Collector (Int, [Binder]) (BinderList Binder)
+binderInfoCollector' :: BinderList b -> Collector (Int, [b]) (BinderList b)
 binderInfoCollector' ini = Collector ini collect
   where
-    collect :: (Int, [Binder]) -> BinderList Binder -> BinderList Binder
+    collect :: (Int, [b]) -> BinderList b -> BinderList b
     collect (k, bi) c
       | k == 0 = c
       | otherwise = BL.prependRev bi c
 
-binderInfoCollector :: Collector (Int, [Binder]) (BinderList Binder)
+binderInfoCollector :: Collector (Int, [b]) (BinderList b)
 binderInfoCollector = binderInfoCollector' mempty
 
-binderNumCollector' :: Int -> Collector (Int, [Binder]) Index
+binderNumCollector' :: Int -> Collector (Int, [b]) Index
 binderNumCollector' ini = Collector ini (\(k, _) c -> c + k)
 
-binderNumCollector :: Collector (Int, [Binder]) Index
+binderNumCollector :: Collector (Int, [b]) Index
 binderNumCollector = binderNumCollector' 0
 
 pairCollector :: Collector a b -> Collector a c -> Collector a (b, c)
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Map.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Map.hs
index ea916ed5a7..9fed6c64f7 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Map.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Map.hs
@@ -2,8 +2,6 @@
 
 module Juvix.Compiler.Core.Extra.Recursors.Map where
 
-import Data.Functor.Identity
-import Data.Kind qualified as GHC
 import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Extra.Recursors.Base
 
@@ -46,51 +44,6 @@ dmapG coll f = go (coll ^. cEmpty)
             goChild :: NodeChild -> m Node
             goChild ch = go ((coll ^. cCollect) (ch ^. childBindersNum, ch ^. childBinders) c') (ch ^. childNode)
 
-type OverIdentity' :: GHC.Type -> GHC.Type
-type family OverIdentity' t = res where
-  OverIdentity' (a -> b) = a -> OverIdentity' b
-  OverIdentity' leaf = Identity leaf
-
-type OverIdentity :: GHC.Type -> GHC.Type
-type family OverIdentity t = res where
-  OverIdentity ((), b) = ((), OverIdentity' b)
-  OverIdentity (BinderList Binder, b) = (BinderList Binder, OverIdentity' b)
-  OverIdentity (Index, b) = (Index, OverIdentity' b)
-  OverIdentity leaf = OverIdentity' leaf
-
-class EmbedIdentity a where
-  embedIden :: a -> OverIdentity a
-
-class EmbedIdentity' a where
-  embedIden' :: a -> OverIdentity' a
-
-instance (EmbedIdentity' b) => EmbedIdentity' (a -> b) where
-  embedIden' f = embedIden' . f
-
-instance (EmbedIdentity' b) => EmbedIdentity ((), b) where
-  embedIden (a, b) = (a, embedIden' b)
-
-instance (EmbedIdentity' b) => EmbedIdentity (Index, b) where
-  embedIden (a, b) = (a, embedIden' b)
-
-instance (EmbedIdentity' b) => EmbedIdentity (BinderList Binder, b) where
-  embedIden (a, b) = (a, embedIden' b)
-
-instance (EmbedIdentity' b) => EmbedIdentity (a -> b) where
-  embedIden a = embedIden' a
-
-instance EmbedIdentity' (c, Node) where
-  embedIden' = Identity
-
-instance EmbedIdentity' Node where
-  embedIden' = Identity
-
-instance EmbedIdentity' Recur where
-  embedIden' = Identity
-
-instance EmbedIdentity' (Recur' c) where
-  embedIden' = Identity
-
 fromSimple :: (Functor g) => c -> g Node -> g (Recur' c)
 fromSimple c = fmap (\x -> Recur' (c, x))
 
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Map/Named.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Map/Named.hs
index 7141bec859..2f1660a2f2 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Map/Named.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Map/Named.hs
@@ -2,6 +2,7 @@ module Juvix.Compiler.Core.Extra.Recursors.Map.Named where
 
 import Data.Functor.Identity
 import Juvix.Compiler.Core.Extra.Recursors.Base
+import Juvix.Compiler.Core.Extra.Recursors.Classes
 import Juvix.Compiler.Core.Extra.Recursors.Map
 
 {-
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Recur.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Recur.hs
index 14c50b866e..adec88b8bf 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Recur.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Recur.hs
@@ -1,5 +1,12 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Avoid restricted flags" #-}
+
 module Juvix.Compiler.Core.Extra.Recursors.Recur where
 
+import Data.Functor.Identity
+import Juvix.Compiler.Core.Extra.Recursors.Classes
 import Juvix.Compiler.Core.Language
 
 data Recur' c
@@ -9,3 +16,15 @@ data Recur' c
 data Recur
   = End Node
   | Recur Node
+
+instance EmbedIdentity' (c, Node) where
+  embedIden' = Identity
+
+instance EmbedIdentity' Node where
+  embedIden' = Identity
+
+instance EmbedIdentity' Recur where
+  embedIden' = Identity
+
+instance EmbedIdentity' (Recur' c) where
+  embedIden' = Identity
diff --git a/src/Juvix/Compiler/Tree/Extra/Base.hs b/src/Juvix/Compiler/Tree/Extra/Base.hs
index a02336a6ed..a5911d73d1 100644
--- a/src/Juvix/Compiler/Tree/Extra/Base.hs
+++ b/src/Juvix/Compiler/Tree/Extra/Base.hs
@@ -7,3 +7,250 @@ mkBinop op arg1 arg2 = Binop (NodeBinop op arg1 arg2)
 
 mkUnop :: UnaryOpcode -> Node -> Node
 mkUnop op arg = Unop (NodeUnop op arg)
+
+{------------------------------------------------------------------------}
+{- generic Node destruction -}
+
+data NodeChild = NodeChild
+  { -- | immediate child of some node
+    _childNode :: Node,
+    -- | `Just i` if the child introduces a temporary variable
+    _childTempVarInfo :: Maybe TempVarInfo
+  }
+
+makeLenses ''NodeChild
+
+-- | `NodeDetails` is a convenience datatype which provides the most commonly needed
+-- information about a node in a generic fashion.
+data NodeDetails = NodeDetails
+  { -- | 'nodeChildren' are the children, in a fixed order, i.e., the immediate
+    -- recursive subnodes
+    _nodeChildren :: [NodeChild],
+    -- | 'nodeReassemble' reassembles the node from the children (which should
+    -- be in the same fixed order as in 'nodeChildren').
+    _nodeReassemble :: [Node] -> Node
+  }
+
+makeLenses ''NodeDetails
+
+{-# INLINE noTempVar #-}
+noTempVar :: Node -> NodeChild
+noTempVar n =
+  NodeChild
+    { _childNode = n,
+      _childTempVarInfo = Nothing
+    }
+
+{-# INLINE oneTempVar #-}
+oneTempVar :: TempVarInfo -> Node -> NodeChild
+oneTempVar i n =
+  NodeChild
+    { _childNode = n,
+      _childTempVarInfo = Just i
+    }
+
+type Reassemble = [Node] -> Node
+
+{-# INLINE noChildren #-}
+noChildren :: Node -> Reassemble
+noChildren n ch = case ch of
+  [] -> n
+  _ -> impossible
+
+{-# INLINE oneChild #-}
+oneChild :: (Node -> Node) -> Reassemble
+oneChild f ch = case ch of
+  [c] -> f c
+  _ -> impossible
+
+{-# INLINE twoChildren #-}
+twoChildren :: (Node -> Node -> Node) -> Reassemble
+twoChildren f ch = case ch of
+  [l, r] -> f l r
+  _ -> impossible
+
+{-# INLINE threeChildren #-}
+threeChildren :: (Node -> Node -> Node -> Node) -> Reassemble
+threeChildren f ch = case ch of
+  [a, b, c] -> f a b c
+  _ -> impossible
+
+{-# INLINE manyChildren #-}
+manyChildren :: ([Node] -> Node) -> Reassemble
+manyChildren f = f
+
+{-# INLINE someChildren #-}
+someChildren :: (NonEmpty Node -> Node) -> Reassemble
+someChildren f = f . nonEmpty'
+
+{-# INLINE twoManyChildren #-}
+twoManyChildren :: (Node -> Node -> [Node] -> Node) -> Reassemble
+twoManyChildren f = \case
+  (x : y : xs) -> f x y xs
+  _ -> impossible
+
+-- | Destruct a node into NodeDetails. This is an internal function used to
+-- implement more high-level accessors and recursors.
+destruct :: Node -> NodeDetails
+destruct = \case
+  Binop NodeBinop {..} ->
+    NodeDetails
+      { _nodeChildren = [noTempVar _nodeBinopArg1, noTempVar _nodeBinopArg2],
+        _nodeReassemble = twoChildren $ \arg1 arg2 ->
+          Binop
+            NodeBinop
+              { _nodeBinopArg1 = arg1,
+                _nodeBinopArg2 = arg2,
+                _nodeBinopOpcode
+              }
+      }
+  Unop NodeUnop {..} ->
+    NodeDetails
+      { _nodeChildren = [noTempVar _nodeUnopArg],
+        _nodeReassemble = oneChild $ \arg ->
+          Unop
+            NodeUnop
+              { _nodeUnopArg = arg,
+                _nodeUnopOpcode
+              }
+      }
+  Const c ->
+    NodeDetails
+      { _nodeChildren = [],
+        _nodeReassemble = noChildren (Const c)
+      }
+  MemRef r ->
+    NodeDetails
+      { _nodeChildren = [],
+        _nodeReassemble = noChildren (MemRef r)
+      }
+  AllocConstr NodeAllocConstr {..} ->
+    NodeDetails
+      { _nodeChildren = map noTempVar _nodeAllocConstrArgs,
+        _nodeReassemble = manyChildren $ \args ->
+          AllocConstr
+            NodeAllocConstr
+              { _nodeAllocConstrArgs = args,
+                _nodeAllocConstrTag
+              }
+      }
+  AllocClosure NodeAllocClosure {..} ->
+    NodeDetails
+      { _nodeChildren = map noTempVar _nodeAllocClosureArgs,
+        _nodeReassemble = manyChildren $ \args ->
+          AllocClosure
+            NodeAllocClosure
+              { _nodeAllocClosureArgs = args,
+                _nodeAllocClosureFunSymbol
+              }
+      }
+  ExtendClosure NodeExtendClosure {..} ->
+    NodeDetails
+      { _nodeChildren = map noTempVar (_nodeExtendClosureFun : toList _nodeExtendClosureArgs),
+        _nodeReassemble = someChildren $ \(arg :| args) ->
+          ExtendClosure
+            NodeExtendClosure
+              { _nodeExtendClosureArgs = nonEmpty' args,
+                _nodeExtendClosureFun = arg
+              }
+      }
+  Call NodeCall {..} -> case _nodeCallType of
+    CallFun sym ->
+      NodeDetails
+        { _nodeChildren = map noTempVar _nodeCallArgs,
+          _nodeReassemble = manyChildren $ \args ->
+            Call
+              NodeCall
+                { _nodeCallArgs = args,
+                  _nodeCallType = CallFun sym
+                }
+        }
+    CallClosure cl ->
+      NodeDetails
+        { _nodeChildren = map noTempVar (cl : _nodeCallArgs),
+          _nodeReassemble = someChildren $ \(arg :| args) ->
+            Call
+              NodeCall
+                { _nodeCallArgs = args,
+                  _nodeCallType = CallClosure arg
+                }
+        }
+  CallClosures NodeCallClosures {..} ->
+    NodeDetails
+      { _nodeChildren = map noTempVar (_nodeCallClosuresFun : _nodeCallClosuresArgs),
+        _nodeReassemble = someChildren $ \(arg :| args) ->
+          CallClosures
+            NodeCallClosures
+              { _nodeCallClosuresArgs = args,
+                _nodeCallClosuresFun = arg
+              }
+      }
+  Branch NodeBranch {..} ->
+    NodeDetails
+      { _nodeChildren = [noTempVar _nodeBranchArg, noTempVar _nodeBranchTrue, noTempVar _nodeBranchFalse],
+        _nodeReassemble = threeChildren $ \arg br1 br2 ->
+          Branch
+            NodeBranch
+              { _nodeBranchArg = arg,
+                _nodeBranchTrue = br1,
+                _nodeBranchFalse = br2
+              }
+      }
+  Case NodeCase {..} ->
+    case _nodeCaseDefault of
+      Nothing ->
+        NodeDetails
+          { _nodeChildren = noTempVar _nodeCaseArg : branchChildren,
+            _nodeReassemble = someChildren $ \(v' :| bodies') ->
+              Case
+                NodeCase
+                  { _nodeCaseArg = v',
+                    _nodeCaseBranches = mkBranches _nodeCaseBranches bodies',
+                    _nodeCaseDefault = Nothing,
+                    _nodeCaseInductive
+                  }
+          }
+      Just def ->
+        NodeDetails
+          { _nodeChildren = noTempVar _nodeCaseArg : noTempVar def : branchChildren,
+            _nodeReassemble = twoManyChildren $ \v' def' bodies' ->
+              Case
+                NodeCase
+                  { _nodeCaseArg = v',
+                    _nodeCaseBranches = mkBranches _nodeCaseBranches bodies',
+                    _nodeCaseDefault = Just def',
+                    _nodeCaseInductive
+                  }
+          }
+    where
+      branchChildren = map mkBranchChild _nodeCaseBranches
+
+      mkBranchChild :: CaseBranch -> NodeChild
+      mkBranchChild CaseBranch {..} =
+        (if _caseBranchSave then oneTempVar (TempVarInfo Nothing Nothing) else noTempVar) _caseBranchBody
+
+      mkBranches :: [CaseBranch] -> [Node] -> [CaseBranch]
+      mkBranches = zipWithExact (flip (set caseBranchBody))
+  Save NodeSave {..} ->
+    NodeDetails
+      { _nodeChildren = [noTempVar _nodeSaveArg, oneTempVar _nodeSaveTempVarInfo _nodeSaveBody],
+        _nodeReassemble = twoChildren $ \arg body ->
+          Save
+            NodeSave
+              { _nodeSaveArg = arg,
+                _nodeSaveBody = body,
+                _nodeSaveTempVarInfo
+              }
+      }
+
+reassembleDetails :: NodeDetails -> [Node] -> Node
+reassembleDetails d ns = (d ^. nodeReassemble) ns
+
+reassemble :: Node -> [Node] -> Node
+reassemble = reassembleDetails . destruct
+
+children :: Node -> [NodeChild]
+children = (^. nodeChildren) . destruct
+
+childrenNodes :: Node -> [Node]
+childrenNodes = map (^. childNode) . children
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Base.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Base.hs
new file mode 100644
index 0000000000..64b060cad6
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Extra/Recursors/Base.hs
@@ -0,0 +1,12 @@
+module Juvix.Compiler.Tree.Extra.Recursors.Base
+  ( module Juvix.Compiler.Core.Data.BinderList,
+    module Juvix.Compiler.Tree.Language,
+    module Juvix.Compiler.Core.Extra.Recursors.Collector,
+    module Juvix.Compiler.Tree.Extra.Recursors.Recur,
+  )
+where
+
+import Juvix.Compiler.Core.Data.BinderList (BinderList)
+import Juvix.Compiler.Core.Extra.Recursors.Collector
+import Juvix.Compiler.Tree.Extra.Recursors.Recur
+import Juvix.Compiler.Tree.Language
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Map.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Map.hs
new file mode 100644
index 0000000000..f1d9e1a59a
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Extra/Recursors/Map.hs
@@ -0,0 +1,65 @@
+module Juvix.Compiler.Tree.Extra.Recursors.Map where
+
+import Juvix.Compiler.Tree.Extra.Base
+import Juvix.Compiler.Tree.Extra.Recursors.Base
+
+-- | `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
+-- recursive subnodes have already been mapped
+umapG ::
+  forall c m.
+  (Monad m) =>
+  Collector (Int, [TempVarInfo]) c ->
+  (c -> Node -> m Node) ->
+  Node ->
+  m Node
+umapG coll f = go (coll ^. cEmpty)
+  where
+    go :: c -> Node -> m Node
+    go c n =
+      let ni = destruct n
+       in do
+            ns <- mapM (\n' -> go ((coll ^. cCollect) (fromEnum (isJust (n' ^. childTempVarInfo)), toList (n' ^. childTempVarInfo)) c) (n' ^. childNode)) (ni ^. nodeChildren)
+            f c (reassembleDetails ni ns)
+
+dmapG ::
+  forall c m.
+  (Monad m) =>
+  Collector (Int, [TempVarInfo]) c ->
+  (c -> Node -> m (Recur' c)) ->
+  Node ->
+  m Node
+dmapG coll f = go (coll ^. cEmpty)
+  where
+    go :: c -> Node -> m Node
+    go c n = do
+      r <- f c n
+      case r of
+        End' n' -> return n'
+        Recur' (c', n') ->
+          let ni = destruct n'
+           in reassembleDetails ni <$> mapM goChild (ni ^. nodeChildren)
+          where
+            goChild :: NodeChild -> m Node
+            goChild ch = go ((coll ^. cCollect) (fromEnum (isJust (ch ^. childTempVarInfo)), toList (ch ^. childTempVarInfo)) c') (ch ^. childNode)
+
+fromSimple :: (Functor g) => c -> g Node -> g (Recur' c)
+fromSimple c = fmap (\x -> Recur' (c, x))
+
+fromRecur :: (Functor g) => c -> g Recur -> g (Recur' c)
+fromRecur c =
+  fmap
+    ( \case
+        End x -> End' x
+        Recur x -> Recur' (c, x)
+    )
+
+fromPair :: (Functor g) => d -> g (c, Node) -> g (Recur' (c, d))
+fromPair d = fmap (\(c, x) -> Recur' ((c, d), x))
+
+fromRecur' :: (Functor g) => d -> g (Recur' c) -> g (Recur' (c, d))
+fromRecur' d =
+  fmap
+    ( \case
+        End' x -> End' x
+        Recur' (c, x) -> Recur' ((c, d), x)
+    )
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Map/Named.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Map/Named.hs
new file mode 100644
index 0000000000..b4e2da22f4
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Extra/Recursors/Map/Named.hs
@@ -0,0 +1,141 @@
+module Juvix.Compiler.Tree.Extra.Recursors.Map.Named where
+
+import Data.Functor.Identity
+import Juvix.Compiler.Core.Extra.Recursors.Classes
+import Juvix.Compiler.Tree.Extra.Recursors.Base
+import Juvix.Compiler.Tree.Extra.Recursors.Map
+
+{- See Juvix.Compiler.Core.Extra.Recursors.Map.Named for an explanation of the
+naming conventions. -}
+
+dmapLRM :: (Monad m) => (BinderList TempVarInfo -> Node -> m Recur) -> Node -> m Node
+dmapLRM f = dmapLRM' (mempty, f)
+
+dmapLM :: (Monad m) => (BinderList TempVarInfo -> Node -> m Node) -> Node -> m Node
+dmapLM f = dmapLM' (mempty, f)
+
+umapLM :: (Monad m) => (BinderList TempVarInfo -> Node -> m Node) -> Node -> m Node
+umapLM f = umapG binderInfoCollector f
+
+dmapNRM :: (Monad m) => (Level -> Node -> m Recur) -> Node -> m Node
+dmapNRM f = dmapNRM' (0, f)
+
+dmapNM :: (Monad m) => (Level -> Node -> m Node) -> Node -> m Node
+dmapNM f = dmapNM' (0, f)
+
+umapNM :: (Monad m) => (Level -> Node -> m Node) -> Node -> m Node
+umapNM f = umapG binderNumCollector f
+
+dmapRM :: (Monad m) => (Node -> m Recur) -> Node -> m Node
+dmapRM f = dmapG unitCollector (const (fromRecur mempty . f))
+
+dmapM :: (Monad m) => (Node -> m Node) -> Node -> m Node
+dmapM f = dmapG unitCollector (const (fromSimple mempty . f))
+
+umapM :: (Monad m) => (Node -> m Node) -> Node -> m Node
+umapM f = umapG unitCollector (const f)
+
+dmapLRM' :: (Monad m) => (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> m Recur) -> Node -> m Node
+dmapLRM' f = dmapG (binderInfoCollector' (fst f)) (\bi -> fromRecur bi . snd f bi)
+
+dmapLM' :: (Monad m) => (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> m Node) -> Node -> m Node
+dmapLM' f = dmapG (binderInfoCollector' (fst f)) (\bi -> fromSimple bi . snd f bi)
+
+umapLM' :: (Monad m) => (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> m Node) -> Node -> m Node
+umapLM' f = umapG (binderInfoCollector' (fst f)) (snd f)
+
+dmapNRM' :: (Monad m) => (Level, Level -> Node -> m Recur) -> Node -> m Node
+dmapNRM' f = dmapG (binderNumCollector' (fst f)) (\bi -> fromRecur bi . snd f bi)
+
+dmapNM' :: (Monad m) => (Level, Level -> Node -> m Node) -> Node -> m Node
+dmapNM' f = dmapG (binderNumCollector' (fst f)) (\bi -> fromSimple bi . snd f bi)
+
+umapNM' :: (Monad m) => (Level, Level -> Node -> m Node) -> Node -> m Node
+umapNM' f = umapG (binderNumCollector' (fst f)) (snd f)
+
+dmapLR :: (BinderList TempVarInfo -> Node -> Recur) -> Node -> Node
+dmapLR f = runIdentity . dmapLRM (embedIden f)
+
+dmapL :: (BinderList TempVarInfo -> Node -> Node) -> Node -> Node
+dmapL f = runIdentity . dmapLM (embedIden f)
+
+umapL :: (BinderList TempVarInfo -> Node -> Node) -> Node -> Node
+umapL f = runIdentity . umapLM (embedIden f)
+
+dmapNR :: (Level -> Node -> Recur) -> Node -> Node
+dmapNR f = runIdentity . dmapNRM (embedIden f)
+
+dmapN :: (Level -> Node -> Node) -> Node -> Node
+dmapN f = runIdentity . dmapNM (embedIden f)
+
+umapN :: (Level -> Node -> Node) -> Node -> Node
+umapN f = runIdentity . umapNM (embedIden f)
+
+dmapR :: (Node -> Recur) -> Node -> Node
+dmapR f = runIdentity . dmapRM (embedIden f)
+
+dmap :: (Node -> Node) -> Node -> Node
+dmap f = runIdentity . dmapM (embedIden f)
+
+umap :: (Node -> Node) -> Node -> Node
+umap f = runIdentity . umapM (embedIden f)
+
+dmapLR' :: (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> Recur) -> Node -> Node
+dmapLR' f = runIdentity . dmapLRM' (embedIden f)
+
+dmapL' :: (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> Node) -> Node -> Node
+dmapL' f = runIdentity . dmapLM' (embedIden f)
+
+umapL' :: (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> Node) -> Node -> Node
+umapL' f = runIdentity . umapLM' (embedIden f)
+
+dmapNR' :: (Level, Level -> Node -> Recur) -> Node -> Node
+dmapNR' f = runIdentity . dmapNRM' (embedIden f)
+
+dmapN' :: (Level, Level -> Node -> Node) -> Node -> Node
+dmapN' f = runIdentity . dmapNM' (embedIden f)
+
+umapN' :: (Level, Level -> Node -> Node) -> Node -> Node
+umapN' f = runIdentity . umapNM' (embedIden f)
+
+dmapCLM' :: (Monad m) => (BinderList TempVarInfo, c -> BinderList TempVarInfo -> Node -> m (c, Node)) -> c -> Node -> m Node
+dmapCLM' f ini = dmapG (pairCollector (identityCollector ini) (binderInfoCollector' (fst f))) (\(c, bi) -> fromPair bi . snd f c bi)
+
+dmapCLRM' :: (Monad m) => (BinderList TempVarInfo, c -> BinderList TempVarInfo -> Node -> m (Recur' c)) -> c -> Node -> m Node
+dmapCLRM' f ini = dmapG (pairCollector (identityCollector ini) (binderInfoCollector' (fst f))) (\(c, bi) -> fromRecur' bi . snd f c bi)
+
+dmapCNRM' :: (Monad m) => (Level, c -> Level -> Node -> m (Recur' c)) -> c -> Node -> m Node
+dmapCNRM' f ini = dmapG (pairCollector (identityCollector ini) (binderNumCollector' (fst f))) (\(c, bi) -> fromRecur' bi . snd f c bi)
+
+dmapCLM :: (Monad m) => (c -> BinderList TempVarInfo -> Node -> m (c, Node)) -> c -> Node -> m Node
+dmapCLM f = dmapCLM' (mempty, f)
+
+dmapCNM' :: (Monad m) => (Level, c -> Level -> Node -> m (c, Node)) -> c -> Node -> m Node
+dmapCNM' f ini = dmapG (pairCollector (identityCollector ini) (binderNumCollector' (fst f))) (\(c, bi) -> fromPair bi . snd f c bi)
+
+dmapCNM :: (Monad m) => (c -> Level -> Node -> m (c, Node)) -> c -> Node -> m Node
+dmapCNM f = dmapCNM' (0, f)
+
+dmapCM :: (Monad m) => (c -> Node -> m (c, Node)) -> c -> Node -> m Node
+dmapCM f ini = dmapG (identityCollector ini) (\c -> fmap Recur' . f c)
+
+dmapCL' :: (BinderList TempVarInfo, c -> BinderList TempVarInfo -> Node -> (c, Node)) -> c -> Node -> Node
+dmapCL' f ini = runIdentity . dmapCLM' (embedIden f) ini
+
+dmapCLR' :: (BinderList TempVarInfo, c -> BinderList TempVarInfo -> Node -> Recur' c) -> c -> Node -> Node
+dmapCLR' f ini = runIdentity . dmapCLRM' (embedIden f) ini
+
+dmapCN' :: (Level, c -> Level -> Node -> (c, Node)) -> c -> Node -> Node
+dmapCN' f ini = runIdentity . dmapCNM' (embedIden f) ini
+
+dmapCNR' :: (Level, c -> Level -> Node -> Recur' c) -> c -> Node -> Node
+dmapCNR' f ini = runIdentity . dmapCNRM' (embedIden f) ini
+
+dmapCL :: (c -> BinderList TempVarInfo -> Node -> (c, Node)) -> c -> Node -> Node
+dmapCL f ini = runIdentity . dmapCLM (embedIden f) ini
+
+dmapCN :: (c -> Level -> Node -> (c, Node)) -> c -> Node -> Node
+dmapCN f ini = runIdentity . dmapCNM (embedIden f) ini
+
+dmapC :: (c -> Node -> (c, Node)) -> c -> Node -> Node
+dmapC f ini = runIdentity . dmapCM (embedIden f) ini
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs
new file mode 100644
index 0000000000..574fc3f88f
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs
@@ -0,0 +1,29 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Avoid restricted flags" #-}
+module Juvix.Compiler.Tree.Extra.Recursors.Recur where
+
+import Data.Functor.Identity
+import Juvix.Compiler.Core.Extra.Recursors.Classes
+import Juvix.Compiler.Tree.Language
+
+data Recur' c
+  = End' Node
+  | Recur' (c, Node)
+
+data Recur
+  = End Node
+  | Recur Node
+
+instance EmbedIdentity' (c, Node) where
+  embedIden' = Identity
+
+instance EmbedIdentity' Node where
+  embedIden' = Identity
+
+instance EmbedIdentity' Recur where
+  embedIden' = Identity
+
+instance EmbedIdentity' (Recur' c) where
+  embedIden' = Identity
diff --git a/src/Juvix/Compiler/Tree/Language.hs b/src/Juvix/Compiler/Tree/Language.hs
index d77f7ebdfc..210d28742b 100644
--- a/src/Juvix/Compiler/Tree/Language.hs
+++ b/src/Juvix/Compiler/Tree/Language.hs
@@ -130,8 +130,13 @@ data CaseBranch = CaseBranch
     _caseBranchSave :: Bool
   }
 
+data TempVarInfo = TempVarInfo
+  { _tempVarInfoName :: Maybe Text,
+    _tempVarInfoLocation :: Maybe Location
+  }
+
 data NodeSave = NodeSave
-  { _nodeSaveName :: Maybe Text,
+  { _nodeSaveTempVarInfo :: TempVarInfo,
     _nodeSaveArg :: Node,
     _nodeSaveBody :: Node
   }
@@ -143,3 +148,5 @@ makeLenses ''NodeCallClosures
 makeLenses ''NodeBranch
 makeLenses ''NodeCase
 makeLenses ''NodeSave
+makeLenses ''TempVarInfo
+makeLenses ''CaseBranch
diff --git a/src/Juvix/Compiler/Tree/Pretty/Base.hs b/src/Juvix/Compiler/Tree/Pretty/Base.hs
index 43fc7e0876..a77a7ccc7d 100644
--- a/src/Juvix/Compiler/Tree/Pretty/Base.hs
+++ b/src/Juvix/Compiler/Tree/Pretty/Base.hs
@@ -323,7 +323,7 @@ instance PrettyCode NodeSave where
     arg <- ppCode _nodeSaveArg
     body <- ppCode _nodeSaveBody
     let name =
-          case _nodeSaveName of
+          case _nodeSaveTempVarInfo ^. tempVarInfoName of
             Just n -> brackets (variable (quoteName n))
             Nothing -> mempty
     return $ primitive Str.save <> name <> parens arg <+> braces' body
diff --git a/src/Juvix/Compiler/Tree/Translation/FromAsm.hs b/src/Juvix/Compiler/Tree/Translation/FromAsm.hs
index 7ecbd3ba3f..ecb060fe7e 100644
--- a/src/Juvix/Compiler/Tree/Translation/FromAsm.hs
+++ b/src/Juvix/Compiler/Tree/Translation/FromAsm.hs
@@ -183,7 +183,7 @@ goFunction infoTab fi = do
           return $
             Save
               NodeSave
-                { _nodeSaveName = _cmdSaveName,
+                { _nodeSaveTempVarInfo = TempVarInfo _cmdSaveName (_cmdSaveInfo ^. Asm.commandInfoLocation),
                   _nodeSaveArg = arg,
                   _nodeSaveBody = body
                 }
@@ -243,7 +243,7 @@ goFunction infoTab fi = do
             Save
               NodeSave
                 { _nodeSaveArg = arg,
-                  _nodeSaveName = Nothing,
+                  _nodeSaveTempVarInfo = TempVarInfo Nothing Nothing,
                   _nodeSaveBody =
                     Binop
                       NodeBinop
diff --git a/src/Juvix/Compiler/Tree/Translation/FromCore.hs b/src/Juvix/Compiler/Tree/Translation/FromCore.hs
index 90d332ed71..aceb44b120 100644
--- a/src/Juvix/Compiler/Tree/Translation/FromCore.hs
+++ b/src/Juvix/Compiler/Tree/Translation/FromCore.hs
@@ -166,10 +166,11 @@ genCode infoTable fi =
         NodeSave
           { _nodeSaveArg = arg,
             _nodeSaveBody = body,
-            _nodeSaveName = Just name
+            _nodeSaveTempVarInfo = TempVarInfo (Just name) loc
           }
       where
         name = _letItem ^. Core.letItemBinder . Core.binderName
+        loc = _letItem ^. Core.letItemBinder . Core.binderLocation
         nameRef = OffsetRef tempSize (Just name)
         arg = go tempSize refs (_letItem ^. Core.letItemValue)
         body = go (tempSize + 1) (BL.cons (DRef (mkTempRef nameRef)) refs) _letBody
diff --git a/src/Juvix/Compiler/Tree/Translation/FromSource.hs b/src/Juvix/Compiler/Tree/Translation/FromSource.hs
index 0296e6caa3..c1ccf7722e 100644
--- a/src/Juvix/Compiler/Tree/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Tree/Translation/FromSource.hs
@@ -304,7 +304,7 @@ parseSave ::
   ParsecS r NodeSave
 parseSave = do
   kw kwSave
-  mname <- optional (brackets identifier)
+  (mname, loc) <- interval $ optional (brackets identifier)
   arg <- parens parseNode
   tmpNum <- lift $ gets (^. localParamsTempIndex)
   let updateNames :: LocalNameMap -> LocalNameMap
@@ -314,5 +314,5 @@ parseSave = do
     NodeSave
       { _nodeSaveArg = arg,
         _nodeSaveBody = body,
-        _nodeSaveName = mname
+        _nodeSaveTempVarInfo = TempVarInfo mname (Just loc)
       }

From 9f8ce26a529356bd9d85a1883b0a22b1c5120dc9 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 24 Jan 2024 18:31:02 +0100
Subject: [PATCH 2/6] generic recursors

---
 .../Backend/Geb/Translation/FromCore.hs       |   1 -
 .../Compiler/Core/Data/IdentDependencyInfo.hs |   1 -
 .../Compiler/Core/Data/TypeDependencyInfo.hs  |   1 -
 src/Juvix/Compiler/Core/Evaluator.hs          |   1 -
 src/Juvix/Compiler/Core/Extra/Info.hs         |   1 -
 .../Compiler/Core/Extra/Recursors/Base.hs     |  19 ++
 .../Compiler/Core/Extra/Recursors/Classes.hs  |  18 ++
 .../Compiler/Core/Extra/Recursors/Fold.hs     |  32 +---
 .../Core/Extra/Recursors/Fold/Named.hs        |  68 +------
 .../Core/Extra/Recursors/Generic/Base.hs      |  44 +++++
 .../Core/Extra/Recursors/Generic/Collector.hs |  44 +++++
 .../Core/Extra/Recursors/Generic/Fold.hs      |  28 +++
 .../Extra/Recursors/Generic/Fold/Named.hs     |  65 +++++++
 .../Core/Extra/Recursors/Generic/Map.hs       |  68 +++++++
 .../Core/Extra/Recursors/Generic/Map/Named.hs | 176 +++++++++++++++++
 .../Core/Extra/Recursors/Generic/Recur.hs     |   9 +
 .../Compiler/Core/Extra/Recursors/Map.hs      |  71 +------
 .../Core/Extra/Recursors/Map/Named.hs         | 180 +-----------------
 .../Compiler/Core/Extra/Recursors/Recur.hs    |  33 ++--
 .../Compiler/Core/Extra/Recursors/Utils.hs    |   1 -
 src/Juvix/Compiler/Core/Extra/Utils.hs        |   1 -
 src/Juvix/Compiler/Core/Extra/Utils/Base.hs   |   1 -
 src/Juvix/Compiler/Core/Extra/Value.hs        |   1 -
 src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs  |   1 -
 src/Juvix/Compiler/Core/Scoper.hs             |   1 -
 .../Core/Transformation/Check/Base.hs         |   1 -
 .../Transformation/LambdaLetRecLifting.hs     |   1 -
 .../Core/Transformation/LetHoisting.hs        |   1 -
 .../Core/Transformation/NaiveMatchToCase.hs   |   1 -
 .../Transformation/NaiveMatchToCase/Data.hs   |   1 -
 .../Compiler/Core/Translation/FromInternal.hs |   1 -
 .../Translation/FromInternal/Builtins/Int.hs  |   1 -
 .../Translation/FromInternal/Builtins/Nat.hs  |   1 -
 .../Compiler/Core/Translation/FromSource.hs   |   1 -
 src/Juvix/Compiler/Store/Core/Extra.hs        |   1 -
 src/Juvix/Compiler/Tree/Extra/Recursors.hs    |  10 +
 .../Compiler/Tree/Extra/Recursors/Base.hs     |  22 ++-
 .../Compiler/Tree/Extra/Recursors/Map.hs      |  65 -------
 .../Tree/Extra/Recursors/Map/Named.hs         | 141 --------------
 .../Compiler/Tree/Extra/Recursors/Recur.hs    |  34 +---
 test/Core/Eval/Base.hs                        |   1 -
 test/Core/Recursor/RMap.hs                    |   1 -
 42 files changed, 543 insertions(+), 607 deletions(-)
 create mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Generic/Base.hs
 create mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Generic/Collector.hs
 create mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Generic/Fold.hs
 create mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Generic/Fold/Named.hs
 create mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Generic/Map.hs
 create mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Generic/Map/Named.hs
 create mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Generic/Recur.hs
 create mode 100644 src/Juvix/Compiler/Tree/Extra/Recursors.hs
 delete mode 100644 src/Juvix/Compiler/Tree/Extra/Recursors/Map.hs
 delete mode 100644 src/Juvix/Compiler/Tree/Extra/Recursors/Map/Named.hs

diff --git a/src/Juvix/Compiler/Backend/Geb/Translation/FromCore.hs b/src/Juvix/Compiler/Backend/Geb/Translation/FromCore.hs
index e81491d790..a0589cb60f 100644
--- a/src/Juvix/Compiler/Backend/Geb/Translation/FromCore.hs
+++ b/src/Juvix/Compiler/Backend/Geb/Translation/FromCore.hs
@@ -9,7 +9,6 @@ import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Core.Extra qualified as Core
 import Juvix.Compiler.Core.Info.TypeInfo qualified as Info
 import Juvix.Compiler.Core.Language (Index, Level, Symbol)
-import Juvix.Compiler.Core.Language qualified as Core
 
 data Env = Env
   { _envIdentMap :: HashMap Symbol Level,
diff --git a/src/Juvix/Compiler/Core/Data/IdentDependencyInfo.hs b/src/Juvix/Compiler/Core/Data/IdentDependencyInfo.hs
index e26f1847d4..063908ff3e 100644
--- a/src/Juvix/Compiler/Core/Data/IdentDependencyInfo.hs
+++ b/src/Juvix/Compiler/Core/Data/IdentDependencyInfo.hs
@@ -5,7 +5,6 @@ import Data.HashSet qualified as HashSet
 import Juvix.Compiler.Core.Data.InfoTable
 import Juvix.Compiler.Core.Data.Module
 import Juvix.Compiler.Core.Extra.Utils
-import Juvix.Compiler.Core.Language
 
 -- | Call graph type
 type IdentDependencyInfo = DependencyInfo Symbol
diff --git a/src/Juvix/Compiler/Core/Data/TypeDependencyInfo.hs b/src/Juvix/Compiler/Core/Data/TypeDependencyInfo.hs
index 849792f14b..24e396122c 100644
--- a/src/Juvix/Compiler/Core/Data/TypeDependencyInfo.hs
+++ b/src/Juvix/Compiler/Core/Data/TypeDependencyInfo.hs
@@ -4,7 +4,6 @@ import Data.HashMap.Strict qualified as HashMap
 import Data.HashSet qualified as HashSet
 import Juvix.Compiler.Core.Data.InfoTable
 import Juvix.Compiler.Core.Extra.Utils
-import Juvix.Compiler.Core.Language
 
 type TypeDependencyInfo = DependencyInfo Symbol
 
diff --git a/src/Juvix/Compiler/Core/Evaluator.hs b/src/Juvix/Compiler/Core/Evaluator.hs
index 8bfda475f3..1d53737642 100644
--- a/src/Juvix/Compiler/Core/Evaluator.hs
+++ b/src/Juvix/Compiler/Core/Evaluator.hs
@@ -17,7 +17,6 @@ import Juvix.Compiler.Core.Error (CoreError (..))
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Info.NoDisplayInfo
-import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Pretty
 import Text.Read qualified as T
 
diff --git a/src/Juvix/Compiler/Core/Extra/Info.hs b/src/Juvix/Compiler/Core/Extra/Info.hs
index 90b741a32e..38344951f2 100644
--- a/src/Juvix/Compiler/Core/Extra/Info.hs
+++ b/src/Juvix/Compiler/Core/Extra/Info.hs
@@ -4,7 +4,6 @@ import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Extra.Recursors
 import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Info.LocationInfo
-import Juvix.Compiler.Core.Language
 
 mapInfo :: (Info -> Info) -> Node -> Node
 mapInfo f = umap (modifyInfo f)
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs
index 17ee57087c..74d8b320b1 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs
@@ -1,3 +1,8 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Avoid restricted flags" #-}
+
 module Juvix.Compiler.Core.Extra.Recursors.Base
   ( module Juvix.Compiler.Core.Data.BinderList,
     module Juvix.Compiler.Core.Language,
@@ -7,6 +12,20 @@ module Juvix.Compiler.Core.Extra.Recursors.Base
 where
 
 import Juvix.Compiler.Core.Data.BinderList (BinderList)
+import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Extra.Recursors.Collector
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Base
 import Juvix.Compiler.Core.Extra.Recursors.Recur
 import Juvix.Compiler.Core.Language
+
+instance IsNodeChild NodeChild Binder where
+  gBindersNum = (^. childBindersNum)
+  gBinders = (^. childBinders)
+
+instance IsNodeDetails NodeDetails NodeChild where
+  gChildren = (^. nodeChildren)
+
+instance IsNode Node NodeDetails NodeChild Binder where
+  gDestruct = destruct
+  gReassemble = reassembleDetails
+  gChild = (^. childNode)
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs
index 678ee41963..38480bfc3e 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs
@@ -39,3 +39,21 @@ instance (EmbedIdentity' b) => EmbedIdentity (BinderList b', b) where
 
 instance (EmbedIdentity' b) => EmbedIdentity (a -> b) where
   embedIden a = embedIden' a
+
+embedIden1 :: (a -> b) -> a -> Identity b
+embedIden1 f = Identity . f
+
+embedIden2 :: (a -> b -> c) -> a -> b -> Identity c
+embedIden2 f = embedIden1 . f
+
+embedIden3 :: (a -> b -> c -> d) -> a -> b -> c -> Identity d
+embedIden3 f = embedIden2 . f
+
+embedIdenP1 :: (p, a -> b) -> (p, a -> Identity b)
+embedIdenP1 = second embedIden1
+
+embedIdenP2 :: (p, a -> b -> c) -> (p, a -> b -> Identity c)
+embedIdenP2 = second embedIden2
+
+embedIdenP3 :: (p, a -> b -> c -> d) -> (p, a -> b -> c -> Identity d)
+embedIdenP3 = second embedIden3
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Fold.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Fold.hs
index d74bf0eda7..83a95347d4 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Fold.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Fold.hs
@@ -1,29 +1,7 @@
 -- | Fold recursors over 'Node'.
-module Juvix.Compiler.Core.Extra.Recursors.Fold where
+module Juvix.Compiler.Core.Extra.Recursors.Fold
+  ( module Juvix.Compiler.Core.Extra.Recursors.Generic.Fold,
+  )
+where
 
-import Juvix.Compiler.Core.Extra.Base
-import Juvix.Compiler.Core.Extra.Recursors.Base
-
-ufoldG ::
-  forall c a f.
-  (Applicative f) =>
-  Collector (Int, [Binder]) c ->
-  (a -> [a] -> a) ->
-  (c -> Node -> f a) ->
-  Node ->
-  f a
-ufoldG coll uplus f = go (coll ^. cEmpty)
-  where
-    go :: c -> Node -> f a
-    go c n = do
-      mas' <- sequenceA mas
-      n' <- f c n
-      pure (uplus n' mas')
-      where
-        ni :: NodeDetails
-        ni = destruct n
-        mas :: [f a]
-        mas =
-          map
-            (\n' -> go ((coll ^. cCollect) (n' ^. childBindersNum, n' ^. childBinders) c) (n' ^. childNode))
-            (ni ^. nodeChildren)
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Fold
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Fold/Named.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Fold/Named.hs
index 84fd5c41df..a226e7219a 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Fold/Named.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Fold/Named.hs
@@ -1,64 +1,8 @@
-module Juvix.Compiler.Core.Extra.Recursors.Fold.Named where
+module Juvix.Compiler.Core.Extra.Recursors.Fold.Named
+  ( module Juvix.Compiler.Core.Extra.Recursors.Generic.Fold.Named,
+    module Juvix.Compiler.Core.Extra.Recursors.Base,
+  )
+where
 
-import Data.Functor.Identity
 import Juvix.Compiler.Core.Extra.Recursors.Base
-import Juvix.Compiler.Core.Extra.Recursors.Fold
-
-{-
-
-There are three major versions of folding recursors.
-
-1. `ufold f g t` folds the term `t` bottom-up, first using `g` to map the
-   current subterm into a value `a`, and then using `f` to combine `a` with the
-   values for children.
-2. `walk f t` combines the applicative actions obtained by applying `f` to each
-   subterm of `t`.
-3. `gather f a t` goes through all subterms of `t` applying `f` to the current
-   value and the subterm to obtain the next value, with `a` being the initial
-   value.
-
-The suffixes of `ufold`, etc., indicate the exact form of the folding functions,
-with similar conventions as with the mapping recursors (see
-Core/Extra/Recursors/Map/Named.hs).
-
-\* A: Applicative version.
-\* L: Provide the binder list.
-\* N: Provide the de Bruijn level.
-
--}
-
-ufoldA :: (Applicative f) => (a -> [a] -> a) -> (Node -> f a) -> Node -> f a
-ufoldA uplus f = ufoldG unitCollector uplus (const f)
-
-ufoldLA :: (Applicative f) => (a -> [a] -> a) -> (BinderList Binder -> Node -> f a) -> Node -> f a
-ufoldLA uplus f = ufoldG binderInfoCollector uplus f
-
-ufoldNA :: (Applicative f) => (a -> [a] -> a) -> (Level -> Node -> f a) -> Node -> f a
-ufoldNA uplus f = ufoldG binderNumCollector uplus f
-
-walk :: (Applicative f) => (Node -> f ()) -> Node -> f ()
-walk = ufoldA (foldr mappend)
-
-walkN :: (Applicative f) => (Level -> Node -> f ()) -> Node -> f ()
-walkN = ufoldNA (foldr mappend)
-
-walkL :: (Applicative f) => (BinderList Binder -> Node -> f ()) -> Node -> f ()
-walkL = ufoldLA (foldr mappend)
-
-ufold :: (a -> [a] -> a) -> (Node -> a) -> Node -> a
-ufold uplus f = runIdentity . ufoldA uplus (return . f)
-
-ufoldL :: (a -> [a] -> a) -> (BinderList Binder -> Node -> a) -> Node -> a
-ufoldL uplus f = runIdentity . ufoldLA uplus (\is -> return . f is)
-
-ufoldN :: (a -> [a] -> a) -> (Level -> Node -> a) -> Node -> a
-ufoldN uplus f = runIdentity . ufoldNA uplus (\idx -> return . f idx)
-
-gather :: (a -> Node -> a) -> a -> Node -> a
-gather f acc = run . execState acc . walk (\n' -> modify' (`f` n'))
-
-gatherL :: (BinderList Binder -> a -> Node -> a) -> a -> Node -> a
-gatherL f acc = run . execState acc . walkL (\is n' -> modify' (\a -> f is a n'))
-
-gatherN :: (Index -> a -> Node -> a) -> a -> Node -> a
-gatherN f acc = run . execState acc . walkN (\idx n' -> modify' (\a -> f idx a n'))
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Fold.Named
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Base.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Base.hs
new file mode 100644
index 0000000000..66731b08fd
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Base.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE FunctionalDependencies #-}
+
+module Juvix.Compiler.Core.Extra.Recursors.Generic.Base
+  ( module Juvix.Compiler.Core.Extra.Recursors.Generic.Collector,
+    module Juvix.Compiler.Core.Extra.Recursors.Generic.Recur,
+    module Juvix.Compiler.Core.Language.Base,
+    module Juvix.Compiler.Core.Extra.Recursors.Generic.Base,
+  )
+where
+
+import Data.Functor.Identity
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Collector
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Recur
+import Juvix.Compiler.Core.Language.Base
+
+class IsNodeChild c b | c -> b where
+  gBindersNum :: c -> Int
+  gBinders :: c -> [b]
+
+class IsNodeDetails d c | d -> c where
+  gChildren :: d -> [c]
+
+class (IsNodeDetails d c, IsNodeChild c b) => IsNode n d c b | n -> d c b where
+  gDestruct :: n -> d
+  gReassemble :: d -> [n] -> n
+  gChild :: c -> n
+
+embedIden1 :: (a -> b) -> a -> Identity b
+embedIden1 f = Identity . f
+
+embedIden2 :: (a -> b -> c) -> a -> b -> Identity c
+embedIden2 f = embedIden1 . f
+
+embedIden3 :: (a -> b -> c -> d) -> a -> b -> c -> Identity d
+embedIden3 f = embedIden2 . f
+
+embedIdenP1 :: (p, a -> b) -> (p, a -> Identity b)
+embedIdenP1 = second embedIden1
+
+embedIdenP2 :: (p, a -> b -> c) -> (p, a -> b -> Identity c)
+embedIdenP2 = second embedIden2
+
+embedIdenP3 :: (p, a -> b -> c -> d) -> (p, a -> b -> c -> Identity d)
+embedIdenP3 = second embedIden3
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Collector.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Collector.hs
new file mode 100644
index 0000000000..94c542e87c
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Collector.hs
@@ -0,0 +1,44 @@
+module Juvix.Compiler.Core.Extra.Recursors.Generic.Collector where
+
+import Juvix.Compiler.Core.Data.BinderList (BinderList)
+import Juvix.Compiler.Core.Data.BinderList qualified as BL
+import Juvix.Compiler.Core.Language.Base
+
+-- | a collector collects information top-down on a single path in the program
+-- tree
+data Collector a c = Collector
+  { _cEmpty :: c,
+    _cCollect :: a -> c -> c
+  }
+
+makeLenses ''Collector
+
+unitCollector :: Collector a ()
+unitCollector = Collector () (\_ _ -> ())
+
+binderInfoCollector' :: BinderList b -> Collector (Int, [b]) (BinderList b)
+binderInfoCollector' ini = Collector ini collect
+  where
+    collect :: (Int, [b]) -> BinderList b -> BinderList b
+    collect (k, bi) c
+      | k == 0 = c
+      | otherwise = BL.prependRev bi c
+
+binderInfoCollector :: Collector (Int, [b]) (BinderList b)
+binderInfoCollector = binderInfoCollector' mempty
+
+binderNumCollector' :: Int -> Collector (Int, [b]) Index
+binderNumCollector' ini = Collector ini (\(k, _) c -> c + k)
+
+binderNumCollector :: Collector (Int, [b]) Index
+binderNumCollector = binderNumCollector' 0
+
+pairCollector :: Collector a b -> Collector a c -> Collector a (b, c)
+pairCollector coll1 coll2 =
+  Collector
+    { _cEmpty = (coll1 ^. cEmpty, coll2 ^. cEmpty),
+      _cCollect = \a (b, c) -> ((coll1 ^. cCollect) a b, (coll2 ^. cCollect) a c)
+    }
+
+identityCollector :: c -> Collector a c
+identityCollector ini = Collector ini (const id)
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Fold.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Fold.hs
new file mode 100644
index 0000000000..49859c9828
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Fold.hs
@@ -0,0 +1,28 @@
+module Juvix.Compiler.Core.Extra.Recursors.Generic.Fold where
+
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Base
+
+ufoldG ::
+  forall c a f n d ch b.
+  (IsNode n d ch b) =>
+  (Applicative f) =>
+  Collector (Int, [b]) c ->
+  (a -> [a] -> a) ->
+  (c -> n -> f a) ->
+  n ->
+  f a
+ufoldG coll uplus f = go (coll ^. cEmpty)
+  where
+    go :: c -> n -> f a
+    go c n = do
+      mas' <- sequenceA mas
+      n' <- f c n
+      pure (uplus n' mas')
+      where
+        ni :: d
+        ni = gDestruct n
+        mas :: [f a]
+        mas =
+          map
+            (\n' -> go ((coll ^. cCollect) (gBindersNum n', gBinders n') c) (gChild n'))
+            (gChildren ni)
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Fold/Named.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Fold/Named.hs
new file mode 100644
index 0000000000..69077c9020
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Fold/Named.hs
@@ -0,0 +1,65 @@
+module Juvix.Compiler.Core.Extra.Recursors.Generic.Fold.Named where
+
+import Data.Functor.Identity
+import Juvix.Compiler.Core.Data.BinderList (BinderList)
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Base
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Fold
+
+{-
+
+There are three major versions of folding recursors.
+
+1. `ufold f g t` folds the term `t` bottom-up, first using `g` to map the
+   current subterm into a value `a`, and then using `f` to combine `a` with the
+   values for children.
+2. `walk f t` combines the applicative actions obtained by applying `f` to each
+   subterm of `t`.
+3. `gather f a t` goes through all subterms of `t` applying `f` to the current
+   value and the subterm to obtain the next value, with `a` being the initial
+   value.
+
+The suffixes of `ufold`, etc., indicate the exact form of the folding functions,
+with similar conventions as with the mapping recursors (see
+Core/Extra/Recursors/Map/Named.hs).
+
+\* A: Applicative version.
+\* L: Provide the binder list.
+\* N: Provide the de Bruijn level.
+
+-}
+
+ufoldA :: (IsNode n d ch b, Applicative f) => (a -> [a] -> a) -> (n -> f a) -> n -> f a
+ufoldA uplus f = ufoldG unitCollector uplus (const f)
+
+ufoldLA :: (IsNode n d ch b, Applicative f) => (a -> [a] -> a) -> (BinderList b -> n -> f a) -> n -> f a
+ufoldLA uplus f = ufoldG binderInfoCollector uplus f
+
+ufoldNA :: (IsNode n d ch b, Applicative f) => (a -> [a] -> a) -> (Level -> n -> f a) -> n -> f a
+ufoldNA uplus f = ufoldG binderNumCollector uplus f
+
+walk :: (IsNode n d ch b, Applicative f) => (n -> f ()) -> n -> f ()
+walk = ufoldA (foldr mappend)
+
+walkN :: (IsNode n d ch b, Applicative f) => (Level -> n -> f ()) -> n -> f ()
+walkN = ufoldNA (foldr mappend)
+
+walkL :: (IsNode n d ch b, Applicative f) => (BinderList b -> n -> f ()) -> n -> f ()
+walkL = ufoldLA (foldr mappend)
+
+ufold :: (IsNode n d ch b) => (a -> [a] -> a) -> (n -> a) -> n -> a
+ufold uplus f = runIdentity . ufoldA uplus (return . f)
+
+ufoldL :: (IsNode n d ch b) => (a -> [a] -> a) -> (BinderList b -> n -> a) -> n -> a
+ufoldL uplus f = runIdentity . ufoldLA uplus (\is -> return . f is)
+
+ufoldN :: (IsNode n d ch b) => (a -> [a] -> a) -> (Level -> n -> a) -> n -> a
+ufoldN uplus f = runIdentity . ufoldNA uplus (\idx -> return . f idx)
+
+gather :: (IsNode n d ch b) => (a -> n -> a) -> a -> n -> a
+gather f acc = run . execState acc . walk (\n' -> modify' (`f` n'))
+
+gatherL :: (IsNode n d ch b) => (BinderList b -> a -> n -> a) -> a -> n -> a
+gatherL f acc = run . execState acc . walkL (\is n' -> modify' (\a -> f is a n'))
+
+gatherN :: (IsNode n d ch b) => (Index -> a -> n -> a) -> a -> n -> a
+gatherN f acc = run . execState acc . walkN (\idx n' -> modify' (\a -> f idx a n'))
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Map.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Map.hs
new file mode 100644
index 0000000000..2e12550601
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Map.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Juvix.Compiler.Core.Extra.Recursors.Generic.Map where
+
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Base
+
+-- | `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
+-- recursive subnodes have already been mapped
+umapG ::
+  forall c m n d ch b.
+  (IsNode n d ch b) =>
+  (Monad m) =>
+  Collector (Int, [b]) c ->
+  (c -> n -> m n) ->
+  n ->
+  m n
+umapG coll f = go (coll ^. cEmpty)
+  where
+    go :: c -> n -> m n
+    go c n =
+      let ni = gDestruct n
+       in do
+            ns <- mapM (\n' -> go ((coll ^. cCollect) (gBindersNum n', gBinders n') c) (gChild n')) (gChildren ni)
+            f c (gReassemble ni ns)
+
+dmapG ::
+  forall c m n d ch b.
+  (IsNode n d ch b) =>
+  (Monad m) =>
+  Collector (Int, [b]) c ->
+  (c -> n -> m (Recur' n c)) ->
+  n ->
+  m n
+dmapG coll f = go (coll ^. cEmpty)
+  where
+    go :: c -> n -> m n
+    go c n = do
+      r <- f c n
+      case r of
+        End' n' -> return n'
+        Recur' (c', n') ->
+          let ni = gDestruct n'
+           in gReassemble ni <$> mapM goChild (gChildren ni)
+          where
+            goChild :: ch -> m n
+            goChild ch = go ((coll ^. cCollect) (gBindersNum ch, gBinders ch) c') (gChild ch)
+
+fromSimple :: (Functor g) => c -> g n -> g (Recur' n c)
+fromSimple c = fmap (\x -> Recur' (c, x))
+
+fromRecur :: (Functor g) => c -> g (Recur n) -> g (Recur' n c)
+fromRecur c =
+  fmap
+    ( \case
+        End x -> End' x
+        Recur x -> Recur' (c, x)
+    )
+
+fromPair :: (Functor g) => d -> g (c, n) -> g (Recur' n (c, d))
+fromPair d = fmap (\(c, x) -> Recur' ((c, d), x))
+
+fromRecur' :: (Functor g) => d -> g (Recur' n c) -> g (Recur' n (c, d))
+fromRecur' d =
+  fmap
+    ( \case
+        End' x -> End' x
+        Recur' (c, x) -> Recur' ((c, d), x)
+    )
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Map/Named.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Map/Named.hs
new file mode 100644
index 0000000000..cd5de8da84
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Map/Named.hs
@@ -0,0 +1,176 @@
+module Juvix.Compiler.Core.Extra.Recursors.Generic.Map.Named where
+
+import Data.Functor.Identity
+import Juvix.Compiler.Core.Data.BinderList (BinderList)
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Base
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Map
+
+{-
+
+The mapping recursors come in three major variants: dmap, umap and rmap. They
+map each subterm of a given term.
+
+1. `dmap f t` goes through the node `t` top-down, applying the function `f` to
+`t` first, and then recursively descending into the children of `f t`.
+
+2. `umap f t` goes through the term `t` bottom-up, first recursively descending
+into the children of `t` and mapping them with `umap f`, then reassembling `t`
+with the mapped children into `t'`, and finally applying `f` to `t'`.
+
+3. `rmap f t`: see Recursors.RMap.Named.
+
+The suffixes of `dmap`, `umap` and `rmap` indicate the exact form of the mapping
+function `f`, what arguments are provided to it and how its return value is
+interpreted.
+
+- M: Monadic version. The return value of the mapping function `f` is wrapped in
+  a monad.
+- L: The function `f` receives as an argument the list of binders upwards in the
+  term. The n-th element of the binder list corresponds to the free variable of
+  the current subterm with de Bruijn index n.
+- N: The function `f` receives as an argument the number of binders upwards in
+  the term, i.e., the current de Bruijn level.
+- ': When combined with L or N, makes it possible to supply the initial binder
+  list or de Bruijn level. This is useful when mapping a subterm with free
+  variables.
+- R: The function `f` returns an element of the `Recur` (or `Recur'`) datatype,
+  indicating whether `dmap` should descend into the children or stop the
+  traversal.
+- C: Enables collecting an arbitrary value while going downward in the term tree
+  with `dmap`. The initial value is provided to `dmap`. The function `f`
+  receives as an argument the current collected value and returns the value for
+  the children, in addition to the new node.
+
+-}
+
+dmapLRM :: (IsNode n d ch b, Monad m) => (BinderList b -> n -> m (Recur n)) -> n -> m n
+dmapLRM f = dmapLRM' (mempty, f)
+
+dmapLM :: (IsNode n d ch b, Monad m) => (BinderList b -> n -> m n) -> n -> m n
+dmapLM f = dmapLM' (mempty, f)
+
+umapLM :: (IsNode n d ch b, Monad m) => (BinderList b -> n -> m n) -> n -> m n
+umapLM f = umapG binderInfoCollector f
+
+dmapNRM :: (IsNode n d ch b, Monad m) => (Level -> n -> m (Recur n)) -> n -> m n
+dmapNRM f = dmapNRM' (0, f)
+
+dmapNM :: (IsNode n d ch b, Monad m) => (Level -> n -> m n) -> n -> m n
+dmapNM f = dmapNM' (0, f)
+
+umapNM :: (IsNode n d ch b, Monad m) => (Level -> n -> m n) -> n -> m n
+umapNM f = umapG binderNumCollector f
+
+dmapRM :: (IsNode n d ch b, Monad m) => (n -> m (Recur n)) -> n -> m n
+dmapRM f = dmapG unitCollector (const (fromRecur mempty . f))
+
+dmapM :: (IsNode n d ch b, Monad m) => (n -> m n) -> n -> m n
+dmapM f = dmapG unitCollector (const (fromSimple mempty . f))
+
+umapM :: (IsNode n d ch b, Monad m) => (n -> m n) -> n -> m n
+umapM f = umapG unitCollector (const f)
+
+dmapLRM' :: (IsNode n d ch b, Monad m) => (BinderList b, BinderList b -> n -> m (Recur n)) -> n -> m n
+dmapLRM' f = dmapG (binderInfoCollector' (fst f)) (\bi -> fromRecur bi . snd f bi)
+
+dmapLM' :: (IsNode n d ch b, Monad m) => (BinderList b, BinderList b -> n -> m n) -> n -> m n
+dmapLM' f = dmapG (binderInfoCollector' (fst f)) (\bi -> fromSimple bi . snd f bi)
+
+umapLM' :: (IsNode n d ch b, Monad m) => (BinderList b, BinderList b -> n -> m n) -> n -> m n
+umapLM' f = umapG (binderInfoCollector' (fst f)) (snd f)
+
+dmapNRM' :: (IsNode n d ch b, Monad m) => (Level, Level -> n -> m (Recur n)) -> n -> m n
+dmapNRM' f = dmapG (binderNumCollector' (fst f)) (\bi -> fromRecur bi . snd f bi)
+
+dmapNM' :: (IsNode n d ch b, Monad m) => (Level, Level -> n -> m n) -> n -> m n
+dmapNM' f = dmapG (binderNumCollector' (fst f)) (\bi -> fromSimple bi . snd f bi)
+
+umapNM' :: (IsNode n d ch b, Monad m) => (Level, Level -> n -> m n) -> n -> m n
+umapNM' f = umapG (binderNumCollector' (fst f)) (snd f)
+
+dmapLR :: (IsNode n d ch b) => (BinderList b -> n -> Recur n) -> n -> n
+dmapLR f = runIdentity . dmapLRM (embedIden2 f)
+
+dmapL :: (IsNode n d ch b) => (BinderList b -> n -> n) -> n -> n
+dmapL f = runIdentity . dmapLM (embedIden2 f)
+
+umapL :: (IsNode n d ch b) => (BinderList b -> n -> n) -> n -> n
+umapL f = runIdentity . umapLM (embedIden2 f)
+
+dmapNR :: (IsNode n d ch b) => (Level -> n -> Recur n) -> n -> n
+dmapNR f = runIdentity . dmapNRM (embedIden2 f)
+
+dmapN :: (IsNode n d ch b) => (Level -> n -> n) -> n -> n
+dmapN f = runIdentity . dmapNM (embedIden2 f)
+
+umapN :: (IsNode n d ch b) => (Level -> n -> n) -> n -> n
+umapN f = runIdentity . umapNM (embedIden2 f)
+
+dmapR :: (IsNode n d ch b) => (n -> Recur n) -> n -> n
+dmapR f = runIdentity . dmapRM (embedIden1 f)
+
+dmap :: (IsNode n d ch b) => (n -> n) -> n -> n
+dmap f = runIdentity . dmapM (embedIden1 f)
+
+umap :: (IsNode n d ch b) => (n -> n) -> n -> n
+umap f = runIdentity . umapM (embedIden1 f)
+
+dmapLR' :: (IsNode n d ch b) => (BinderList b, BinderList b -> n -> Recur n) -> n -> n
+dmapLR' f = runIdentity . dmapLRM' (embedIdenP2 f)
+
+dmapL' :: (IsNode n d ch b) => (BinderList b, BinderList b -> n -> n) -> n -> n
+dmapL' f = runIdentity . dmapLM' (embedIdenP2 f)
+
+umapL' :: (IsNode n d ch b) => (BinderList b, BinderList b -> n -> n) -> n -> n
+umapL' f = runIdentity . umapLM' (embedIdenP2 f)
+
+dmapNR' :: (IsNode n d ch b) => (Level, Level -> n -> Recur n) -> n -> n
+dmapNR' f = runIdentity . dmapNRM' (embedIdenP2 f)
+
+dmapN' :: (IsNode n d ch b) => (Level, Level -> n -> n) -> n -> n
+dmapN' f = runIdentity . dmapNM' (embedIdenP2 f)
+
+umapN' :: (IsNode n d ch b) => (Level, Level -> n -> n) -> n -> n
+umapN' f = runIdentity . umapNM' (embedIdenP2 f)
+
+dmapCLM' :: (IsNode n d ch b, Monad m) => (BinderList b, c -> BinderList b -> n -> m (c, n)) -> c -> n -> m n
+dmapCLM' f ini = dmapG (pairCollector (identityCollector ini) (binderInfoCollector' (fst f))) (\(c, bi) -> fromPair bi . snd f c bi)
+
+dmapCLRM' :: (IsNode n d ch b, Monad m) => (BinderList b, c -> BinderList b -> n -> m (Recur' n c)) -> c -> n -> m n
+dmapCLRM' f ini = dmapG (pairCollector (identityCollector ini) (binderInfoCollector' (fst f))) (\(c, bi) -> fromRecur' bi . snd f c bi)
+
+dmapCNRM' :: (IsNode n d ch b, Monad m) => (Level, c -> Level -> n -> m (Recur' n c)) -> c -> n -> m n
+dmapCNRM' f ini = dmapG (pairCollector (identityCollector ini) (binderNumCollector' (fst f))) (\(c, bi) -> fromRecur' bi . snd f c bi)
+
+dmapCLM :: (IsNode n d ch b, Monad m) => (c -> BinderList b -> n -> m (c, n)) -> c -> n -> m n
+dmapCLM f = dmapCLM' (mempty, f)
+
+dmapCNM' :: (IsNode n d ch b, Monad m) => (Level, c -> Level -> n -> m (c, n)) -> c -> n -> m n
+dmapCNM' f ini = dmapG (pairCollector (identityCollector ini) (binderNumCollector' (fst f))) (\(c, bi) -> fromPair bi . snd f c bi)
+
+dmapCNM :: (IsNode n d ch b, Monad m) => (c -> Level -> n -> m (c, n)) -> c -> n -> m n
+dmapCNM f = dmapCNM' (0, f)
+
+dmapCM :: (IsNode n d ch b, Monad m) => (c -> n -> m (c, n)) -> c -> n -> m n
+dmapCM f ini = dmapG (identityCollector ini) (\c -> fmap Recur' . f c)
+
+dmapCL' :: (IsNode n d ch b) => (BinderList b, c -> BinderList b -> n -> (c, n)) -> c -> n -> n
+dmapCL' f ini = runIdentity . dmapCLM' (embedIdenP3 f) ini
+
+dmapCLR' :: (IsNode n d ch b) => (BinderList b, c -> BinderList b -> n -> Recur' n c) -> c -> n -> n
+dmapCLR' f ini = runIdentity . dmapCLRM' (embedIdenP3 f) ini
+
+dmapCN' :: (IsNode n d ch b) => (Level, c -> Level -> n -> (c, n)) -> c -> n -> n
+dmapCN' f ini = runIdentity . dmapCNM' (embedIdenP3 f) ini
+
+dmapCNR' :: (IsNode n d ch b) => (Level, c -> Level -> n -> Recur' n c) -> c -> n -> n
+dmapCNR' f ini = runIdentity . dmapCNRM' (embedIdenP3 f) ini
+
+dmapCL :: (IsNode n d ch b) => (c -> BinderList b -> n -> (c, n)) -> c -> n -> n
+dmapCL f ini = runIdentity . dmapCLM (embedIden3 f) ini
+
+dmapCN :: (IsNode n d ch b) => (c -> Level -> n -> (c, n)) -> c -> n -> n
+dmapCN f ini = runIdentity . dmapCNM (embedIden3 f) ini
+
+dmapC :: (IsNode n d ch b) => (c -> n -> (c, n)) -> c -> n -> n
+dmapC f ini = runIdentity . dmapCM (embedIden2 f) ini
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Recur.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Recur.hs
new file mode 100644
index 0000000000..47f8bd1df6
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Generic/Recur.hs
@@ -0,0 +1,9 @@
+module Juvix.Compiler.Core.Extra.Recursors.Generic.Recur where
+
+data Recur' n c
+  = End' n
+  | Recur' (c, n)
+
+data Recur n
+  = End n
+  | Recur n
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Map.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Map.hs
index 9fed6c64f7..74caff91c0 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Map.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Map.hs
@@ -1,67 +1,6 @@
-{-# LANGUAGE UndecidableInstances #-}
+module Juvix.Compiler.Core.Extra.Recursors.Map
+  ( module Juvix.Compiler.Core.Extra.Recursors.Generic.Map,
+  )
+where
 
-module Juvix.Compiler.Core.Extra.Recursors.Map where
-
-import Juvix.Compiler.Core.Extra.Base
-import Juvix.Compiler.Core.Extra.Recursors.Base
-
--- | `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
--- recursive subnodes have already been mapped
-umapG ::
-  forall c m.
-  (Monad m) =>
-  Collector (Int, [Binder]) c ->
-  (c -> Node -> m Node) ->
-  Node ->
-  m Node
-umapG coll f = go (coll ^. cEmpty)
-  where
-    go :: c -> Node -> m Node
-    go c n =
-      let ni = destruct n
-       in do
-            ns <- mapM (\n' -> go ((coll ^. cCollect) (n' ^. childBindersNum, n' ^. childBinders) c) (n' ^. childNode)) (ni ^. nodeChildren)
-            f c (reassembleDetails ni ns)
-
-dmapG ::
-  forall c m.
-  (Monad m) =>
-  Collector (Int, [Binder]) c ->
-  (c -> Node -> m (Recur' c)) ->
-  Node ->
-  m Node
-dmapG coll f = go (coll ^. cEmpty)
-  where
-    go :: c -> Node -> m Node
-    go c n = do
-      r <- f c n
-      case r of
-        End' n' -> return n'
-        Recur' (c', n') ->
-          let ni = destruct n'
-           in reassembleDetails ni <$> mapM goChild (ni ^. nodeChildren)
-          where
-            goChild :: NodeChild -> m Node
-            goChild ch = go ((coll ^. cCollect) (ch ^. childBindersNum, ch ^. childBinders) c') (ch ^. childNode)
-
-fromSimple :: (Functor g) => c -> g Node -> g (Recur' c)
-fromSimple c = fmap (\x -> Recur' (c, x))
-
-fromRecur :: (Functor g) => c -> g Recur -> g (Recur' c)
-fromRecur c =
-  fmap
-    ( \case
-        End x -> End' x
-        Recur x -> Recur' (c, x)
-    )
-
-fromPair :: (Functor g) => d -> g (c, Node) -> g (Recur' (c, d))
-fromPair d = fmap (\(c, x) -> Recur' ((c, d), x))
-
-fromRecur' :: (Functor g) => d -> g (Recur' c) -> g (Recur' (c, d))
-fromRecur' d =
-  fmap
-    ( \case
-        End' x -> End' x
-        Recur' (c, x) -> Recur' ((c, d), x)
-    )
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Map
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Map/Named.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Map/Named.hs
index 2f1660a2f2..6d135af7f3 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Map/Named.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Map/Named.hs
@@ -1,176 +1,8 @@
-module Juvix.Compiler.Core.Extra.Recursors.Map.Named where
+module Juvix.Compiler.Core.Extra.Recursors.Map.Named
+  ( module Juvix.Compiler.Core.Extra.Recursors.Generic.Map.Named,
+    module Juvix.Compiler.Core.Extra.Recursors.Base,
+  )
+where
 
-import Data.Functor.Identity
 import Juvix.Compiler.Core.Extra.Recursors.Base
-import Juvix.Compiler.Core.Extra.Recursors.Classes
-import Juvix.Compiler.Core.Extra.Recursors.Map
-
-{-
-
-The mapping recursors come in three major variants: dmap, umap and rmap. They
-map each subterm of a given term.
-
-1. `dmap f t` goes through the node `t` top-down, applying the function `f` to
-`t` first, and then recursively descending into the children of `f t`.
-
-2. `umap f t` goes through the term `t` bottom-up, first recursively descending
-into the children of `t` and mapping them with `umap f`, then reassembling `t`
-with the mapped children into `t'`, and finally applying `f` to `t'`.
-
-3. `rmap f t`: see Recursors.RMap.Named.
-
-The suffixes of `dmap`, `umap` and `rmap` indicate the exact form of the mapping
-function `f`, what arguments are provided to it and how its return value is
-interpreted.
-
-- M: Monadic version. The return value of the mapping function `f` is wrapped in
-  a monad.
-- L: The function `f` receives as an argument the list of binders upwards in the
-  term. The n-th element of the binder list corresponds to the free variable of
-  the current subterm with de Bruijn index n.
-- N: The function `f` receives as an argument the number of binders upwards in
-  the term, i.e., the current de Bruijn level.
-- ': When combined with L or N, makes it possible to supply the initial binder
-  list or de Bruijn level. This is useful when mapping a subterm with free
-  variables.
-- R: The function `f` returns an element of the `Recur` (or `Recur'`) datatype,
-  indicating whether `dmap` should descend into the children or stop the
-  traversal.
-- C: Enables collecting an arbitrary value while going downward in the term tree
-  with `dmap`. The initial value is provided to `dmap`. The function `f`
-  receives as an argument the current collected value and returns the value for
-  the children, in addition to the new node.
-
--}
-
-dmapLRM :: (Monad m) => (BinderList Binder -> Node -> m Recur) -> Node -> m Node
-dmapLRM f = dmapLRM' (mempty, f)
-
-dmapLM :: (Monad m) => (BinderList Binder -> Node -> m Node) -> Node -> m Node
-dmapLM f = dmapLM' (mempty, f)
-
-umapLM :: (Monad m) => (BinderList Binder -> Node -> m Node) -> Node -> m Node
-umapLM f = umapG binderInfoCollector f
-
-dmapNRM :: (Monad m) => (Level -> Node -> m Recur) -> Node -> m Node
-dmapNRM f = dmapNRM' (0, f)
-
-dmapNM :: (Monad m) => (Level -> Node -> m Node) -> Node -> m Node
-dmapNM f = dmapNM' (0, f)
-
-umapNM :: (Monad m) => (Level -> Node -> m Node) -> Node -> m Node
-umapNM f = umapG binderNumCollector f
-
-dmapRM :: (Monad m) => (Node -> m Recur) -> Node -> m Node
-dmapRM f = dmapG unitCollector (const (fromRecur mempty . f))
-
-dmapM :: (Monad m) => (Node -> m Node) -> Node -> m Node
-dmapM f = dmapG unitCollector (const (fromSimple mempty . f))
-
-umapM :: (Monad m) => (Node -> m Node) -> Node -> m Node
-umapM f = umapG unitCollector (const f)
-
-dmapLRM' :: (Monad m) => (BinderList Binder, BinderList Binder -> Node -> m Recur) -> Node -> m Node
-dmapLRM' f = dmapG (binderInfoCollector' (fst f)) (\bi -> fromRecur bi . snd f bi)
-
-dmapLM' :: (Monad m) => (BinderList Binder, BinderList Binder -> Node -> m Node) -> Node -> m Node
-dmapLM' f = dmapG (binderInfoCollector' (fst f)) (\bi -> fromSimple bi . snd f bi)
-
-umapLM' :: (Monad m) => (BinderList Binder, BinderList Binder -> Node -> m Node) -> Node -> m Node
-umapLM' f = umapG (binderInfoCollector' (fst f)) (snd f)
-
-dmapNRM' :: (Monad m) => (Level, Level -> Node -> m Recur) -> Node -> m Node
-dmapNRM' f = dmapG (binderNumCollector' (fst f)) (\bi -> fromRecur bi . snd f bi)
-
-dmapNM' :: (Monad m) => (Level, Level -> Node -> m Node) -> Node -> m Node
-dmapNM' f = dmapG (binderNumCollector' (fst f)) (\bi -> fromSimple bi . snd f bi)
-
-umapNM' :: (Monad m) => (Level, Level -> Node -> m Node) -> Node -> m Node
-umapNM' f = umapG (binderNumCollector' (fst f)) (snd f)
-
-dmapLR :: (BinderList Binder -> Node -> Recur) -> Node -> Node
-dmapLR f = runIdentity . dmapLRM (embedIden f)
-
-dmapL :: (BinderList Binder -> Node -> Node) -> Node -> Node
-dmapL f = runIdentity . dmapLM (embedIden f)
-
-umapL :: (BinderList Binder -> Node -> Node) -> Node -> Node
-umapL f = runIdentity . umapLM (embedIden f)
-
-dmapNR :: (Level -> Node -> Recur) -> Node -> Node
-dmapNR f = runIdentity . dmapNRM (embedIden f)
-
-dmapN :: (Level -> Node -> Node) -> Node -> Node
-dmapN f = runIdentity . dmapNM (embedIden f)
-
-umapN :: (Level -> Node -> Node) -> Node -> Node
-umapN f = runIdentity . umapNM (embedIden f)
-
-dmapR :: (Node -> Recur) -> Node -> Node
-dmapR f = runIdentity . dmapRM (embedIden f)
-
-dmap :: (Node -> Node) -> Node -> Node
-dmap f = runIdentity . dmapM (embedIden f)
-
-umap :: (Node -> Node) -> Node -> Node
-umap f = runIdentity . umapM (embedIden f)
-
-dmapLR' :: (BinderList Binder, BinderList Binder -> Node -> Recur) -> Node -> Node
-dmapLR' f = runIdentity . dmapLRM' (embedIden f)
-
-dmapL' :: (BinderList Binder, BinderList Binder -> Node -> Node) -> Node -> Node
-dmapL' f = runIdentity . dmapLM' (embedIden f)
-
-umapL' :: (BinderList Binder, BinderList Binder -> Node -> Node) -> Node -> Node
-umapL' f = runIdentity . umapLM' (embedIden f)
-
-dmapNR' :: (Level, Level -> Node -> Recur) -> Node -> Node
-dmapNR' f = runIdentity . dmapNRM' (embedIden f)
-
-dmapN' :: (Level, Level -> Node -> Node) -> Node -> Node
-dmapN' f = runIdentity . dmapNM' (embedIden f)
-
-umapN' :: (Level, Level -> Node -> Node) -> Node -> Node
-umapN' f = runIdentity . umapNM' (embedIden f)
-
-dmapCLM' :: (Monad m) => (BinderList Binder, c -> BinderList Binder -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCLM' f ini = dmapG (pairCollector (identityCollector ini) (binderInfoCollector' (fst f))) (\(c, bi) -> fromPair bi . snd f c bi)
-
-dmapCLRM' :: (Monad m) => (BinderList Binder, c -> BinderList Binder -> Node -> m (Recur' c)) -> c -> Node -> m Node
-dmapCLRM' f ini = dmapG (pairCollector (identityCollector ini) (binderInfoCollector' (fst f))) (\(c, bi) -> fromRecur' bi . snd f c bi)
-
-dmapCNRM' :: (Monad m) => (Level, c -> Level -> Node -> m (Recur' c)) -> c -> Node -> m Node
-dmapCNRM' f ini = dmapG (pairCollector (identityCollector ini) (binderNumCollector' (fst f))) (\(c, bi) -> fromRecur' bi . snd f c bi)
-
-dmapCLM :: (Monad m) => (c -> BinderList Binder -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCLM f = dmapCLM' (mempty, f)
-
-dmapCNM' :: (Monad m) => (Level, c -> Level -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCNM' f ini = dmapG (pairCollector (identityCollector ini) (binderNumCollector' (fst f))) (\(c, bi) -> fromPair bi . snd f c bi)
-
-dmapCNM :: (Monad m) => (c -> Level -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCNM f = dmapCNM' (0, f)
-
-dmapCM :: (Monad m) => (c -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCM f ini = dmapG (identityCollector ini) (\c -> fmap Recur' . f c)
-
-dmapCL' :: (BinderList Binder, c -> BinderList Binder -> Node -> (c, Node)) -> c -> Node -> Node
-dmapCL' f ini = runIdentity . dmapCLM' (embedIden f) ini
-
-dmapCLR' :: (BinderList Binder, c -> BinderList Binder -> Node -> Recur' c) -> c -> Node -> Node
-dmapCLR' f ini = runIdentity . dmapCLRM' (embedIden f) ini
-
-dmapCN' :: (Level, c -> Level -> Node -> (c, Node)) -> c -> Node -> Node
-dmapCN' f ini = runIdentity . dmapCNM' (embedIden f) ini
-
-dmapCNR' :: (Level, c -> Level -> Node -> Recur' c) -> c -> Node -> Node
-dmapCNR' f ini = runIdentity . dmapCNRM' (embedIden f) ini
-
-dmapCL :: (c -> BinderList Binder -> Node -> (c, Node)) -> c -> Node -> Node
-dmapCL f ini = runIdentity . dmapCLM (embedIden f) ini
-
-dmapCN :: (c -> Level -> Node -> (c, Node)) -> c -> Node -> Node
-dmapCN f ini = runIdentity . dmapCNM (embedIden f) ini
-
-dmapC :: (c -> Node -> (c, Node)) -> c -> Node -> Node
-dmapC f ini = runIdentity . dmapCM (embedIden f) ini
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Map.Named
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Recur.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Recur.hs
index adec88b8bf..5b89147a8a 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Recur.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Recur.hs
@@ -1,30 +1,19 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
+{-# HLINT ignore "Avoid restricted extensions" #-}
 {-# HLINT ignore "Avoid restricted flags" #-}
 
-module Juvix.Compiler.Core.Extra.Recursors.Recur where
+module Juvix.Compiler.Core.Extra.Recursors.Recur
+  ( module Juvix.Compiler.Core.Extra.Recursors.Recur,
+    module Juvix.Compiler.Core.Extra.Recursors.Generic.Recur,
+  )
+where
 
-import Data.Functor.Identity
-import Juvix.Compiler.Core.Extra.Recursors.Classes
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Recur (pattern End, pattern End', pattern Recur, pattern Recur')
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Recur qualified as G
 import Juvix.Compiler.Core.Language
 
-data Recur' c
-  = End' Node
-  | Recur' (c, Node)
+type Recur' c = G.Recur' Node c
 
-data Recur
-  = End Node
-  | Recur Node
-
-instance EmbedIdentity' (c, Node) where
-  embedIden' = Identity
-
-instance EmbedIdentity' Node where
-  embedIden' = Identity
-
-instance EmbedIdentity' Recur where
-  embedIden' = Identity
-
-instance EmbedIdentity' (Recur' c) where
-  embedIden' = Identity
+type Recur = G.Recur Node
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Utils.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Utils.hs
index 6d8ffe8776..7712abc5cc 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Utils.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Utils.hs
@@ -1,7 +1,6 @@
 module Juvix.Compiler.Core.Extra.Recursors.Utils where
 
 import Juvix.Compiler.Core.Extra.Recursors.Map.Named
-import Juvix.Compiler.Core.Language
 
 shiftVar :: Index -> Var -> Var
 shiftVar m = over varIndex (+ m)
diff --git a/src/Juvix/Compiler/Core/Extra/Utils.hs b/src/Juvix/Compiler/Core/Extra/Utils.hs
index a5186711a0..171ecdaead 100644
--- a/src/Juvix/Compiler/Core/Extra/Utils.hs
+++ b/src/Juvix/Compiler/Core/Extra/Utils.hs
@@ -30,7 +30,6 @@ import Juvix.Compiler.Core.Extra.Utils.Base
 import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Info.ExpansionInfo
 import Juvix.Compiler.Core.Info.LocationInfo qualified as Info
-import Juvix.Compiler.Core.Language
 
 substEnvInBranch :: Env -> CaseBranch -> CaseBranch
 substEnvInBranch env br = over caseBranchBody (substEnv env') br
diff --git a/src/Juvix/Compiler/Core/Extra/Utils/Base.hs b/src/Juvix/Compiler/Core/Extra/Utils/Base.hs
index 245de6b61b..e5a02d791d 100644
--- a/src/Juvix/Compiler/Core/Extra/Utils/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Utils/Base.hs
@@ -6,7 +6,6 @@ module Juvix.Compiler.Core.Extra.Utils.Base where
 import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Extra.Recursors
 import Juvix.Compiler.Core.Extra.Recursors.Utils
-import Juvix.Compiler.Core.Language
 
 -- | substitution of all free variables for values in an environment
 substEnv :: Env -> Node -> Node
diff --git a/src/Juvix/Compiler/Core/Extra/Value.hs b/src/Juvix/Compiler/Core/Extra/Value.hs
index 96c22d6fad..c8b7bee189 100644
--- a/src/Juvix/Compiler/Core/Extra/Value.hs
+++ b/src/Juvix/Compiler/Core/Extra/Value.hs
@@ -5,7 +5,6 @@ import Juvix.Compiler.Core.Extra.Base
 import Juvix.Compiler.Core.Extra.Utils
 import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Info.ExpansionInfo (kExpansionInfo)
-import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Language.Value
 
 toValue :: InfoTable -> Node -> Value
diff --git a/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs b/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs
index ec8f275c7a..2a665ab4e5 100644
--- a/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs
+++ b/src/Juvix/Compiler/Core/Info/FreeVarsInfo.hs
@@ -3,7 +3,6 @@ module Juvix.Compiler.Core.Info.FreeVarsInfo where
 import Data.Map qualified as Map
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info qualified as Info
-import Juvix.Compiler.Core.Language
 
 newtype FreeVarsInfo = FreeVarsInfo
   { -- map free variables to the number of their occurrences
diff --git a/src/Juvix/Compiler/Core/Scoper.hs b/src/Juvix/Compiler/Core/Scoper.hs
index f2fe9f11fa..17786ed49b 100644
--- a/src/Juvix/Compiler/Core/Scoper.hs
+++ b/src/Juvix/Compiler/Core/Scoper.hs
@@ -2,7 +2,6 @@ module Juvix.Compiler.Core.Scoper where
 
 import Juvix.Compiler.Core.Data.InfoTable
 import Juvix.Compiler.Core.Extra
-import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Pretty
 import Juvix.Compiler.Core.Transformation.Base
 
diff --git a/src/Juvix/Compiler/Core/Transformation/Check/Base.hs b/src/Juvix/Compiler/Core/Transformation/Check/Base.hs
index 421be2cb67..07e10c881b 100644
--- a/src/Juvix/Compiler/Core/Transformation/Check/Base.hs
+++ b/src/Juvix/Compiler/Core/Transformation/Check/Base.hs
@@ -8,7 +8,6 @@ import Juvix.Compiler.Core.Error
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info.LocationInfo (getInfoLocation, getNodeLocation)
 import Juvix.Compiler.Core.Info.TypeInfo qualified as Info
-import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Transformation.Base (mapT')
 import Juvix.Data.NameKind
 import Juvix.Data.PPOutput
diff --git a/src/Juvix/Compiler/Core/Transformation/LambdaLetRecLifting.hs b/src/Juvix/Compiler/Core/Transformation/LambdaLetRecLifting.hs
index ab783ff03a..6d37429620 100644
--- a/src/Juvix/Compiler/Core/Transformation/LambdaLetRecLifting.hs
+++ b/src/Juvix/Compiler/Core/Transformation/LambdaLetRecLifting.hs
@@ -9,7 +9,6 @@ import Juvix.Compiler.Core.Data.InfoTableBuilder
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info.NameInfo
 import Juvix.Compiler.Core.Info.PragmaInfo
-import Juvix.Compiler.Core.Pretty
 import Juvix.Compiler.Core.Transformation.Base
 import Juvix.Compiler.Core.Transformation.ComputeTypeInfo (computeNodeType)
 
diff --git a/src/Juvix/Compiler/Core/Transformation/LetHoisting.hs b/src/Juvix/Compiler/Core/Transformation/LetHoisting.hs
index 2e301ef493..7d9e720f12 100644
--- a/src/Juvix/Compiler/Core/Transformation/LetHoisting.hs
+++ b/src/Juvix/Compiler/Core/Transformation/LetHoisting.hs
@@ -16,7 +16,6 @@ import Juvix.Compiler.Core.Data.BinderList qualified as BL
 import Juvix.Compiler.Core.Data.InfoTableBuilder
 import Juvix.Compiler.Core.Extra.Recursors.Map.Named
 import Juvix.Compiler.Core.Extra.Utils
-import Juvix.Compiler.Core.Pretty
 import Juvix.Compiler.Core.Transformation.Base
 
 data LItem = LItem
diff --git a/src/Juvix/Compiler/Core/Transformation/NaiveMatchToCase.hs b/src/Juvix/Compiler/Core/Transformation/NaiveMatchToCase.hs
index 356dbb0b35..34307e8691 100644
--- a/src/Juvix/Compiler/Core/Transformation/NaiveMatchToCase.hs
+++ b/src/Juvix/Compiler/Core/Transformation/NaiveMatchToCase.hs
@@ -3,7 +3,6 @@ module Juvix.Compiler.Core.Transformation.NaiveMatchToCase where
 import Juvix.Compiler.Core.Data.InfoTableBuilder
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info.NameInfo (setInfoName)
-import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Transformation.Base
 import Juvix.Compiler.Core.Transformation.NaiveMatchToCase.Data
 
diff --git a/src/Juvix/Compiler/Core/Transformation/NaiveMatchToCase/Data.hs b/src/Juvix/Compiler/Core/Transformation/NaiveMatchToCase/Data.hs
index 599de226dd..5cab0e00fb 100644
--- a/src/Juvix/Compiler/Core/Transformation/NaiveMatchToCase/Data.hs
+++ b/src/Juvix/Compiler/Core/Transformation/NaiveMatchToCase/Data.hs
@@ -1,7 +1,6 @@
 module Juvix.Compiler.Core.Transformation.NaiveMatchToCase.Data where
 
 import Juvix.Compiler.Core.Extra
-import Juvix.Compiler.Core.Language
 
 -- | A CompiledBinder is either a binder that was present in the original match (OriginalBinder)
 -- or an additional binder that was added during the compilation (AuxiliaryBinder)
diff --git a/src/Juvix/Compiler/Core/Translation/FromInternal.hs b/src/Juvix/Compiler/Core/Translation/FromInternal.hs
index 85054051f0..a6bb82b3aa 100644
--- a/src/Juvix/Compiler/Core/Translation/FromInternal.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromInternal.hs
@@ -8,7 +8,6 @@ import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Info.LocationInfo
 import Juvix.Compiler.Core.Info.NameInfo
 import Juvix.Compiler.Core.Info.PragmaInfo
-import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Pretty qualified as Core
 import Juvix.Compiler.Core.Translation.FromInternal.Builtins.Int
 import Juvix.Compiler.Core.Translation.FromInternal.Builtins.Nat
diff --git a/src/Juvix/Compiler/Core/Translation/FromInternal/Builtins/Int.hs b/src/Juvix/Compiler/Core/Translation/FromInternal/Builtins/Int.hs
index 073885d860..766171298d 100644
--- a/src/Juvix/Compiler/Core/Translation/FromInternal/Builtins/Int.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromInternal/Builtins/Int.hs
@@ -3,7 +3,6 @@ module Juvix.Compiler.Core.Translation.FromInternal.Builtins.Int where
 import Juvix.Compiler.Core.Data
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info.NameInfo
-import Juvix.Compiler.Core.Language
 
 -- | Returns the node representing a function Int -> Int that transforms literal
 -- integers to builtin Int.
diff --git a/src/Juvix/Compiler/Core/Translation/FromInternal/Builtins/Nat.hs b/src/Juvix/Compiler/Core/Translation/FromInternal/Builtins/Nat.hs
index a7b2250f6c..f63ba233d4 100644
--- a/src/Juvix/Compiler/Core/Translation/FromInternal/Builtins/Nat.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromInternal/Builtins/Nat.hs
@@ -3,7 +3,6 @@ module Juvix.Compiler.Core.Translation.FromInternal.Builtins.Nat where
 import Juvix.Compiler.Core.Data
 import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info.NameInfo
-import Juvix.Compiler.Core.Language
 
 -- | Returns the node representing a function Int -> Nat that is used to transform
 -- literal integers to builtin Nat. The symbol representing the literalIntToNat function is passed
diff --git a/src/Juvix/Compiler/Core/Translation/FromSource.hs b/src/Juvix/Compiler/Core/Translation/FromSource.hs
index 9f0b951966..cab92c5dd8 100644
--- a/src/Juvix/Compiler/Core/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Core/Translation/FromSource.hs
@@ -15,7 +15,6 @@ import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Info.LocationInfo as LocationInfo
 import Juvix.Compiler.Core.Info.NameInfo as NameInfo
-import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Transformation.Eta
 import Juvix.Compiler.Core.Translation.FromSource.Lexer
 import Juvix.Extra.Strings qualified as Str
diff --git a/src/Juvix/Compiler/Store/Core/Extra.hs b/src/Juvix/Compiler/Store/Core/Extra.hs
index 9cc71bcaff..213f8ad19f 100644
--- a/src/Juvix/Compiler/Store/Core/Extra.hs
+++ b/src/Juvix/Compiler/Store/Core/Extra.hs
@@ -2,7 +2,6 @@ module Juvix.Compiler.Store.Core.Extra where
 
 import Juvix.Compiler.Core.Data.InfoTable qualified as Core
 import Juvix.Compiler.Core.Extra qualified as Core
-import Juvix.Compiler.Core.Language qualified as Core
 import Juvix.Compiler.Store.Core.Data.InfoTable
 import Juvix.Compiler.Store.Core.Language
 
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors.hs b/src/Juvix/Compiler/Tree/Extra/Recursors.hs
new file mode 100644
index 0000000000..67d453b0d8
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Extra/Recursors.hs
@@ -0,0 +1,10 @@
+module Juvix.Compiler.Tree.Extra.Recursors
+  ( module Juvix.Compiler.Core.Extra.Recursors.Generic.Map.Named,
+    module Juvix.Compiler.Core.Extra.Recursors.Generic.Fold.Named,
+    module Juvix.Compiler.Tree.Extra.Recursors.Base,
+  )
+where
+
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Fold.Named
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Map.Named
+import Juvix.Compiler.Tree.Extra.Recursors.Base
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Base.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Base.hs
index 64b060cad6..8d3d0dd745 100644
--- a/src/Juvix/Compiler/Tree/Extra/Recursors/Base.hs
+++ b/src/Juvix/Compiler/Tree/Extra/Recursors/Base.hs
@@ -1,12 +1,30 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Avoid restricted flags" #-}
 module Juvix.Compiler.Tree.Extra.Recursors.Base
   ( module Juvix.Compiler.Core.Data.BinderList,
     module Juvix.Compiler.Tree.Language,
-    module Juvix.Compiler.Core.Extra.Recursors.Collector,
+    module Juvix.Compiler.Core.Extra.Recursors.Generic.Collector,
     module Juvix.Compiler.Tree.Extra.Recursors.Recur,
   )
 where
 
 import Juvix.Compiler.Core.Data.BinderList (BinderList)
-import Juvix.Compiler.Core.Extra.Recursors.Collector
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Base
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Collector
+import Juvix.Compiler.Tree.Extra.Base
 import Juvix.Compiler.Tree.Extra.Recursors.Recur
 import Juvix.Compiler.Tree.Language
+
+instance IsNodeChild NodeChild TempVarInfo where
+  gBindersNum = fromEnum . isJust . (^. childTempVarInfo)
+  gBinders = toList . (^. childTempVarInfo)
+
+instance IsNodeDetails NodeDetails NodeChild where
+  gChildren = (^. nodeChildren)
+
+instance IsNode Node NodeDetails NodeChild TempVarInfo where
+  gDestruct = destruct
+  gReassemble = reassembleDetails
+  gChild = (^. childNode)
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Map.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Map.hs
deleted file mode 100644
index f1d9e1a59a..0000000000
--- a/src/Juvix/Compiler/Tree/Extra/Recursors/Map.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-module Juvix.Compiler.Tree.Extra.Recursors.Map where
-
-import Juvix.Compiler.Tree.Extra.Base
-import Juvix.Compiler.Tree.Extra.Recursors.Base
-
--- | `umapG` maps the nodes bottom-up, i.e., when invoking the mapper function the
--- recursive subnodes have already been mapped
-umapG ::
-  forall c m.
-  (Monad m) =>
-  Collector (Int, [TempVarInfo]) c ->
-  (c -> Node -> m Node) ->
-  Node ->
-  m Node
-umapG coll f = go (coll ^. cEmpty)
-  where
-    go :: c -> Node -> m Node
-    go c n =
-      let ni = destruct n
-       in do
-            ns <- mapM (\n' -> go ((coll ^. cCollect) (fromEnum (isJust (n' ^. childTempVarInfo)), toList (n' ^. childTempVarInfo)) c) (n' ^. childNode)) (ni ^. nodeChildren)
-            f c (reassembleDetails ni ns)
-
-dmapG ::
-  forall c m.
-  (Monad m) =>
-  Collector (Int, [TempVarInfo]) c ->
-  (c -> Node -> m (Recur' c)) ->
-  Node ->
-  m Node
-dmapG coll f = go (coll ^. cEmpty)
-  where
-    go :: c -> Node -> m Node
-    go c n = do
-      r <- f c n
-      case r of
-        End' n' -> return n'
-        Recur' (c', n') ->
-          let ni = destruct n'
-           in reassembleDetails ni <$> mapM goChild (ni ^. nodeChildren)
-          where
-            goChild :: NodeChild -> m Node
-            goChild ch = go ((coll ^. cCollect) (fromEnum (isJust (ch ^. childTempVarInfo)), toList (ch ^. childTempVarInfo)) c') (ch ^. childNode)
-
-fromSimple :: (Functor g) => c -> g Node -> g (Recur' c)
-fromSimple c = fmap (\x -> Recur' (c, x))
-
-fromRecur :: (Functor g) => c -> g Recur -> g (Recur' c)
-fromRecur c =
-  fmap
-    ( \case
-        End x -> End' x
-        Recur x -> Recur' (c, x)
-    )
-
-fromPair :: (Functor g) => d -> g (c, Node) -> g (Recur' (c, d))
-fromPair d = fmap (\(c, x) -> Recur' ((c, d), x))
-
-fromRecur' :: (Functor g) => d -> g (Recur' c) -> g (Recur' (c, d))
-fromRecur' d =
-  fmap
-    ( \case
-        End' x -> End' x
-        Recur' (c, x) -> Recur' ((c, d), x)
-    )
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Map/Named.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Map/Named.hs
deleted file mode 100644
index b4e2da22f4..0000000000
--- a/src/Juvix/Compiler/Tree/Extra/Recursors/Map/Named.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-module Juvix.Compiler.Tree.Extra.Recursors.Map.Named where
-
-import Data.Functor.Identity
-import Juvix.Compiler.Core.Extra.Recursors.Classes
-import Juvix.Compiler.Tree.Extra.Recursors.Base
-import Juvix.Compiler.Tree.Extra.Recursors.Map
-
-{- See Juvix.Compiler.Core.Extra.Recursors.Map.Named for an explanation of the
-naming conventions. -}
-
-dmapLRM :: (Monad m) => (BinderList TempVarInfo -> Node -> m Recur) -> Node -> m Node
-dmapLRM f = dmapLRM' (mempty, f)
-
-dmapLM :: (Monad m) => (BinderList TempVarInfo -> Node -> m Node) -> Node -> m Node
-dmapLM f = dmapLM' (mempty, f)
-
-umapLM :: (Monad m) => (BinderList TempVarInfo -> Node -> m Node) -> Node -> m Node
-umapLM f = umapG binderInfoCollector f
-
-dmapNRM :: (Monad m) => (Level -> Node -> m Recur) -> Node -> m Node
-dmapNRM f = dmapNRM' (0, f)
-
-dmapNM :: (Monad m) => (Level -> Node -> m Node) -> Node -> m Node
-dmapNM f = dmapNM' (0, f)
-
-umapNM :: (Monad m) => (Level -> Node -> m Node) -> Node -> m Node
-umapNM f = umapG binderNumCollector f
-
-dmapRM :: (Monad m) => (Node -> m Recur) -> Node -> m Node
-dmapRM f = dmapG unitCollector (const (fromRecur mempty . f))
-
-dmapM :: (Monad m) => (Node -> m Node) -> Node -> m Node
-dmapM f = dmapG unitCollector (const (fromSimple mempty . f))
-
-umapM :: (Monad m) => (Node -> m Node) -> Node -> m Node
-umapM f = umapG unitCollector (const f)
-
-dmapLRM' :: (Monad m) => (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> m Recur) -> Node -> m Node
-dmapLRM' f = dmapG (binderInfoCollector' (fst f)) (\bi -> fromRecur bi . snd f bi)
-
-dmapLM' :: (Monad m) => (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> m Node) -> Node -> m Node
-dmapLM' f = dmapG (binderInfoCollector' (fst f)) (\bi -> fromSimple bi . snd f bi)
-
-umapLM' :: (Monad m) => (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> m Node) -> Node -> m Node
-umapLM' f = umapG (binderInfoCollector' (fst f)) (snd f)
-
-dmapNRM' :: (Monad m) => (Level, Level -> Node -> m Recur) -> Node -> m Node
-dmapNRM' f = dmapG (binderNumCollector' (fst f)) (\bi -> fromRecur bi . snd f bi)
-
-dmapNM' :: (Monad m) => (Level, Level -> Node -> m Node) -> Node -> m Node
-dmapNM' f = dmapG (binderNumCollector' (fst f)) (\bi -> fromSimple bi . snd f bi)
-
-umapNM' :: (Monad m) => (Level, Level -> Node -> m Node) -> Node -> m Node
-umapNM' f = umapG (binderNumCollector' (fst f)) (snd f)
-
-dmapLR :: (BinderList TempVarInfo -> Node -> Recur) -> Node -> Node
-dmapLR f = runIdentity . dmapLRM (embedIden f)
-
-dmapL :: (BinderList TempVarInfo -> Node -> Node) -> Node -> Node
-dmapL f = runIdentity . dmapLM (embedIden f)
-
-umapL :: (BinderList TempVarInfo -> Node -> Node) -> Node -> Node
-umapL f = runIdentity . umapLM (embedIden f)
-
-dmapNR :: (Level -> Node -> Recur) -> Node -> Node
-dmapNR f = runIdentity . dmapNRM (embedIden f)
-
-dmapN :: (Level -> Node -> Node) -> Node -> Node
-dmapN f = runIdentity . dmapNM (embedIden f)
-
-umapN :: (Level -> Node -> Node) -> Node -> Node
-umapN f = runIdentity . umapNM (embedIden f)
-
-dmapR :: (Node -> Recur) -> Node -> Node
-dmapR f = runIdentity . dmapRM (embedIden f)
-
-dmap :: (Node -> Node) -> Node -> Node
-dmap f = runIdentity . dmapM (embedIden f)
-
-umap :: (Node -> Node) -> Node -> Node
-umap f = runIdentity . umapM (embedIden f)
-
-dmapLR' :: (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> Recur) -> Node -> Node
-dmapLR' f = runIdentity . dmapLRM' (embedIden f)
-
-dmapL' :: (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> Node) -> Node -> Node
-dmapL' f = runIdentity . dmapLM' (embedIden f)
-
-umapL' :: (BinderList TempVarInfo, BinderList TempVarInfo -> Node -> Node) -> Node -> Node
-umapL' f = runIdentity . umapLM' (embedIden f)
-
-dmapNR' :: (Level, Level -> Node -> Recur) -> Node -> Node
-dmapNR' f = runIdentity . dmapNRM' (embedIden f)
-
-dmapN' :: (Level, Level -> Node -> Node) -> Node -> Node
-dmapN' f = runIdentity . dmapNM' (embedIden f)
-
-umapN' :: (Level, Level -> Node -> Node) -> Node -> Node
-umapN' f = runIdentity . umapNM' (embedIden f)
-
-dmapCLM' :: (Monad m) => (BinderList TempVarInfo, c -> BinderList TempVarInfo -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCLM' f ini = dmapG (pairCollector (identityCollector ini) (binderInfoCollector' (fst f))) (\(c, bi) -> fromPair bi . snd f c bi)
-
-dmapCLRM' :: (Monad m) => (BinderList TempVarInfo, c -> BinderList TempVarInfo -> Node -> m (Recur' c)) -> c -> Node -> m Node
-dmapCLRM' f ini = dmapG (pairCollector (identityCollector ini) (binderInfoCollector' (fst f))) (\(c, bi) -> fromRecur' bi . snd f c bi)
-
-dmapCNRM' :: (Monad m) => (Level, c -> Level -> Node -> m (Recur' c)) -> c -> Node -> m Node
-dmapCNRM' f ini = dmapG (pairCollector (identityCollector ini) (binderNumCollector' (fst f))) (\(c, bi) -> fromRecur' bi . snd f c bi)
-
-dmapCLM :: (Monad m) => (c -> BinderList TempVarInfo -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCLM f = dmapCLM' (mempty, f)
-
-dmapCNM' :: (Monad m) => (Level, c -> Level -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCNM' f ini = dmapG (pairCollector (identityCollector ini) (binderNumCollector' (fst f))) (\(c, bi) -> fromPair bi . snd f c bi)
-
-dmapCNM :: (Monad m) => (c -> Level -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCNM f = dmapCNM' (0, f)
-
-dmapCM :: (Monad m) => (c -> Node -> m (c, Node)) -> c -> Node -> m Node
-dmapCM f ini = dmapG (identityCollector ini) (\c -> fmap Recur' . f c)
-
-dmapCL' :: (BinderList TempVarInfo, c -> BinderList TempVarInfo -> Node -> (c, Node)) -> c -> Node -> Node
-dmapCL' f ini = runIdentity . dmapCLM' (embedIden f) ini
-
-dmapCLR' :: (BinderList TempVarInfo, c -> BinderList TempVarInfo -> Node -> Recur' c) -> c -> Node -> Node
-dmapCLR' f ini = runIdentity . dmapCLRM' (embedIden f) ini
-
-dmapCN' :: (Level, c -> Level -> Node -> (c, Node)) -> c -> Node -> Node
-dmapCN' f ini = runIdentity . dmapCNM' (embedIden f) ini
-
-dmapCNR' :: (Level, c -> Level -> Node -> Recur' c) -> c -> Node -> Node
-dmapCNR' f ini = runIdentity . dmapCNRM' (embedIden f) ini
-
-dmapCL :: (c -> BinderList TempVarInfo -> Node -> (c, Node)) -> c -> Node -> Node
-dmapCL f ini = runIdentity . dmapCLM (embedIden f) ini
-
-dmapCN :: (c -> Level -> Node -> (c, Node)) -> c -> Node -> Node
-dmapCN f ini = runIdentity . dmapCNM (embedIden f) ini
-
-dmapC :: (c -> Node -> (c, Node)) -> c -> Node -> Node
-dmapC f ini = runIdentity . dmapCM (embedIden f) ini
diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs
index 574fc3f88f..1f06ff2d98 100644
--- a/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs
+++ b/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs
@@ -1,29 +1,13 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+module Juvix.Compiler.Tree.Extra.Recursors.Recur(
+  module Juvix.Compiler.Tree.Extra.Recursors.Recur,
+  module Juvix.Compiler.Core.Extra.Recursors.Generic.Recur
+) where
 
-{-# HLINT ignore "Avoid restricted flags" #-}
-module Juvix.Compiler.Tree.Extra.Recursors.Recur where
 
-import Data.Functor.Identity
-import Juvix.Compiler.Core.Extra.Recursors.Classes
-import Juvix.Compiler.Tree.Language
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Recur (pattern End, pattern End', pattern Recur, pattern Recur')
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Recur qualified as G
+import Juvix.Compiler.Core.Language
 
-data Recur' c
-  = End' Node
-  | Recur' (c, Node)
+type Recur' c = G.Recur' Node c
 
-data Recur
-  = End Node
-  | Recur Node
-
-instance EmbedIdentity' (c, Node) where
-  embedIden' = Identity
-
-instance EmbedIdentity' Node where
-  embedIden' = Identity
-
-instance EmbedIdentity' Recur where
-  embedIden' = Identity
-
-instance EmbedIdentity' (Recur' c) where
-  embedIden' = Identity
+type Recur = G.Recur Node
diff --git a/test/Core/Eval/Base.hs b/test/Core/Eval/Base.hs
index f5caaa8821..7c7c377e34 100644
--- a/test/Core/Eval/Base.hs
+++ b/test/Core/Eval/Base.hs
@@ -14,7 +14,6 @@ import Juvix.Compiler.Core.Extra
 import Juvix.Compiler.Core.Extra.Value
 import Juvix.Compiler.Core.Info qualified as Info
 import Juvix.Compiler.Core.Info.NoDisplayInfo
-import Juvix.Compiler.Core.Language
 import Juvix.Compiler.Core.Options
 import Juvix.Compiler.Core.Pretty
 import Juvix.Compiler.Core.Transformation
diff --git a/test/Core/Recursor/RMap.hs b/test/Core/Recursor/RMap.hs
index 318ffc6452..d77b6e99f2 100644
--- a/test/Core/Recursor/RMap.hs
+++ b/test/Core/Recursor/RMap.hs
@@ -3,7 +3,6 @@ module Core.Recursor.RMap where
 import Base
 import Core.Recursor.Base
 import Juvix.Compiler.Core.Extra
-import Juvix.Compiler.Core.Language
 
 allTests :: TestTree
 allTests =

From 27b6f2ca23b426483add9b69ab4e84ad29391d6e Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Wed, 24 Jan 2024 18:33:07 +0100
Subject: [PATCH 3/6] remove Recursors/Classes.hs

---
 .../Compiler/Core/Extra/Recursors/Classes.hs  | 59 -------------------
 1 file changed, 59 deletions(-)
 delete mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs

diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs
deleted file mode 100644
index 38480bfc3e..0000000000
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Classes.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-
-module Juvix.Compiler.Core.Extra.Recursors.Classes where
-
-import Data.Functor.Identity
-import Data.Kind qualified as GHC
-import Juvix.Compiler.Core.Extra.Base
-import Juvix.Compiler.Core.Language.Base
-
-type OverIdentity' :: GHC.Type -> GHC.Type
-type family OverIdentity' t = res where
-  OverIdentity' (a -> b) = a -> OverIdentity' b
-  OverIdentity' leaf = Identity leaf
-
-type OverIdentity :: GHC.Type -> GHC.Type
-type family OverIdentity t = res where
-  OverIdentity ((), b) = ((), OverIdentity' b)
-  OverIdentity (BinderList b', b) = (BinderList b', OverIdentity' b)
-  OverIdentity (Index, b) = (Index, OverIdentity' b)
-  OverIdentity leaf = OverIdentity' leaf
-
-class EmbedIdentity a where
-  embedIden :: a -> OverIdentity a
-
-class EmbedIdentity' a where
-  embedIden' :: a -> OverIdentity' a
-
-instance (EmbedIdentity' b) => EmbedIdentity' (a -> b) where
-  embedIden' f = embedIden' . f
-
-instance (EmbedIdentity' b) => EmbedIdentity ((), b) where
-  embedIden (a, b) = (a, embedIden' b)
-
-instance (EmbedIdentity' b) => EmbedIdentity (Index, b) where
-  embedIden (a, b) = (a, embedIden' b)
-
-instance (EmbedIdentity' b) => EmbedIdentity (BinderList b', b) where
-  embedIden (a, b) = (a, embedIden' b)
-
-instance (EmbedIdentity' b) => EmbedIdentity (a -> b) where
-  embedIden a = embedIden' a
-
-embedIden1 :: (a -> b) -> a -> Identity b
-embedIden1 f = Identity . f
-
-embedIden2 :: (a -> b -> c) -> a -> b -> Identity c
-embedIden2 f = embedIden1 . f
-
-embedIden3 :: (a -> b -> c -> d) -> a -> b -> c -> Identity d
-embedIden3 f = embedIden2 . f
-
-embedIdenP1 :: (p, a -> b) -> (p, a -> Identity b)
-embedIdenP1 = second embedIden1
-
-embedIdenP2 :: (p, a -> b -> c) -> (p, a -> b -> Identity c)
-embedIdenP2 = second embedIden2
-
-embedIdenP3 :: (p, a -> b -> c -> d) -> (p, a -> b -> c -> Identity d)
-embedIdenP3 = second embedIden3

From aac91d54fb5ae3f05e88821f8bbc1a8468b50b18 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 25 Jan 2024 12:32:27 +0100
Subject: [PATCH 4/6] transformations

---
 .../Compiler/Core/Data/TransformationId.hs    |  85 +++++--
 .../Core/Data/TransformationId/Base.hs        |  32 +++
 .../Core/Data/TransformationId/Parser.hs      | 235 +-----------------
 .../Core/Data/TransformationId/Parser/Base.hs |  69 +++++
 .../Core/Data/TransformationId/Strings.hs     | 132 ++++++++++
 src/Juvix/Compiler/Core/Extra/Recursors.hs    |   4 +-
 .../Compiler/Core/Extra/Recursors/Base.hs     |   4 +-
 .../Core/Extra/Recursors/Collector.hs         |  44 ----
 .../Compiler/Core/Extra/Recursors/Fold.hs     |   1 -
 .../Compiler/Core/Transformation/Identity.hs  |   1 -
 .../Compiler/Tree/Data/TransformationId.hs    |  42 ++++
 .../Tree/Data/TransformationId/Parser.hs      |  14 ++
 .../Tree/Data/TransformationId/Strings.hs     |  18 ++
 src/Juvix/Compiler/Tree/Transformation.hs     |  19 ++
 .../Compiler/Tree/Transformation/Base.hs      |  43 ++++
 .../Compiler/Tree/Transformation/Identity.hs  |  17 ++
 16 files changed, 455 insertions(+), 305 deletions(-)
 create mode 100644 src/Juvix/Compiler/Core/Data/TransformationId/Base.hs
 create mode 100644 src/Juvix/Compiler/Core/Data/TransformationId/Parser/Base.hs
 create mode 100644 src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs
 delete mode 100644 src/Juvix/Compiler/Core/Extra/Recursors/Collector.hs
 create mode 100644 src/Juvix/Compiler/Tree/Data/TransformationId.hs
 create mode 100644 src/Juvix/Compiler/Tree/Data/TransformationId/Parser.hs
 create mode 100644 src/Juvix/Compiler/Tree/Data/TransformationId/Strings.hs
 create mode 100644 src/Juvix/Compiler/Tree/Transformation.hs
 create mode 100644 src/Juvix/Compiler/Tree/Transformation/Base.hs
 create mode 100644 src/Juvix/Compiler/Tree/Transformation/Identity.hs

diff --git a/src/Juvix/Compiler/Core/Data/TransformationId.hs b/src/Juvix/Compiler/Core/Data/TransformationId.hs
index 99febd05e7..71d6ec35c2 100644
--- a/src/Juvix/Compiler/Core/Data/TransformationId.hs
+++ b/src/Juvix/Compiler/Core/Data/TransformationId.hs
@@ -1,5 +1,7 @@
 module Juvix.Compiler.Core.Data.TransformationId where
 
+import Juvix.Compiler.Core.Data.TransformationId.Base
+import Juvix.Compiler.Core.Data.TransformationId.Strings
 import Juvix.Prelude
 
 data TransformationId
@@ -51,23 +53,7 @@ data PipelineId
   | PipelineStripped
   deriving stock (Data, Bounded, Enum)
 
-data TransformationLikeId
-  = TransformationId TransformationId
-  | PipelineId PipelineId
-  deriving stock (Data)
-
-allTransformationLikeIds :: [TransformationLikeId]
-allTransformationLikeIds =
-  map TransformationId allElements
-    ++ map PipelineId allElements
-
-fromTransformationLike :: TransformationLikeId -> [TransformationId]
-fromTransformationLike = \case
-  TransformationId i -> [i]
-  PipelineId p -> pipeline p
-
-fromTransformationLikes :: [TransformationLikeId] -> [TransformationId]
-fromTransformationLikes = concatMap fromTransformationLike
+type TransformationLikeId = TransformationLikeId' TransformationId PipelineId
 
 toTypecheckTransformations :: [TransformationId]
 toTypecheckTransformations = [MatchToCase]
@@ -88,10 +74,61 @@ toStrippedTransformations =
 toGebTransformations :: [TransformationId]
 toGebTransformations = [CombineInfoTables, FilterUnreachable, CheckGeb, LetRecLifting, OptPhaseGeb, UnrollRecursion, FoldTypeSynonyms, ComputeTypeInfo]
 
-pipeline :: PipelineId -> [TransformationId]
-pipeline = \case
-  PipelineStored -> toStoredTransformations
-  PipelineNormalize -> toNormalizeTransformations
-  PipelineGeb -> toGebTransformations
-  PipelineVampIR -> toVampIRTransformations
-  PipelineStripped -> toStrippedTransformations
+instance TransformationId' TransformationId where
+  transformationText :: TransformationId -> Text
+  transformationText = \case
+    LambdaLetRecLifting -> strLifting
+    LetRecLifting -> strLetRecLifting
+    TopEtaExpand -> strTopEtaExpand
+    MatchToCase -> strMatchToCase
+    NaiveMatchToCase -> strNaiveMatchToCase
+    EtaExpandApps -> strEtaExpandApps
+    Identity -> strIdentity
+    RemoveTypeArgs -> strRemoveTypeArgs
+    MoveApps -> strMoveApps
+    NatToPrimInt -> strNatToPrimInt
+    IntToPrimInt -> strIntToPrimInt
+    ConvertBuiltinTypes -> strConvertBuiltinTypes
+    ComputeTypeInfo -> strComputeTypeInfo
+    UnrollRecursion -> strUnrollRecursion
+    DisambiguateNames -> strDisambiguateNames
+    CombineInfoTables -> strCombineInfoTables
+    CheckGeb -> strCheckGeb
+    CheckExec -> strCheckExec
+    CheckVampIR -> strCheckVampIR
+    Normalize -> strNormalize
+    LetFolding -> strLetFolding
+    LambdaFolding -> strLambdaFolding
+    LetHoisting -> strLetHoisting
+    Inlining -> strInlining
+    MandatoryInlining -> strMandatoryInlining
+    FoldTypeSynonyms -> strFoldTypeSynonyms
+    CaseCallLifting -> strCaseCallLifting
+    SimplifyIfs -> strSimplifyIfs
+    SimplifyComparisons -> strSimplifyComparisons
+    SpecializeArgs -> strSpecializeArgs
+    CaseFolding -> strCaseFolding
+    CasePermutation -> strCasePermutation
+    FilterUnreachable -> strFilterUnreachable
+    OptPhaseEval -> strOptPhaseEval
+    OptPhaseExec -> strOptPhaseExec
+    OptPhaseGeb -> strOptPhaseGeb
+    OptPhaseVampIR -> strOptPhaseVampIR
+    OptPhaseMain -> strOptPhaseMain
+
+instance PipelineId' TransformationId PipelineId where
+  pipelineText :: PipelineId -> Text
+  pipelineText = \case
+    PipelineStored -> strStoredPipeline
+    PipelineNormalize -> strNormalizePipeline
+    PipelineGeb -> strGebPipeline
+    PipelineVampIR -> strVampIRPipeline
+    PipelineStripped -> strStrippedPipeline
+
+  pipeline :: PipelineId -> [TransformationId]
+  pipeline = \case
+    PipelineStored -> toStoredTransformations
+    PipelineNormalize -> toNormalizeTransformations
+    PipelineGeb -> toGebTransformations
+    PipelineVampIR -> toVampIRTransformations
+    PipelineStripped -> toStrippedTransformations
diff --git a/src/Juvix/Compiler/Core/Data/TransformationId/Base.hs b/src/Juvix/Compiler/Core/Data/TransformationId/Base.hs
new file mode 100644
index 0000000000..c29e5c2d6b
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Data/TransformationId/Base.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE FunctionalDependencies #-}
+
+module Juvix.Compiler.Core.Data.TransformationId.Base where
+
+import Juvix.Prelude
+
+class TransformationId' t where
+  transformationText :: t -> Text
+
+class (Enum p, Enum t, Bounded p, Bounded t, TransformationId' t) => PipelineId' t p | p -> t where
+  pipelineText :: p -> Text
+  pipeline :: p -> [t]
+
+data TransformationLikeId' t p
+  = TransformationId t
+  | PipelineId p
+  deriving stock (Data)
+
+allTransformationLikeIds ::
+  (Bounded t, Bounded p, Enum t, Enum p) =>
+  [TransformationLikeId' t p]
+allTransformationLikeIds =
+  map TransformationId allElements
+    ++ map PipelineId allElements
+
+fromTransformationLike :: (PipelineId' t p) => TransformationLikeId' t p -> [t]
+fromTransformationLike = \case
+  TransformationId i -> [i]
+  PipelineId p -> pipeline p
+
+fromTransformationLikes :: (PipelineId' t p) => [TransformationLikeId' t p] -> [t]
+fromTransformationLikes = concatMap fromTransformationLike
diff --git a/src/Juvix/Compiler/Core/Data/TransformationId/Parser.hs b/src/Juvix/Compiler/Core/Data/TransformationId/Parser.hs
index 6bcfd8505d..3ca250b3cc 100644
--- a/src/Juvix/Compiler/Core/Data/TransformationId/Parser.hs
+++ b/src/Juvix/Compiler/Core/Data/TransformationId/Parser.hs
@@ -1,241 +1,14 @@
 module Juvix.Compiler.Core.Data.TransformationId.Parser (parseTransformations, TransformationId (..), completions, completionsString) where
 
-import Data.Text qualified as Text
 import Juvix.Compiler.Core.Data.TransformationId
+import Juvix.Compiler.Core.Data.TransformationId.Parser.Base
 import Juvix.Prelude
-import Juvix.Prelude.Parsing (MonadParsec)
-import Juvix.Prelude.Parsing qualified as P
-import Text.Megaparsec.Char.Lexer qualified as L
 
 parseTransformations :: Text -> Either Text [TransformationId]
-parseTransformations = fmap fromTransformationLikes . P.parseHelper transformations
+parseTransformations = parseTransformations' @TransformationId @PipelineId
 
 completionsString :: String -> [String]
-completionsString = map unpack . completions . pack
+completionsString = completionsString' @TransformationId @PipelineId
 
 completions :: Text -> [Text]
-completions = fromRight [] . P.parseHelper pcompletions
-
-transformations :: (MonadParsec e Text m) => m [TransformationLikeId]
-transformations = do
-  P.hspace
-  P.sepEndBy transformationLike comma <* P.eof
-
--- | returns a possible list of completions
-pcompletions :: (MonadParsec e Text m) => m [Text]
-pcompletions = do
-  P.hspace
-  l <- P.sepEndBy transformationLike comma
-  rest <- Text.strip <$> P.takeRest
-  return [ppTransL (notNull l) l <> str | str <- allStrings, Text.isPrefixOf rest str]
-  where
-    ppTransL :: Bool -> [TransformationLikeId] -> Text
-    ppTransL c =
-      let f :: Text -> Text = if c then (<> ",") else id
-       in f . Text.intercalate "," . map transformationLikeText
-
-lexeme :: (MonadParsec e Text m) => m a -> m a
-lexeme = L.lexeme P.hspace
-
-comma :: (MonadParsec e Text m) => m ()
-comma = symbol ","
-
-symbol :: (MonadParsec e Text m) => Text -> m ()
-symbol = void . lexeme . P.chunk
-
-transformationLike :: (MonadParsec e Text m) => m TransformationLikeId
-transformationLike =
-  TransformationId <$> transformation
-    <|> PipelineId <$> parsePipeline
-
-pipelineText :: PipelineId -> Text
-pipelineText = \case
-  PipelineStored -> strStoredPipeline
-  PipelineNormalize -> strNormalizePipeline
-  PipelineGeb -> strGebPipeline
-  PipelineVampIR -> strVampIRPipeline
-  PipelineStripped -> strStrippedPipeline
-
-transformationLikeText :: TransformationLikeId -> Text
-transformationLikeText = \case
-  TransformationId t -> transformationText t
-  PipelineId p -> pipelineText p
-
-transformationText :: TransformationId -> Text
-transformationText = \case
-  LambdaLetRecLifting -> strLifting
-  LetRecLifting -> strLetRecLifting
-  TopEtaExpand -> strTopEtaExpand
-  MatchToCase -> strMatchToCase
-  NaiveMatchToCase -> strNaiveMatchToCase
-  EtaExpandApps -> strEtaExpandApps
-  Identity -> strIdentity
-  RemoveTypeArgs -> strRemoveTypeArgs
-  MoveApps -> strMoveApps
-  NatToPrimInt -> strNatToPrimInt
-  IntToPrimInt -> strIntToPrimInt
-  ConvertBuiltinTypes -> strConvertBuiltinTypes
-  ComputeTypeInfo -> strComputeTypeInfo
-  UnrollRecursion -> strUnrollRecursion
-  DisambiguateNames -> strDisambiguateNames
-  CombineInfoTables -> strCombineInfoTables
-  CheckGeb -> strCheckGeb
-  CheckExec -> strCheckExec
-  CheckVampIR -> strCheckVampIR
-  Normalize -> strNormalize
-  LetFolding -> strLetFolding
-  LambdaFolding -> strLambdaFolding
-  LetHoisting -> strLetHoisting
-  Inlining -> strInlining
-  MandatoryInlining -> strMandatoryInlining
-  FoldTypeSynonyms -> strFoldTypeSynonyms
-  CaseCallLifting -> strCaseCallLifting
-  SimplifyIfs -> strSimplifyIfs
-  SimplifyComparisons -> strSimplifyComparisons
-  SpecializeArgs -> strSpecializeArgs
-  CaseFolding -> strCaseFolding
-  CasePermutation -> strCasePermutation
-  FilterUnreachable -> strFilterUnreachable
-  OptPhaseEval -> strOptPhaseEval
-  OptPhaseExec -> strOptPhaseExec
-  OptPhaseGeb -> strOptPhaseGeb
-  OptPhaseVampIR -> strOptPhaseVampIR
-  OptPhaseMain -> strOptPhaseMain
-
-parsePipeline :: (MonadParsec e Text m) => m PipelineId
-parsePipeline = P.choice [symbol (pipelineText t) $> t | t <- allElements]
-
-transformation :: (MonadParsec e Text m) => m TransformationId
-transformation = P.choice [symbol (transformationText t) $> t | t <- allElements]
-
-allStrings :: [Text]
-allStrings = map transformationLikeText allTransformationLikeIds
-
-strLetHoisting :: Text
-strLetHoisting = "let-hoisting"
-
-strStoredPipeline :: Text
-strStoredPipeline = "pipeline-stored"
-
-strNormalizePipeline :: Text
-strNormalizePipeline = "pipeline-normalize"
-
-strGebPipeline :: Text
-strGebPipeline = "pipeline-geb"
-
-strVampIRPipeline :: Text
-strVampIRPipeline = "pipeline-vampir"
-
-strStrippedPipeline :: Text
-strStrippedPipeline = "pipeline-stripped"
-
-strLifting :: Text
-strLifting = "lifting"
-
-strLetRecLifting :: Text
-strLetRecLifting = "letrec-lifting"
-
-strTopEtaExpand :: Text
-strTopEtaExpand = "top-eta-expand"
-
-strMatchToCase :: Text
-strMatchToCase = "match-to-case"
-
-strNaiveMatchToCase :: Text
-strNaiveMatchToCase = "naive-match-to-case"
-
-strEtaExpandApps :: Text
-strEtaExpandApps = "eta-expand-apps"
-
-strIdentity :: Text
-strIdentity = "identity"
-
-strRemoveTypeArgs :: Text
-strRemoveTypeArgs = "remove-type-args"
-
-strMoveApps :: Text
-strMoveApps = "move-apps"
-
-strNatToPrimInt :: Text
-strNatToPrimInt = "nat-to-primint"
-
-strIntToPrimInt :: Text
-strIntToPrimInt = "int-to-primint"
-
-strConvertBuiltinTypes :: Text
-strConvertBuiltinTypes = "convert-builtin-types"
-
-strComputeTypeInfo :: Text
-strComputeTypeInfo = "compute-type-info"
-
-strUnrollRecursion :: Text
-strUnrollRecursion = "unroll-recursion"
-
-strDisambiguateNames :: Text
-strDisambiguateNames = "disambiguate-names"
-
-strCombineInfoTables :: Text
-strCombineInfoTables = "combine-info-tables"
-
-strCheckGeb :: Text
-strCheckGeb = "check-geb"
-
-strCheckExec :: Text
-strCheckExec = "check-exec"
-
-strCheckVampIR :: Text
-strCheckVampIR = "check-vampir"
-
-strNormalize :: Text
-strNormalize = "normalize"
-
-strLetFolding :: Text
-strLetFolding = "let-folding"
-
-strLambdaFolding :: Text
-strLambdaFolding = "lambda-folding"
-
-strInlining :: Text
-strInlining = "inlining"
-
-strMandatoryInlining :: Text
-strMandatoryInlining = "mandatory-inlining"
-
-strFoldTypeSynonyms :: Text
-strFoldTypeSynonyms = "fold-type-synonyms"
-
-strCaseCallLifting :: Text
-strCaseCallLifting = "case-call-lifting"
-
-strSimplifyIfs :: Text
-strSimplifyIfs = "simplify-ifs"
-
-strSimplifyComparisons :: Text
-strSimplifyComparisons = "simplify-comparisons"
-
-strSpecializeArgs :: Text
-strSpecializeArgs = "specialize-args"
-
-strCaseFolding :: Text
-strCaseFolding = "case-folding"
-
-strCasePermutation :: Text
-strCasePermutation = "case-permutation"
-
-strFilterUnreachable :: Text
-strFilterUnreachable = "filter-unreachable"
-
-strOptPhaseEval :: Text
-strOptPhaseEval = "opt-phase-eval"
-
-strOptPhaseExec :: Text
-strOptPhaseExec = "opt-phase-exec"
-
-strOptPhaseGeb :: Text
-strOptPhaseGeb = "opt-phase-geb"
-
-strOptPhaseVampIR :: Text
-strOptPhaseVampIR = "opt-phase-vampir"
-
-strOptPhaseMain :: Text
-strOptPhaseMain = "opt-phase-main"
+completions = completions' @TransformationId @PipelineId
diff --git a/src/Juvix/Compiler/Core/Data/TransformationId/Parser/Base.hs b/src/Juvix/Compiler/Core/Data/TransformationId/Parser/Base.hs
new file mode 100644
index 0000000000..d19b3d2bd0
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Data/TransformationId/Parser/Base.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Avoid restricted extensions" #-}
+{-# HLINT ignore "Avoid restricted flags" #-}
+
+module Juvix.Compiler.Core.Data.TransformationId.Parser.Base (parseTransformations', completions', completionsString') where
+
+import Data.Text qualified as Text
+import Juvix.Compiler.Core.Data.TransformationId.Base
+import Juvix.Prelude
+import Juvix.Prelude.Parsing (MonadParsec)
+import Juvix.Prelude.Parsing qualified as P
+import Text.Megaparsec.Char.Lexer qualified as L
+
+parseTransformations' :: forall t p. (PipelineId' t p) => Text -> Either Text [t]
+parseTransformations' = fmap (fromTransformationLikes @t @p) . P.parseHelper transformations
+
+completionsString' :: forall t p. (PipelineId' t p) => String -> [String]
+completionsString' = map unpack . completions' @t @p . pack
+
+completions' :: forall t p. (PipelineId' t p) => Text -> [Text]
+completions' = fromRight [] . P.parseHelper (pcompletions @t @p)
+
+transformations :: (PipelineId' t p, MonadParsec e Text m) => m [TransformationLikeId' t p]
+transformations = do
+  P.hspace
+  P.sepEndBy transformationLike comma <* P.eof
+
+-- | returns a possible list of completions
+pcompletions :: forall t p e m. (PipelineId' t p, MonadParsec e Text m) => m [Text]
+pcompletions = do
+  P.hspace
+  l <- P.sepEndBy transformationLike comma
+  rest <- Text.strip <$> P.takeRest
+  return [ppTransL (notNull l) l <> str | str <- allStrings @t @p, Text.isPrefixOf rest str]
+  where
+    ppTransL :: Bool -> [TransformationLikeId' t p] -> Text
+    ppTransL c =
+      let f :: Text -> Text = if c then (<> ",") else id
+       in f . Text.intercalate "," . map transformationLikeText
+
+lexeme :: (MonadParsec e Text m) => m a -> m a
+lexeme = L.lexeme P.hspace
+
+comma :: (MonadParsec e Text m) => m ()
+comma = symbol ","
+
+symbol :: (MonadParsec e Text m) => Text -> m ()
+symbol = void . lexeme . P.chunk
+
+transformationLike :: (PipelineId' t p, MonadParsec e Text m) => m (TransformationLikeId' t p)
+transformationLike =
+  TransformationId <$> parseTransformation
+    <|> PipelineId <$> parsePipeline
+
+transformationLikeText :: (PipelineId' t p) => TransformationLikeId' t p -> Text
+transformationLikeText = \case
+  TransformationId t -> transformationText t
+  PipelineId p -> pipelineText p
+
+parsePipeline :: (PipelineId' t p, MonadParsec e Text m) => m p
+parsePipeline = P.choice [symbol (pipelineText t) $> t | t <- allElements]
+
+parseTransformation :: (Enum t, Bounded t, TransformationId' t, MonadParsec e Text m) => m t
+parseTransformation = P.choice [symbol (transformationText t) $> t | t <- allElements]
+
+allStrings :: forall t p. (PipelineId' t p) => [Text]
+allStrings = map (transformationLikeText @t @p) (allTransformationLikeIds @t @p)
diff --git a/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs b/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs
new file mode 100644
index 0000000000..7f98fadf4c
--- /dev/null
+++ b/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs
@@ -0,0 +1,132 @@
+module Juvix.Compiler.Core.Data.TransformationId.Strings where
+
+import Juvix.Prelude
+
+strLetHoisting :: Text
+strLetHoisting = "let-hoisting"
+
+strStoredPipeline :: Text
+strStoredPipeline = "pipeline-stored"
+
+strNormalizePipeline :: Text
+strNormalizePipeline = "pipeline-normalize"
+
+strGebPipeline :: Text
+strGebPipeline = "pipeline-geb"
+
+strVampIRPipeline :: Text
+strVampIRPipeline = "pipeline-vampir"
+
+strStrippedPipeline :: Text
+strStrippedPipeline = "pipeline-stripped"
+
+strLifting :: Text
+strLifting = "lifting"
+
+strLetRecLifting :: Text
+strLetRecLifting = "letrec-lifting"
+
+strTopEtaExpand :: Text
+strTopEtaExpand = "top-eta-expand"
+
+strMatchToCase :: Text
+strMatchToCase = "match-to-case"
+
+strNaiveMatchToCase :: Text
+strNaiveMatchToCase = "naive-match-to-case"
+
+strEtaExpandApps :: Text
+strEtaExpandApps = "eta-expand-apps"
+
+strIdentity :: Text
+strIdentity = "identity"
+
+strRemoveTypeArgs :: Text
+strRemoveTypeArgs = "remove-type-args"
+
+strMoveApps :: Text
+strMoveApps = "move-apps"
+
+strNatToPrimInt :: Text
+strNatToPrimInt = "nat-to-primint"
+
+strIntToPrimInt :: Text
+strIntToPrimInt = "int-to-primint"
+
+strConvertBuiltinTypes :: Text
+strConvertBuiltinTypes = "convert-builtin-types"
+
+strComputeTypeInfo :: Text
+strComputeTypeInfo = "compute-type-info"
+
+strUnrollRecursion :: Text
+strUnrollRecursion = "unroll-recursion"
+
+strDisambiguateNames :: Text
+strDisambiguateNames = "disambiguate-names"
+
+strCombineInfoTables :: Text
+strCombineInfoTables = "combine-info-tables"
+
+strCheckGeb :: Text
+strCheckGeb = "check-geb"
+
+strCheckExec :: Text
+strCheckExec = "check-exec"
+
+strCheckVampIR :: Text
+strCheckVampIR = "check-vampir"
+
+strNormalize :: Text
+strNormalize = "normalize"
+
+strLetFolding :: Text
+strLetFolding = "let-folding"
+
+strLambdaFolding :: Text
+strLambdaFolding = "lambda-folding"
+
+strInlining :: Text
+strInlining = "inlining"
+
+strMandatoryInlining :: Text
+strMandatoryInlining = "mandatory-inlining"
+
+strFoldTypeSynonyms :: Text
+strFoldTypeSynonyms = "fold-type-synonyms"
+
+strCaseCallLifting :: Text
+strCaseCallLifting = "case-call-lifting"
+
+strSimplifyIfs :: Text
+strSimplifyIfs = "simplify-ifs"
+
+strSimplifyComparisons :: Text
+strSimplifyComparisons = "simplify-comparisons"
+
+strSpecializeArgs :: Text
+strSpecializeArgs = "specialize-args"
+
+strCaseFolding :: Text
+strCaseFolding = "case-folding"
+
+strCasePermutation :: Text
+strCasePermutation = "case-permutation"
+
+strFilterUnreachable :: Text
+strFilterUnreachable = "filter-unreachable"
+
+strOptPhaseEval :: Text
+strOptPhaseEval = "opt-phase-eval"
+
+strOptPhaseExec :: Text
+strOptPhaseExec = "opt-phase-exec"
+
+strOptPhaseGeb :: Text
+strOptPhaseGeb = "opt-phase-geb"
+
+strOptPhaseVampIR :: Text
+strOptPhaseVampIR = "opt-phase-vampir"
+
+strOptPhaseMain :: Text
+strOptPhaseMain = "opt-phase-main"
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors.hs b/src/Juvix/Compiler/Core/Extra/Recursors.hs
index 1caacf27a9..1ec708760c 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors.hs
@@ -9,14 +9,14 @@ module Juvix.Compiler.Core.Extra.Recursors
     module Juvix.Compiler.Core.Extra.Recursors.RMap,
     module Juvix.Compiler.Core.Extra.Recursors.RMap.Named,
     module Juvix.Compiler.Core.Extra.Recursors.Recur,
-    module Juvix.Compiler.Core.Extra.Recursors.Collector,
+    module Juvix.Compiler.Core.Extra.Recursors.Generic.Collector,
   )
 where
 
 import Juvix.Compiler.Core.Extra.Recursors.Base
-import Juvix.Compiler.Core.Extra.Recursors.Collector
 import Juvix.Compiler.Core.Extra.Recursors.Fold
 import Juvix.Compiler.Core.Extra.Recursors.Fold.Named
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Collector
 import Juvix.Compiler.Core.Extra.Recursors.Map
 import Juvix.Compiler.Core.Extra.Recursors.Map.Named
 import Juvix.Compiler.Core.Extra.Recursors.RMap
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs
index 74d8b320b1..78d7745567 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Base.hs
@@ -6,15 +6,15 @@
 module Juvix.Compiler.Core.Extra.Recursors.Base
   ( module Juvix.Compiler.Core.Data.BinderList,
     module Juvix.Compiler.Core.Language,
-    module Juvix.Compiler.Core.Extra.Recursors.Collector,
+    module Juvix.Compiler.Core.Extra.Recursors.Generic.Collector,
     module Juvix.Compiler.Core.Extra.Recursors.Recur,
   )
 where
 
 import Juvix.Compiler.Core.Data.BinderList (BinderList)
 import Juvix.Compiler.Core.Extra.Base
-import Juvix.Compiler.Core.Extra.Recursors.Collector
 import Juvix.Compiler.Core.Extra.Recursors.Generic.Base
+import Juvix.Compiler.Core.Extra.Recursors.Generic.Collector
 import Juvix.Compiler.Core.Extra.Recursors.Recur
 import Juvix.Compiler.Core.Language
 
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Collector.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Collector.hs
deleted file mode 100644
index 696a49d95f..0000000000
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Collector.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-module Juvix.Compiler.Core.Extra.Recursors.Collector where
-
-import Juvix.Compiler.Core.Data.BinderList (BinderList)
-import Juvix.Compiler.Core.Data.BinderList qualified as BL
-import Juvix.Compiler.Core.Language.Base
-
--- | a collector collects information top-down on a single path in the program
--- tree
-data Collector a c = Collector
-  { _cEmpty :: c,
-    _cCollect :: a -> c -> c
-  }
-
-makeLenses ''Collector
-
-unitCollector :: Collector a ()
-unitCollector = Collector () (\_ _ -> ())
-
-binderInfoCollector' :: BinderList b -> Collector (Int, [b]) (BinderList b)
-binderInfoCollector' ini = Collector ini collect
-  where
-    collect :: (Int, [b]) -> BinderList b -> BinderList b
-    collect (k, bi) c
-      | k == 0 = c
-      | otherwise = BL.prependRev bi c
-
-binderInfoCollector :: Collector (Int, [b]) (BinderList b)
-binderInfoCollector = binderInfoCollector' mempty
-
-binderNumCollector' :: Int -> Collector (Int, [b]) Index
-binderNumCollector' ini = Collector ini (\(k, _) c -> c + k)
-
-binderNumCollector :: Collector (Int, [b]) Index
-binderNumCollector = binderNumCollector' 0
-
-pairCollector :: Collector a b -> Collector a c -> Collector a (b, c)
-pairCollector coll1 coll2 =
-  Collector
-    { _cEmpty = (coll1 ^. cEmpty, coll2 ^. cEmpty),
-      _cCollect = \a (b, c) -> ((coll1 ^. cCollect) a b, (coll2 ^. cCollect) a c)
-    }
-
-identityCollector :: c -> Collector a c
-identityCollector ini = Collector ini (const id)
diff --git a/src/Juvix/Compiler/Core/Extra/Recursors/Fold.hs b/src/Juvix/Compiler/Core/Extra/Recursors/Fold.hs
index 83a95347d4..dd174ed075 100644
--- a/src/Juvix/Compiler/Core/Extra/Recursors/Fold.hs
+++ b/src/Juvix/Compiler/Core/Extra/Recursors/Fold.hs
@@ -1,4 +1,3 @@
--- | Fold recursors over 'Node'.
 module Juvix.Compiler.Core.Extra.Recursors.Fold
   ( module Juvix.Compiler.Core.Extra.Recursors.Generic.Fold,
   )
diff --git a/src/Juvix/Compiler/Core/Transformation/Identity.hs b/src/Juvix/Compiler/Core/Transformation/Identity.hs
index 40d6f1c426..c6189ab52f 100644
--- a/src/Juvix/Compiler/Core/Transformation/Identity.hs
+++ b/src/Juvix/Compiler/Core/Transformation/Identity.hs
@@ -4,7 +4,6 @@ module Juvix.Compiler.Core.Transformation.Identity
   )
 where
 
-import Juvix.Compiler.Core.Pretty
 import Juvix.Compiler.Core.Transformation.Base
 
 identity :: Module -> Module
diff --git a/src/Juvix/Compiler/Tree/Data/TransformationId.hs b/src/Juvix/Compiler/Tree/Data/TransformationId.hs
new file mode 100644
index 0000000000..59b5ae1dc4
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Data/TransformationId.hs
@@ -0,0 +1,42 @@
+module Juvix.Compiler.Tree.Data.TransformationId where
+
+import Juvix.Compiler.Core.Data.TransformationId.Base
+import Juvix.Compiler.Tree.Data.TransformationId.Strings
+import Juvix.Prelude
+
+data TransformationId
+  = Identity
+  | IdentityU
+  | IdentityD
+  deriving stock (Data, Bounded, Enum, Show)
+
+data PipelineId
+  = PipelineNock
+  | PipelineAsm
+  deriving stock (Data, Bounded, Enum)
+
+type TransformationLikeId = TransformationLikeId' TransformationId PipelineId
+
+toNockTransformations :: [TransformationId]
+toNockTransformations = []
+
+toAsmTransformations :: [TransformationId]
+toAsmTransformations = []
+
+instance TransformationId' TransformationId where
+  transformationText :: TransformationId -> Text
+  transformationText = \case
+    Identity -> strIdentity
+    IdentityU -> strIdentityU
+    IdentityD -> strIdentityD
+
+instance PipelineId' TransformationId PipelineId where
+  pipelineText :: PipelineId -> Text
+  pipelineText = \case
+    PipelineNock -> strNockPipeline
+    PipelineAsm -> strAsmPipeline
+
+  pipeline :: PipelineId -> [TransformationId]
+  pipeline = \case
+    PipelineNock -> toNockTransformations
+    PipelineAsm -> toAsmTransformations
diff --git a/src/Juvix/Compiler/Tree/Data/TransformationId/Parser.hs b/src/Juvix/Compiler/Tree/Data/TransformationId/Parser.hs
new file mode 100644
index 0000000000..5a985288fc
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Data/TransformationId/Parser.hs
@@ -0,0 +1,14 @@
+module Juvix.Compiler.Tree.Data.TransformationId.Parser (parseTransformations, TransformationId (..), completions, completionsString) where
+
+import Juvix.Compiler.Core.Data.TransformationId.Parser.Base
+import Juvix.Compiler.Tree.Data.TransformationId
+import Juvix.Prelude
+
+parseTransformations :: Text -> Either Text [TransformationId]
+parseTransformations = parseTransformations' @TransformationId @PipelineId
+
+completionsString :: String -> [String]
+completionsString = completionsString' @TransformationId @PipelineId
+
+completions :: Text -> [Text]
+completions = completions' @TransformationId @PipelineId
diff --git a/src/Juvix/Compiler/Tree/Data/TransformationId/Strings.hs b/src/Juvix/Compiler/Tree/Data/TransformationId/Strings.hs
new file mode 100644
index 0000000000..3a462d6cd1
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Data/TransformationId/Strings.hs
@@ -0,0 +1,18 @@
+module Juvix.Compiler.Tree.Data.TransformationId.Strings where
+
+import Juvix.Prelude
+
+strNockPipeline :: Text
+strNockPipeline = "pipeline-nock"
+
+strAsmPipeline :: Text
+strAsmPipeline = "pipeline-asm"
+
+strIdentity :: Text
+strIdentity = "identity"
+
+strIdentityU :: Text
+strIdentityU = "identity-umap"
+
+strIdentityD :: Text
+strIdentityD = "identity-dmap"
diff --git a/src/Juvix/Compiler/Tree/Transformation.hs b/src/Juvix/Compiler/Tree/Transformation.hs
new file mode 100644
index 0000000000..4f338bc9a3
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Transformation.hs
@@ -0,0 +1,19 @@
+module Juvix.Compiler.Tree.Transformation
+  ( module Juvix.Compiler.Tree.Transformation.Base,
+    module Juvix.Compiler.Tree.Transformation,
+    module Juvix.Compiler.Tree.Data.TransformationId,
+  )
+where
+
+import Juvix.Compiler.Tree.Data.TransformationId
+import Juvix.Compiler.Tree.Transformation.Base
+import Juvix.Compiler.Tree.Transformation.Identity
+
+applyTransformations :: forall r. [TransformationId] -> InfoTable -> Sem r InfoTable
+applyTransformations ts tbl = foldM (flip appTrans) tbl ts
+  where
+    appTrans :: TransformationId -> InfoTable -> Sem r InfoTable
+    appTrans = \case
+      Identity -> return . identity
+      IdentityU -> return . identityU
+      IdentityD -> return . identityD
diff --git a/src/Juvix/Compiler/Tree/Transformation/Base.hs b/src/Juvix/Compiler/Tree/Transformation/Base.hs
new file mode 100644
index 0000000000..2fb394621b
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Transformation/Base.hs
@@ -0,0 +1,43 @@
+module Juvix.Compiler.Tree.Transformation.Base
+  ( module Juvix.Compiler.Tree.Transformation.Base,
+    module Juvix.Compiler.Tree.Data.InfoTable,
+    module Juvix.Compiler.Tree.Language,
+  )
+where
+
+import Data.HashMap.Strict qualified as HashMap
+import Juvix.Compiler.Tree.Data.InfoTable
+import Juvix.Compiler.Tree.Data.InfoTableBuilder
+import Juvix.Compiler.Tree.Language
+
+mapFunctionsM :: (Monad m) => (FunctionInfo -> m FunctionInfo) -> InfoTable -> m InfoTable
+mapFunctionsM = overM infoFunctions . mapM
+
+mapInductivesM :: (Monad m) => (InductiveInfo -> m InductiveInfo) -> InfoTable -> m InfoTable
+mapInductivesM = overM infoInductives . mapM
+
+mapConstructorsM :: (Monad m) => (ConstructorInfo -> m ConstructorInfo) -> InfoTable -> m InfoTable
+mapConstructorsM = overM infoConstrs . mapM
+
+mapFunctions :: (FunctionInfo -> FunctionInfo) -> InfoTable -> InfoTable
+mapFunctions = over infoFunctions . fmap
+
+mapInductives :: (InductiveInfo -> InductiveInfo) -> InfoTable -> InfoTable
+mapInductives = over infoInductives . fmap
+
+mapConstructors :: (ConstructorInfo -> ConstructorInfo) -> InfoTable -> InfoTable
+mapConstructors = over infoConstrs . fmap
+
+mapT :: (Symbol -> Node -> Node) -> InfoTable -> InfoTable
+mapT f = over infoFunctions (HashMap.mapWithKey (over functionCode . f))
+
+mapT' :: (Symbol -> Node -> Sem (InfoTableBuilder ': r) Node) -> InfoTable -> Sem r InfoTable
+mapT' f tab =
+  fmap fst $
+    runInfoTableBuilder $
+      mapM_
+        (\(sym, fi) -> overM functionCode (f sym) fi >>= registerFunction)
+        (HashMap.toList (tab ^. infoFunctions))
+
+walkT :: (Applicative f) => (Symbol -> Node -> f ()) -> InfoTable -> f ()
+walkT f tab = for_ (HashMap.toList (tab ^. infoFunctions)) (\(k, v) -> f k (v ^. functionCode))
diff --git a/src/Juvix/Compiler/Tree/Transformation/Identity.hs b/src/Juvix/Compiler/Tree/Transformation/Identity.hs
new file mode 100644
index 0000000000..40a4c2a100
--- /dev/null
+++ b/src/Juvix/Compiler/Tree/Transformation/Identity.hs
@@ -0,0 +1,17 @@
+module Juvix.Compiler.Tree.Transformation.Identity
+  ( module Juvix.Compiler.Tree.Transformation.Identity,
+    module Juvix.Compiler.Tree.Transformation.Base,
+  )
+where
+
+import Juvix.Compiler.Tree.Extra.Recursors
+import Juvix.Compiler.Tree.Transformation.Base
+
+identity :: InfoTable -> InfoTable
+identity = run . mapT' (const return)
+
+identityU :: InfoTable -> InfoTable
+identityU = run . mapT' (const (return . umap id))
+
+identityD :: InfoTable -> InfoTable
+identityD = run . mapT' (const (return . dmap id))

From 0dc73b52e1ceb419694fee6f1fbeed91cc1511b8 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Thu, 25 Jan 2024 13:15:24 +0100
Subject: [PATCH 5/6] tests

---
 .../Tree/Data/InfoTableBuilder/Base.hs        | 15 +++++++++
 .../Compiler/Tree/Transformation/Base.hs      |  2 +-
 test/Tree.hs                                  |  3 +-
 test/Tree/Eval/Base.hs                        | 12 +++++--
 test/Tree/Eval/Positive.hs                    |  2 +-
 test/Tree/Transformation.hs                   | 11 +++++++
 test/Tree/Transformation/Base.hs              | 31 +++++++++++++++++++
 test/Tree/Transformation/Identity.hs          | 21 +++++++++++++
 8 files changed, 92 insertions(+), 5 deletions(-)
 create mode 100644 test/Tree/Transformation.hs
 create mode 100644 test/Tree/Transformation/Base.hs
 create mode 100644 test/Tree/Transformation/Identity.hs

diff --git a/src/Juvix/Compiler/Tree/Data/InfoTableBuilder/Base.hs b/src/Juvix/Compiler/Tree/Data/InfoTableBuilder/Base.hs
index 3d8b71651c..98285d8425 100644
--- a/src/Juvix/Compiler/Tree/Data/InfoTableBuilder/Base.hs
+++ b/src/Juvix/Compiler/Tree/Data/InfoTableBuilder/Base.hs
@@ -47,6 +47,21 @@ emptyBuilderState =
       _stateIdents = mempty
     }
 
+runInfoTableBuilderWithTab :: InfoTable' t e -> Sem (InfoTableBuilder' t e ': r) b -> Sem r (InfoTable' t e, b)
+runInfoTableBuilderWithTab tab = fmap (first (^. stateInfoTable)) . runInfoTableBuilder' st
+  where
+    st =
+      BuilderState
+        { _stateNextSymbolId = maximum (0 : map (^. symbolId) (HashMap.keys (tab ^. infoFunctions) ++ HashMap.keys (tab ^. infoInductives))),
+          _stateNextUserTag = maximum (0 : mapMaybe getUserTagId (HashMap.keys (tab ^. infoConstrs))),
+          _stateInfoTable = tab,
+          _stateIdents =
+            HashMap.fromList $
+              map (\fi -> (fi ^. functionName, IdentFun (fi ^. functionSymbol))) (HashMap.elems (tab ^. infoFunctions))
+                ++ map (\ii -> (ii ^. inductiveName, IdentInd (ii ^. inductiveSymbol))) (HashMap.elems (tab ^. infoInductives))
+                ++ map (\ci -> (ci ^. constructorName, IdentConstr (ci ^. constructorTag))) (HashMap.elems (tab ^. infoConstrs))
+        }
+
 runInfoTableBuilder :: Sem (InfoTableBuilder' t e ': r) b -> Sem r (InfoTable' t e, b)
 runInfoTableBuilder = fmap (first (^. stateInfoTable)) . runInfoTableBuilder' emptyBuilderState
 
diff --git a/src/Juvix/Compiler/Tree/Transformation/Base.hs b/src/Juvix/Compiler/Tree/Transformation/Base.hs
index 2fb394621b..f73e4002f7 100644
--- a/src/Juvix/Compiler/Tree/Transformation/Base.hs
+++ b/src/Juvix/Compiler/Tree/Transformation/Base.hs
@@ -34,7 +34,7 @@ mapT f = over infoFunctions (HashMap.mapWithKey (over functionCode . f))
 mapT' :: (Symbol -> Node -> Sem (InfoTableBuilder ': r) Node) -> InfoTable -> Sem r InfoTable
 mapT' f tab =
   fmap fst $
-    runInfoTableBuilder $
+    runInfoTableBuilderWithTab tab $
       mapM_
         (\(sym, fi) -> overM functionCode (f sym) fi >>= registerFunction)
         (HashMap.toList (tab ^. infoFunctions))
diff --git a/test/Tree.hs b/test/Tree.hs
index fc354934ea..d4febc6dac 100644
--- a/test/Tree.hs
+++ b/test/Tree.hs
@@ -3,6 +3,7 @@ module Tree where
 import Base
 import Tree.Asm qualified as Asm
 import Tree.Eval qualified as Eval
+import Tree.Transformation qualified as Transformation
 
 allTests :: TestTree
-allTests = testGroup "JuvixTree tests" [Eval.allTests, Asm.allTests]
+allTests = testGroup "JuvixTree tests" [Eval.allTests, Asm.allTests, Transformation.allTests]
diff --git a/test/Tree/Eval/Base.hs b/test/Tree/Eval/Base.hs
index ba75017aab..e6b46c8254 100644
--- a/test/Tree/Eval/Base.hs
+++ b/test/Tree/Eval/Base.hs
@@ -2,25 +2,33 @@ module Tree.Eval.Base where
 
 import Base
 import Juvix.Compiler.Tree.Data.InfoTable
+import Juvix.Compiler.Tree.Data.TransformationId
 import Juvix.Compiler.Tree.Error
 import Juvix.Compiler.Tree.Evaluator
 import Juvix.Compiler.Tree.Language.Base
 import Juvix.Compiler.Tree.Language.Value
 import Juvix.Compiler.Tree.Pretty
+import Juvix.Compiler.Tree.Transformation
 import Juvix.Compiler.Tree.Translation.FromSource
 import Juvix.Data.PPOutput
 
 treeEvalAssertion ::
   Path Abs File ->
   Path Abs File ->
+  [TransformationId] ->
+  (InfoTable -> Assertion) ->
   (String -> IO ()) ->
   Assertion
-treeEvalAssertion mainFile expectedFile step = do
+treeEvalAssertion mainFile expectedFile trans testTrans step = do
   step "Parse"
   s <- readFile (toFilePath mainFile)
   case runParser (toFilePath mainFile) s of
     Left err -> assertFailure (show (pretty err))
-    Right tab -> do
+    Right tab0 -> do
+      unless (null trans) $
+        step "Transform"
+      let tab = run $ applyTransformations trans tab0
+      testTrans tab
       case tab ^. infoMainFunction of
         Just sym -> do
           withTempDir'
diff --git a/test/Tree/Eval/Positive.hs b/test/Tree/Eval/Positive.hs
index 927ec37b68..49ed936317 100644
--- a/test/Tree/Eval/Positive.hs
+++ b/test/Tree/Eval/Positive.hs
@@ -23,7 +23,7 @@ testDescr PosTest {..} =
    in TestDescr
         { _testName = _name,
           _testRoot = tRoot,
-          _testAssertion = Steps $ treeEvalAssertion file' expected'
+          _testAssertion = Steps $ treeEvalAssertion file' expected' [] (const (return ()))
         }
 
 filterOutTests :: [String] -> [PosTest] -> [PosTest]
diff --git a/test/Tree/Transformation.hs b/test/Tree/Transformation.hs
new file mode 100644
index 0000000000..bd056da0c4
--- /dev/null
+++ b/test/Tree/Transformation.hs
@@ -0,0 +1,11 @@
+module Tree.Transformation where
+
+import Base
+import Tree.Transformation.Identity qualified as Identity
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "JuvixTree transformations"
+    [ Identity.allTests
+    ]
diff --git a/test/Tree/Transformation/Base.hs b/test/Tree/Transformation/Base.hs
new file mode 100644
index 0000000000..9f7e88e06b
--- /dev/null
+++ b/test/Tree/Transformation/Base.hs
@@ -0,0 +1,31 @@
+module Tree.Transformation.Base where
+
+import Base
+import Juvix.Compiler.Tree.Data.InfoTable
+import Juvix.Compiler.Tree.Transformation
+import Tree.Eval.Base
+import Tree.Eval.Positive qualified as Eval
+
+data Test = Test
+  { _testTransformations :: [TransformationId],
+    _testAssertion :: InfoTable -> Assertion,
+    _testEval :: Eval.PosTest
+  }
+
+fromTest :: Test -> TestTree
+fromTest = mkTest . toTestDescr
+
+root :: Path Abs Dir
+root = relToProject $(mkRelDir "tests/Tree/positive/")
+
+toTestDescr :: Test -> TestDescr
+toTestDescr Test {..} =
+  let Eval.PosTest {..} = _testEval
+      tRoot = root <//> _relDir
+      file' = tRoot <//> _file
+      expected' = tRoot <//> _expectedFile
+   in TestDescr
+        { _testName = _name,
+          _testRoot = tRoot,
+          _testAssertion = Steps $ treeEvalAssertion file' expected' _testTransformations _testAssertion
+        }
diff --git a/test/Tree/Transformation/Identity.hs b/test/Tree/Transformation/Identity.hs
new file mode 100644
index 0000000000..e17afdb2a7
--- /dev/null
+++ b/test/Tree/Transformation/Identity.hs
@@ -0,0 +1,21 @@
+module Tree.Transformation.Identity (allTests) where
+
+import Base
+import Juvix.Compiler.Tree.Transformation
+import Tree.Eval.Positive qualified as Eval
+import Tree.Transformation.Base
+
+allTests :: TestTree
+allTests = testGroup "Identity" (map liftTest Eval.tests)
+
+pipe :: [TransformationId]
+pipe = [Identity, IdentityU, IdentityD]
+
+liftTest :: Eval.PosTest -> TestTree
+liftTest _testEval =
+  fromTest
+    Test
+      { _testTransformations = pipe,
+        _testAssertion = const (return ()),
+        _testEval
+      }

From fd8c694ba46d88a25f8863e106fbf5b55fdb3212 Mon Sep 17 00:00:00 2001
From: Lukasz Czajka <lukasz@heliax.dev>
Date: Mon, 29 Jan 2024 11:46:48 +0100
Subject: [PATCH 6/6] fix ormolu

---
 src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs b/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs
index 1f06ff2d98..418c2daf91 100644
--- a/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs
+++ b/src/Juvix/Compiler/Tree/Extra/Recursors/Recur.hs
@@ -1,8 +1,8 @@
-module Juvix.Compiler.Tree.Extra.Recursors.Recur(
-  module Juvix.Compiler.Tree.Extra.Recursors.Recur,
-  module Juvix.Compiler.Core.Extra.Recursors.Generic.Recur
-) where
-
+module Juvix.Compiler.Tree.Extra.Recursors.Recur
+  ( module Juvix.Compiler.Tree.Extra.Recursors.Recur,
+    module Juvix.Compiler.Core.Extra.Recursors.Generic.Recur,
+  )
+where
 
 import Juvix.Compiler.Core.Extra.Recursors.Generic.Recur (pattern End, pattern End', pattern Recur, pattern Recur')
 import Juvix.Compiler.Core.Extra.Recursors.Generic.Recur qualified as G