Address remaining review comments

Author: ana-pantilie

plutus-core/plutus-core.cabal

@@ -114,6 +114,7 @@ library
     PlutusCore.Check.Value
     PlutusCore.Compiler
     PlutusCore.Compiler.Erase
+    PlutusCore.Compiler.Opts
     PlutusCore.Compiler.Types
     PlutusCore.Core
     PlutusCore.Core.Plated
@@ -750,6 +751,7 @@ library plutus-core-testlib
     , dependent-map               >=0.4.0.0
     , filepath
     , free
+    , hashable
     , hedgehog                    >=1.0
     , hedgehog-quickcheck
     , lazy-search

plutus-core/plutus-core/src/PlutusCore/Compiler.hs

@@ -1,41 +1,40 @@
 module PlutusCore.Compiler
-  ( module UntypedPlutusCore.Optimize.Opts
+  ( module Opts
   , compileTerm
   , compileProgram
   , compileProgramWithTrace
   ) where
 
 import PlutusCore.Compiler.Erase
+import PlutusCore.Compiler.Opts as Opts
 import PlutusCore.Compiler.Types
 import PlutusCore.Core
 import PlutusCore.Name.Unique
 import PlutusCore.Rename
-import UntypedPlutusCore.Analysis.Builtins
 import UntypedPlutusCore.Core.Type qualified as UPLC
 import UntypedPlutusCore.Optimize qualified as UPLC
-import UntypedPlutusCore.Optimize.Opts
 
 import Control.Lens (view)
-import Control.Monad.Reader (MonadReader, ask)
+import Control.Monad.Reader (MonadReader)
 
 -- | Compile a PLC term to UPLC, and optimize it.
 compileTerm
   :: ( Compiling m uni fun name a
-     , MonadReader (OptimizeOpts name uni fun a) m
+     , MonadReader (CompilationOpts name fun a) m
      )
   => Term tyname name uni fun a
   -> m (UPLC.Term name uni fun a)
 compileTerm t = do
-  builtinSemanticsVariant <- view (ooBuiltinsInfo . biSemanticsVariant)
+  optimizeOpts <- view coOptimizeOpts
+  builtinSemanticsVariant <- view coBuiltinSemanticsVariant
   let erased = eraseTerm t
   renamed <- rename erased
-  optimizeOpts <- ask
   UPLC.optimizeTerm optimizeOpts builtinSemanticsVariant renamed
 
 -- | Compile a PLC program to UPLC, and optimize it.
 compileProgram
   :: ( Compiling m uni fun name a
-     , MonadReader (OptimizeOpts name uni fun a) m
+     , MonadReader (CompilationOpts name fun a) m
      )
   => Program tyname name uni fun a
   -> m (UPLC.Program name uni fun a)
@@ -45,15 +44,15 @@ compileProgram (Program a v t) = UPLC.Program a v <$> compileTerm t
 the compilation trace in the result. -}
 compileProgramWithTrace
   :: ( Compiling m uni fun name a
-     , MonadReader (OptimizeOpts name uni fun a) m
+     , MonadReader (CompilationOpts name fun a) m
      )
   => Program tyname name uni fun a
   -> m (UPLC.Program name uni fun a, UPLC.OptimizerTrace name uni fun a)
 compileProgramWithTrace (Program a v t) = do
-  builtinSemanticsVariant <- view (ooBuiltinsInfo . biSemanticsVariant)
+  optimizeOpts <- view coOptimizeOpts
+  builtinSemanticsVariant <- view coBuiltinSemanticsVariant
   let erased = eraseTerm t
   renamedProgram <- UPLC.Program a v <$> rename erased
-  optimizeOpts <- ask
   UPLC.optimizeProgramWithTrace
     optimizeOpts
     builtinSemanticsVariant

