Inliner certification

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs

@@ -19,6 +19,7 @@ module UntypedPlutusCore.Core.Type
     , bindFunM
     , bindFun
     , mapFun
+    , mapAnn
     , termAnn
     , UVarDecl(..)
     , uvarDeclName
@@ -194,3 +195,16 @@ bindFun f = runIdentity . bindFunM (coerce f)
 
 mapFun :: (ann -> fun -> fun') -> Term name uni fun ann -> Term name uni fun' ann
 mapFun f = bindFun $ \ann fun -> Builtin ann (f ann fun)
+
+mapAnn :: (ann -> ann') -> Term name uni fun ann -> Term name uni fun ann'
+mapAnn f = go where
+    go (Constant ann val)     = Constant (f ann) val
+    go (Builtin ann fun)      = Builtin (f ann) fun
+    go (Var ann name)         = Var (f ann) name
+    go (LamAbs ann name body) = LamAbs (f ann) name (go body)
+    go (Apply ann fun arg)    = Apply (f ann) (go fun) (go arg)
+    go (Delay ann term)       = Delay (f ann) (go term)
+    go (Force ann term)       = Force (f ann) (go term)
+    go (Error ann)            = Error (f ann)
+    go (Constr ann i args)    = Constr (f ann) i $ fmap go args
+    go (Case ann arg cs)      = Case (f ann) (go arg) $ fmap go cs

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseOfCase.hs

@@ -44,7 +44,7 @@ import PlutusCore.MkPlc (mkIterApp)
 import UntypedPlutusCore.Core
 import UntypedPlutusCore.Transform.CaseReduce qualified as CaseReduce
 import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (CaseOfCase), SimplifierT,
-                                               recordSimplification)
+                                               initSimplifierTerm, recordSimplification)
 
 import Control.Lens
 import Data.List (nub)
@@ -57,7 +57,10 @@ caseOfCase
     -> SimplifierT name uni fun a m (Term name uni fun a)
 caseOfCase term = do
   let result = transformOf termSubterms processTerm term
-  recordSimplification term CaseOfCase result
+  recordSimplification
+    (initSimplifierTerm term)
+    CaseOfCase
+    (initSimplifierTerm result)
   return result
 
 processTerm

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs

@@ -12,15 +12,18 @@ import PlutusCore.Builtin (CaseBuiltin (..))
 import PlutusCore.MkPlc
 import UntypedPlutusCore.Core
 import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (CaseReduce), SimplifierT,
-                                               recordSimplification)
+                                               initSimplifierTerm, recordSimplification)
 
 caseReduce
     :: (Monad m, CaseBuiltin uni)
     => Term name uni fun a
     -> SimplifierT name uni fun a m (Term name uni fun a)
 caseReduce term = do
     let result = transformOf termSubterms processTerm term
-    recordSimplification term CaseReduce result
+    recordSimplification
+       (initSimplifierTerm term)
+       CaseReduce
+       (initSimplifierTerm result)
     return result
 
 processTerm :: CaseBuiltin uni => Term name uni fun a -> Term name uni fun a

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Cse.hs

@@ -12,7 +12,7 @@ import UntypedPlutusCore.Core
 import UntypedPlutusCore.Purity (isWorkFree)
 import UntypedPlutusCore.Size (termSize)
 import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (CSE), SimplifierT,
-                                               recordSimplification)
+                                               initSimplifierTerm, recordSimplification)
 
 import Control.Arrow ((>>>))
 import Control.Lens (foldrOf, transformOf)
@@ -232,7 +232,10 @@ cse builtinSemanticsVariant t0 = do
           . Map.elems
           $ countOccs builtinSemanticsVariant annotated
   result <- mkCseTerm commonSubexprs annotated
-  recordSimplification t0 CSE result
+  recordSimplification
+    (initSimplifierTerm t0)
+    CSE
+    (initSimplifierTerm result)
   return result
 
 -- | The second pass. See Note [CSE].

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/FloatDelay.hs

@@ -62,7 +62,7 @@ import PlutusCore.Name.UniqueSet qualified as USet
 import UntypedPlutusCore.Core.Plated (termSubterms)
 import UntypedPlutusCore.Core.Type (Term (..))
 import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (FloatDelay), SimplifierT,
-                                               recordSimplification)
+                                               initSimplifierTerm, recordSimplification)
 
 import Control.Lens (forOf, forOf_, transformOf)
 import Control.Monad.Trans.Writer.CPS (Writer, execWriter, runWriter, tell)
@@ -78,7 +78,10 @@ floatDelay term = do
   result <-
     PLC.rename term >>= \t ->
         pure . uncurry (flip simplifyBodies) $ simplifyArgs (unforcedVars t) t
-  recordSimplification term FloatDelay result
+  recordSimplification
+    (initSimplifierTerm term)
+    FloatDelay
+    (initSimplifierTerm result)
   return result
 
 {- | First pass. Returns the names of all variables, at least one occurrence

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceCaseDelay.hs

@@ -35,7 +35,7 @@ where
 
 import UntypedPlutusCore.Core
 import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (ForceCaseDelay), SimplifierT,
-                                               recordSimplification)
+                                               initSimplifierTerm, recordSimplification)
 
 import Control.Lens
 
@@ -45,7 +45,10 @@ forceCaseDelay
     -> SimplifierT name uni fun a m (Term name uni fun a)
 forceCaseDelay term = do
   let result = transformOf termSubterms processTerm term
-  recordSimplification term ForceCaseDelay result
+  recordSimplification
+    (initSimplifierTerm term)
+    ForceCaseDelay
+    (initSimplifierTerm result)
   return result
 
 processTerm :: Term name uni fun a -> Term name uni fun a

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/ForceDelay.hs

@@ -154,7 +154,7 @@ import PlutusCore.MkPlc (mkIterApp)
 import UntypedPlutusCore.Core
 import UntypedPlutusCore.Purity (isPure, isWorkFree)
 import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (ForceDelay), SimplifierT,
-                                               recordSimplification)
+                                               initSimplifierTerm, recordSimplification)
 
 import Control.Lens (transformOf)
 import Control.Monad (guard)
@@ -170,7 +170,10 @@ forceDelay
     -> SimplifierT name uni fun a m (Term name uni fun a)
 forceDelay semVar term = do
     let result = transformOf termSubterms (processTerm semVar) term
-    recordSimplification term ForceDelay result
+    recordSimplification
+        (initSimplifierTerm term)
+        ForceDelay
+        (initSimplifierTerm result)
     return result
 
 {- | Checks whether the term is of the right form, and "pushes"