plutus-core/plutus-core/src/PlutusCore/Compiler/Opts.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module PlutusCore.Compiler.Opts
+  ( CompilationOpts (..)
+  , coOptimizeOpts
+  , coBuiltinSemanticsVariant
+  , defaultCompilationOpts
+  ) where
+
+import Control.Lens (makeLenses)
+import Data.Default.Class (Default (def))
+import PlutusCore.Builtin.Meaning (BuiltinSemanticsVariant)
+import UntypedPlutusCore.Optimize.Opts (OptimizeOpts, defaultOptimizeOpts)
+
+data CompilationOpts name fun a = CompilationOpts
+  { _coOptimizeOpts :: OptimizeOpts name a
+  , _coBuiltinSemanticsVariant :: BuiltinSemanticsVariant fun
+  }
+
+$(makeLenses ''CompilationOpts)
+
+defaultCompilationOpts :: Default (BuiltinSemanticsVariant fun) => CompilationOpts name fun a
+defaultCompilationOpts =
+  CompilationOpts
+    { _coOptimizeOpts = defaultOptimizeOpts
+    , _coBuiltinSemanticsVariant = def
+    }

plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs

@@ -92,7 +92,7 @@ compileTplcProgramOrFail
 compileTplcProgramOrFail plcProgram =
   handlePirErrorByFailing @SrcSpan =<< do
     TPLC.compileProgram plcProgram
-      & flip runReaderT TPLC.defaultOptimizeOpts
+      & flip runReaderT TPLC.defaultCompilationOpts
       & runQuoteT
       & runExceptT
 

plutus-core/testlib/PlutusCore/Test.hs

@@ -63,6 +63,7 @@ import PlutusPrelude
 
 import PlutusCore qualified as TPLC
 import PlutusCore.Annotation
+import PlutusCore.Builtin
 import PlutusCore.Check.Scoping
 import PlutusCore.Compiler qualified as TPLC
 import PlutusCore.DeBruijn
@@ -84,6 +85,7 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Either.Extras
+import Data.Hashable
 import Data.Kind qualified as GHC
 import Data.Text (Text)
 import Hedgehog
@@ -186,15 +188,19 @@ instance ToUPlc (UPLC.Program TPLC.Name uni fun ()) uni fun where
   toUPlc = pure
 
 instance
-  ToUPlc
-    (TPLC.Program TPLC.TyName UPLC.Name UPLC.DefaultUni UPLC.DefaultFun ())
-    UPLC.DefaultUni
-    UPLC.DefaultFun
+  ( TPLC.Typecheckable uni fun
+  , CaseBuiltin uni
+  , Hashable fun
+  , TPLC.GEq uni
+  , TPLC.Closed uni
+  , TPLC.Everywhere uni Eq
+  )
+  => ToUPlc (TPLC.Program TPLC.TyName UPLC.Name uni fun ()) uni fun
   where
   toUPlc =
     pure
       . TPLC.runQuote
-      . flip runReaderT UPLC.defaultOptimizeOpts
+      . flip runReaderT TPLC.defaultCompilationOpts
       . TPLC.compileProgram
 
 instance ToUPlc (UPLC.Program UPLC.NamedDeBruijn uni fun ()) uni fun where

plutus-core/testlib/PlutusIR/Test.hs

@@ -44,6 +44,7 @@ import PlutusIR.Transform.RewriteRules
 import PlutusIR.TypeCheck
 import System.FilePath (joinPath, splitExtension, (</>))
 
+import Data.Hashable
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 
@@ -70,16 +71,23 @@ instance
   toTPlc = asIfThrown . fmap void . compileWithOpts id
 
 instance
-  ( Pretty a
+  ( PLC.GEq uni
+  , uni `PLC.Everywhere` Eq
+  , PLC.Typecheckable uni fun
+  , PLC.CaseBuiltin uni
+  , PLC.PrettyUni uni
+  , Pretty fun
+  , Hashable fun
+  , Pretty a
   , Typeable a
   , Ord a
   , PLC.AnnInline a
   , PLC.AnnCase a
+  , Default (PLC.CostingPart uni fun)
+  , Default (BuiltinsInfo uni fun)
+  , Default (RewriteRules uni fun)
   )
-  => ToUPlc
-       (PIR.Program PIR.TyName PIR.Name PLC.DefaultUni PLC.DefaultFun a)
-       PLC.DefaultUni
-       PLC.DefaultFun
+  => ToUPlc (PIR.Program PIR.TyName PIR.Name uni fun a) uni fun
   where
   toUPlc = toTPlc >=> toUPlc
 

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Analysis/Builtins.hs

@@ -74,6 +74,5 @@ defaultUniUnserializableConstants = \case
   Some (ValueOf DefaultUniBLS12_381_MlResult _) -> True
   _ -> False
 
-{- Note [Unserializable constants]
-See Note [Unserializable constants] in PlutusIR.Analysis.Builtins.
+{- See Note [Unserializable constants] in PlutusIR.Analysis.Builtins.
 -}

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Contexts.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TupleSections #-}
 
 module UntypedPlutusCore.Contexts where
 
@@ -40,30 +39,6 @@ fillAppCtx term = \case
   AppCtxTerm ann arg ctx -> fillAppCtx (Apply ann term arg) ctx
   AppCtxType ann ctx -> fillAppCtx (Force ann term) ctx
 
-lengthContext :: AppCtx name uni fun a -> Int
-lengthContext = go 0
-  where
-    go acc = \case
-      AppCtxEnd -> acc
-      AppCtxTerm _ _ ctx -> go (acc + 1) ctx
-      AppCtxType _ ctx -> go (acc + 1) ctx
-
-appendAppCtx
-  :: AppCtx name uni fun a
-  -> AppCtx name uni fun a
-  -> AppCtx name uni fun a
-appendAppCtx ctx1 ctx2 = go ctx1
-  where
-    go AppCtxEnd = ctx2
-    go (AppCtxTerm ann arg ctx') = AppCtxTerm ann arg $ go ctx'
-    go (AppCtxType ann ctx') = AppCtxType ann $ go ctx'
-
-instance Semigroup (AppCtx name uni fun a) where
-  (<>) = appendAppCtx
-
-instance Monoid (AppCtx name uni fun a) where
-  mempty = AppCtxEnd
-
 data Saturation = Oversaturated | Undersaturated | Saturated
 
 -- | Do the given arguments saturate the given arity?
@@ -82,14 +57,3 @@ saturates (AppCtxType {}) (TermParam : _) = Nothing
 -- Arguments left - undersaturated
 saturates (AppCtxTerm {}) [] = Just Oversaturated
 saturates (AppCtxType {}) [] = Just Oversaturated
-
-{- Note [Ctx splitting in a recursive pass]
-When writing a recursive pass that processes the whole program, you must be
-a bit cautious when using a Ctx split. The context split may traverse
-part of the program, which will _also_ be traversed by the main recursive
-traversal. This can lead to quadratic runtime.
-
-This is usually okay for something like 'splitApplication', since it is
-quadratic in the longest application in the program, which is usually not
-significantly long.
--}

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Optimize.hs

@@ -13,10 +13,12 @@ module UntypedPlutusCore.Optimize
   , module UntypedPlutusCore.Transform.Optimizer
   ) where
 
+import PlutusCore.Builtin (CostingPart)
 import PlutusCore.Compiler.Types
 import PlutusCore.Default qualified as PLC
 import PlutusCore.Default.Builtins
 import PlutusCore.Name.Unique
+import UntypedPlutusCore.Analysis.Builtins (BuiltinsInfo, biSemanticsVariant)
 import UntypedPlutusCore.Core.Type
 import UntypedPlutusCore.Optimize.Opts as Opts
 import UntypedPlutusCore.Transform.ApplyToCase (applyToCase)
@@ -31,7 +33,9 @@ import UntypedPlutusCore.Transform.Inline (InlineHints (..), inline)
 import UntypedPlutusCore.Transform.LetFloatOut (letFloatOut)
 import UntypedPlutusCore.Transform.Optimizer
 
+import Control.Lens ((&), (.~))
 import Control.Monad
+import Data.Default.Class (def)
 import Data.Either (isRight)
 import Data.List as List (foldl')
 import Data.Typeable
@@ -40,7 +44,7 @@ import Data.Vector.Orphans ()
 optimizeProgram
   :: forall name uni fun m a
    . Compiling m uni fun name a
-  => OptimizeOpts name uni fun a
+  => OptimizeOpts name a
   -> BuiltinSemanticsVariant fun
   -> Program name uni fun a
   -> m (Program name uni fun a)
@@ -50,7 +54,7 @@ optimizeProgram opts builtinSemanticsVariant (Program a v t) =
 optimizeProgramWithTrace
   :: forall name uni fun m a
    . Compiling m uni fun name a
-  => OptimizeOpts name uni fun a
+  => OptimizeOpts name a
   -> BuiltinSemanticsVariant fun
   -> Program name uni fun a
   -> m (Program name uni fun a, OptimizerTrace name uni fun a)
@@ -63,7 +67,7 @@ optimizeProgramWithTrace opts builtinSemanticsVariant (Program a v t) = do
 optimizeTerm
   :: forall name uni fun m a
    . Compiling m uni fun name a
-  => OptimizeOpts name uni fun a
+  => OptimizeOpts name a
   -> BuiltinSemanticsVariant fun
   -> Term name uni fun a
   -> m (Term name uni fun a)
@@ -73,7 +77,7 @@ optimizeTerm opts builtinSemanticsVariant term =
 termOptimizer
   :: forall name uni fun m a
    . Compiling m uni fun name a
-  => OptimizeOpts name uni fun a
+  => OptimizeOpts name a
   -> BuiltinSemanticsVariant fun
   -> Term name uni fun a
   -> OptimizerT name uni fun a m (Term name uni fun a)
@@ -147,10 +151,13 @@ termOptimizer opts builtinSemanticsVariant =
           LetFloatOutStage ->
             letFloatOut
           ConstantFoldingStage ->
-            evaluateBuiltinsPass
-              (_ooPreserveLogging opts)
-              (_ooBuiltinsInfo opts)
-              (_ooBuiltinCostModel opts)
+            case (eqT @uni @PLC.DefaultUni, eqT @fun @DefaultFun) of
+              (Just Refl, Just Refl) ->
+                evaluateBuiltinsPass
+                  (_ooPreserveLogging opts)
+                  ((def :: BuiltinsInfo PLC.DefaultUni DefaultFun) & biSemanticsVariant .~ builtinSemanticsVariant)
+                  (def :: CostingPart PLC.DefaultUni DefaultFun)
+              _ -> pure
 
     caseOfCase'
       :: Term name uni fun a

plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Optimize/Opts.hs

@@ -13,24 +13,17 @@ module UntypedPlutusCore.Optimize.Opts
   , ooInlineCallsiteGrowth
   , ooPreserveLogging
   , ooCertifiedOptsOnly
-  , ooBuiltinsInfo
-  , ooBuiltinCostModel
   , defaultOptimizeOpts
   , CseWhichSubterms (..)
-  , BuiltinsInfo (..)
-  , biSemanticsVariant
   ) where
 
 import Control.Lens.TH (makeLenses)
 import Data.Default.Class
 
 import PlutusCore.Annotation (InlineHints (..))
 import PlutusCore.AstSize
-import PlutusCore.Builtin qualified as PLC
-import PlutusCore.Default
 import PlutusCore.Pretty
 import Prettyprinter (viaShow)
-import UntypedPlutusCore.Analysis.Builtins
 
 -- | Which subterms should be considered as candidates for CSE?
 data CseWhichSubterms = AllSubterms | ExcludeWorkFree
@@ -39,7 +32,7 @@ data CseWhichSubterms = AllSubterms | ExcludeWorkFree
 instance Pretty CseWhichSubterms where
   pretty = viaShow
 
-data OptimizeOpts name uni fun a = OptimizeOpts
+data OptimizeOpts name a = OptimizeOpts
   { _ooMaxSimplifierIterations :: Int
   , _ooMaxCseIterations :: Int
   , _ooCseWhichSubterms :: CseWhichSubterms
@@ -51,13 +44,12 @@ data OptimizeOpts name uni fun a = OptimizeOpts
   , _ooPreserveLogging :: Bool
   , _ooApplyToCase :: Bool
   , _ooCertifiedOptsOnly :: Bool
-  , _ooBuiltinsInfo :: BuiltinsInfo uni fun
-  , _ooBuiltinCostModel :: PLC.CostingPart uni fun
   }
+  deriving stock (Show)
 
 $(makeLenses ''OptimizeOpts)
 
-defaultOptimizeOpts :: OptimizeOpts name DefaultUni DefaultFun a
+defaultOptimizeOpts :: OptimizeOpts name a
 defaultOptimizeOpts =
   OptimizeOpts
     { _ooMaxSimplifierIterations = 12
@@ -71,6 +63,4 @@ defaultOptimizeOpts =
     , _ooPreserveLogging = True
     , _ooApplyToCase = True
     , _ooCertifiedOptsOnly = False
-    , _ooBuiltinsInfo = def
-    , _ooBuiltinCostModel = def
     }