{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE ViewPatterns          #-}
-- For some reason this module is very slow to compile otherwise
{-# OPTIONS_GHC -O0 #-}

module PlutusTx.Plugin (plugin, plc) where

import PlutusPrelude
import PlutusTx.AsData.Internal qualified
import PlutusTx.Bool ((&&), (||))
import PlutusTx.Builtins (equalsInteger, mkNilOpaque, useFromOpaque, useToOpaque)
import PlutusTx.Code
import PlutusTx.Compiler.Builtins
import PlutusTx.Compiler.Error
import PlutusTx.Compiler.Expr
import PlutusTx.Compiler.Trace
import PlutusTx.Compiler.Types
import PlutusTx.Coverage
import PlutusTx.Function qualified
import PlutusTx.Optimize.Inline qualified
import PlutusTx.PIRTypes
import PlutusTx.PLCTypes
import PlutusTx.Plugin.Utils
import PlutusTx.Trace

import GHC.ByteCode.Types qualified as GHC
import GHC.Core.Coercion.Opt qualified as GHC
import GHC.Core.FamInstEnv qualified as GHC
import GHC.Core.Opt.Arity qualified as GHC
import GHC.Core.Opt.OccurAnal qualified as GHC
import GHC.Core.Opt.Simplify qualified as GHC
import GHC.Core.Opt.Simplify.Env qualified as GHC
import GHC.Core.Opt.Simplify.Monad qualified as GHC
import GHC.Core.Rules.Config qualified as GHC
import GHC.Core.Unfold qualified as GHC
import GHC.Plugins qualified as GHC
import GHC.Types.TyThing qualified as GHC

import PlutusCore qualified as PLC
import PlutusCore.Compiler qualified as PLC
import PlutusCore.Pretty as PLC
import PlutusCore.Quote
import PlutusCore.Version qualified as PLC

import UntypedPlutusCore qualified as UPLC

import PlutusIR qualified as PIR
import PlutusIR.Compiler qualified as PIR
import PlutusIR.Compiler.Definitions qualified as PIR
import PlutusTx.Options

import Language.Haskell.TH.Syntax as TH hiding (lift)

import Control.Exception (throwIO)
import Control.Lens
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Flat (Flat, flat, unflat)

import Data.ByteString qualified as BS
import Data.ByteString.Unsafe qualified as BSUnsafe
import Data.Either.Validation
import Data.Map qualified as Map
import Data.Monoid.Extra (mwhen)
import Data.Set qualified as Set
import GHC.Num.Integer qualified
import PlutusCore.Default (DefaultFun, DefaultUni)
import PlutusIR.Compiler.Provenance (noProvenance, original)
import PlutusIR.Compiler.Types qualified as PIR
import PlutusIR.Transform.RewriteRules
import PlutusIR.Transform.RewriteRules.RemoveTrace (rewriteRuleRemoveTrace)
import Prettyprinter qualified as PP
import System.IO (hPutStrLn, openBinaryTempFile, stderr)
import System.IO.Unsafe (unsafePerformIO)

import Certifier

data PluginCtx = PluginCtx
  { PluginCtx -> PluginOptions
pcOpts            :: PluginOptions
  , PluginCtx -> FamInstEnvs
pcFamEnvs         :: GHC.FamInstEnvs
  , PluginCtx -> Name
pcMarkerName      :: GHC.Name
  , PluginCtx -> ModuleName
pcModuleName      :: GHC.ModuleName
  , PluginCtx -> Maybe ModBreaks
pcModuleModBreaks :: Maybe GHC.ModBreaks
  }

{- Note [Making sure unfoldings are present]
Our plugin runs at the start of the Core pipeline. If we look around us, we will find
that as expected, we have unfoldings for some bindings from other modules or packages
depending on whether GHC thinks they're good to inline/are marked INLINEABLE.

But there will be no unfoldings for local bindings!

It turns out that these are added by the simplifier, of all things. To avoid relying too
much on the shape of the subsequent passes, we add a single, very gentle, simplifier
pass before we run, turning off everything that we can and running only once.

This means that we need to be robust to the transformations that the simplifier performs
unconditionally which we pretty much are.

See https://gitlab.haskell.org/ghc/ghc/issues/16615 for upstream discussion.
-}

{- Note [newtype field accessors in `base`]
For some unknown reason, newtype field accessors in `base`, such as `getFirst`, `appEndo` and
`getDual`, cause Cabal build and Nix build to behave differently. In Cabal build, these
field accessors' unfoldings are available to the GHC simplifier, and so the simplifier inlines
them into `Coercion`s. But in Nix build, somehow their unfoldings aren't available.

This started to happen after a seemingly innocent PR (#4552), and it eventually led to different
PIRs, PLCs and UPLCs, causing test failures. Replacing them with `coerce` avoids the problem.
-}

plugin :: GHC.Plugin
plugin :: Plugin
plugin =
  Plugin
GHC.defaultPlugin
    { GHC.pluginRecompile = GHC.flagRecompile
    , GHC.installCoreToDos = install
    }
 where
  install :: [GHC.CommandLineOption] -> [GHC.CoreToDo] -> GHC.CoreM [GHC.CoreToDo]
  install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install [CommandLineOption]
args [CoreToDo]
rest = do
    -- create simplifier pass to be placed at the front
    CoreToDo
simplPass <- DynFlags -> CoreToDo
mkSimplPass (DynFlags -> CoreToDo) -> CoreM DynFlags -> CoreM CoreToDo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
GHC.getDynFlags
    -- instantiate our plugin pass
    CoreToDo
pluginPass <-
      PluginOptions -> CoreToDo
mkPluginPass (PluginOptions -> CoreToDo)
-> CoreM PluginOptions -> CoreM CoreToDo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case [CommandLineOption] -> Validation ParseErrors PluginOptions
parsePluginOptions [CommandLineOption]
args of
        Success PluginOptions
opts -> PluginOptions -> CoreM PluginOptions
forall a. a -> CoreM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PluginOptions
opts
        Failure ParseErrors
errs -> IO PluginOptions -> CoreM PluginOptions
forall a. IO a -> CoreM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PluginOptions -> CoreM PluginOptions)
-> IO PluginOptions -> CoreM PluginOptions
forall a b. (a -> b) -> a -> b
$ ParseErrors -> IO PluginOptions
forall e a. Exception e => e -> IO a
throwIO ParseErrors
errs
    -- return the pipeline
    [CoreToDo] -> CoreM [CoreToDo]
forall a. a -> CoreM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CoreToDo] -> CoreM [CoreToDo]) -> [CoreToDo] -> CoreM [CoreToDo]
forall a b. (a -> b) -> a -> b
$
      CoreToDo
simplPass
        CoreToDo -> [CoreToDo] -> [CoreToDo]
forall a. a -> [a] -> [a]
: CoreToDo
pluginPass
        CoreToDo -> [CoreToDo] -> [CoreToDo]
forall a. a -> [a] -> [a]
: [CoreToDo]
rest

{- Note [GHC.sm_pre_inline]
We run a GHC simplifier pass before the plugin, in which we turn on `sm_pre_inline`, which
makes GHC inline certain bindings before the plugin runs. Pre-inlining is a phase of the GHC
inliner that inlines bindings in GHC Core where the binder occurs exactly once in an
unconditionally safe way (e.g., the occurrence isn't inside a lambda). For details, see paper
"Secrets of the Glasgow Haskell Compiler inliner".

The reason we need the pre-inlining is that the plugin requires certain functions
to be fully applied. For example, it has a special rule to handle
`noinline @(String -> BuiltinString) stringToBuiltinString "a"`, but it cannot compile
`let f = noinline @(String -> BuiltinString) stringToBuiltinString in f "a"`.
By turning on pre-inlining, the `f` in the latter expression will be inlined, resulting in
the former expression, which the plugin knows how to compile.

There is a related flag, `sm_inline`, which controls whether GHC's call-site inlining is
enabled. If enabled, GHC will inline additional bindings that cannot be unconditionally
inlined, on a call-site-by-call-site basis. Currently we haven't found the need to turn on
`sm_inline`. Turning it on seems to reduce PIR sizes in many cases, but it is unclear
whether it may affect the semantics of Plutus Core.

Arguably, relying on `sm_pre_inline` is not the proper solution - what if we get
`let f = noinline @(String -> BuiltinString) stringToBuiltinString in f "a" <> f "b"`?
Here `f` won't be pre-inlined because it occurs twice. Instead, we should perhaps
inline a binding when the RHS is a partially applied function that we need fully applied.
But so far we haven't had an issue like this.

We should also make the error message better in cases like this. The current error message is
"Unsupported feature: Type constructor: GHC.Prim.Char#", resulting from attempting to inline
and compile `stringToBuiltinString`.

Note also, this `sm_pre_inline` pass doesn't include some of the inlining GHC does before the
plugin.
The GHC desugarer generates a large number of intermediate definitions and general clutter that
should be removed quickly. So GHC's "simple optimiser" (GHC.Core.SimpleOpt) also inlines things with
single occurrences. This is why the OPAQUE pragma is needed to avoid inlining of bindings that
have single occurrence.
None of -fmax-simplifier-iterations=0  -fforce-recomp -O0 would prevent it,
nor will turning off `sm_pre_inline`.
See https://gitlab.haskell.org/ghc/ghc/-/issues/23337.
-}

-- | A simplifier pass, implemented by GHC
mkSimplPass :: GHC.DynFlags -> GHC.CoreToDo
mkSimplPass :: DynFlags -> CoreToDo
mkSimplPass DynFlags
dflags =
  -- See Note [Making sure unfoldings are present]
  SimplifyOpts -> CoreToDo
GHC.CoreDoSimplify (SimplifyOpts -> CoreToDo) -> SimplifyOpts -> CoreToDo
forall a b. (a -> b) -> a -> b
$
    GHC.SimplifyOpts
      { so_dump_core_sizes :: Bool
GHC.so_dump_core_sizes = Bool
False
      , so_iterations :: Int
GHC.so_iterations = Int
1
      , so_mode :: SimplMode
GHC.so_mode = SimplMode
simplMode
      , so_pass_result_cfg :: Maybe LintPassResultConfig
GHC.so_pass_result_cfg = Maybe LintPassResultConfig
forall a. Maybe a
Nothing
      , so_hpt_rules :: RuleBase
GHC.so_hpt_rules = RuleBase
GHC.emptyRuleBase
      , so_top_env_cfg :: TopEnvConfig
GHC.so_top_env_cfg = Int -> Int -> TopEnvConfig
GHC.TopEnvConfig Int
0 Int
0
      }
 where
  simplMode :: SimplMode
simplMode =
    GHC.SimplMode
      { sm_names :: [CommandLineOption]
GHC.sm_names = [CommandLineOption
"Ensure unfoldings are present"]
      , sm_phase :: CompilerPhase
GHC.sm_phase = CompilerPhase
GHC.InitialPhase
      , sm_uf_opts :: UnfoldingOpts
GHC.sm_uf_opts = UnfoldingOpts
GHC.defaultUnfoldingOpts
      , sm_rules :: Bool
GHC.sm_rules = Bool
False
      , sm_cast_swizzle :: Bool
GHC.sm_cast_swizzle = Bool
True
      , -- See Note [GHC.sm_pre_inline]
        sm_pre_inline :: Bool
GHC.sm_pre_inline = Bool
True
      , -- You might think you would need this, but apparently not
        sm_inline :: Bool
GHC.sm_inline = Bool
False
      , sm_case_case :: Bool
GHC.sm_case_case = Bool
False
      , sm_eta_expand :: Bool
GHC.sm_eta_expand = Bool
False
      , sm_float_enable :: FloatEnable
GHC.sm_float_enable = FloatEnable
GHC.FloatDisabled
      , sm_do_eta_reduction :: Bool
GHC.sm_do_eta_reduction = Bool
False
      , sm_arity_opts :: ArityOpts
GHC.sm_arity_opts = Bool -> Bool -> ArityOpts
GHC.ArityOpts Bool
False Bool
False
      , sm_rule_opts :: RuleOpts
GHC.sm_rule_opts = Platform -> Bool -> Bool -> Bool -> RuleOpts
GHC.RuleOpts (DynFlags -> Platform
GHC.targetPlatform DynFlags
dflags) Bool
False Bool
True Bool
False
      , sm_case_folding :: Bool
GHC.sm_case_folding = Bool
False
      , sm_case_merge :: Bool
GHC.sm_case_merge = Bool
False
      , sm_co_opt_opts :: OptCoercionOpts
GHC.sm_co_opt_opts = Bool -> OptCoercionOpts
GHC.OptCoercionOpts Bool
False
      }

{- Note [Marker resolution]
We use TH's 'foo exact syntax for resolving the 'plc marker's ghc name, as explained in:
<https://hackage.haskell.org/package/ghc-9.6.6/docs/GHC-Plugins.html#v:thNameToGhcName>

The GHC haddock suggests that the "exact syntax" will always succeed because it is statically
resolved here (inside this Plugin module);

If this is the case, then it means that our plugin will always traverse each module's binds
searching for plc markers even in the case that the `plc` name is not in scope locally in the module
 under compilation.

The alternative is to use the "dynamic syntax" (`TH.mkName "plc"`), which implies that
the "plc" name will be resolved dynamically during module's compilation. In case "plc" is not
locally in scope,
the plugin would finish faster by completely skipping the module under compilation.
This dynamic approach comes with its own downsides however,
because the user may have imported "plc" qualified or aliased it, which will fail to resolve.
-}

{-| Our plugin works at haskell-module level granularity; the plugin
looks at the module's top-level bindings for plc markers and compiles their right-hand-side core
expressions.
-}
mkPluginPass :: PluginOptions -> GHC.CoreToDo
mkPluginPass :: PluginOptions -> CoreToDo
mkPluginPass PluginOptions
opts = CommandLineOption -> CorePluginPass -> CoreToDo
GHC.CoreDoPluginPass CommandLineOption
"Core to PLC" (CorePluginPass -> CoreToDo) -> CorePluginPass -> CoreToDo
forall a b. (a -> b) -> a -> b
$ \ModGuts
guts -> do
  -- Family env code borrowed from SimplCore
  PackageFamInstEnv
p_fam_env <- CoreM PackageFamInstEnv
GHC.getPackageFamInstEnv
  -- See Note [Marker resolution]
  Maybe Name
maybeMarkerName <- Name -> CoreM (Maybe Name)
GHC.thNameToGhcName 'plc
  case Maybe Name
maybeMarkerName of
    -- TODO: test that this branch can happen using TH's 'plc exact syntax.
    -- See Note [Marker resolution]
    Maybe Name
Nothing -> CorePluginPass
forall a. a -> CoreM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModGuts
guts
    Just Name
markerName ->
      let pctx :: PluginCtx
pctx =
            PluginCtx
              { pcOpts :: PluginOptions
pcOpts = PluginOptions
opts
              , pcFamEnvs :: FamInstEnvs
pcFamEnvs = (PackageFamInstEnv
p_fam_env, ModGuts -> PackageFamInstEnv
GHC.mg_fam_inst_env ModGuts
guts)
              , pcMarkerName :: Name
pcMarkerName = Name
markerName
              , pcModuleName :: ModuleName
pcModuleName = GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModGuts -> GenModule Unit
GHC.mg_module ModGuts
guts
              , pcModuleModBreaks :: Maybe ModBreaks
pcModuleModBreaks = ModGuts -> Maybe ModBreaks
GHC.mg_modBreaks ModGuts
guts
              }
       in -- start looking for plc calls from the top-level binds
          (CoreProgram -> CoreM CoreProgram) -> CorePluginPass
GHC.bindsOnlyPass (PluginCtx
-> PluginM DefaultUni DefaultFun CoreProgram -> CoreM CoreProgram
forall (uni :: * -> *) fun a.
(PrettyUni uni, Pretty fun) =>
PluginCtx -> PluginM uni fun a -> CoreM a
runPluginM PluginCtx
pctx (PluginM DefaultUni DefaultFun CoreProgram -> CoreM CoreProgram)
-> (CoreProgram -> PluginM DefaultUni DefaultFun CoreProgram)
-> CoreProgram
-> CoreM CoreProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoreBind
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      CoreBind)
-> CoreProgram -> PluginM DefaultUni DefaultFun CoreProgram
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse CoreBind
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreBind
compileBind) ModGuts
guts

{-| The monad where the plugin runs in for each module.
It is a core->core compiler monad, called PluginM, augmented with pure errors.
-}
type PluginM uni fun = ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) GHC.CoreM)

-- | Runs the plugin monad in a given context; throws a Ghc.Exception when compilation fails.
runPluginM
  :: (PLC.PrettyUni uni, PP.Pretty fun)
  => PluginCtx -> PluginM uni fun a -> GHC.CoreM a
runPluginM :: forall (uni :: * -> *) fun a.
(PrettyUni uni, Pretty fun) =>
PluginCtx -> PluginM uni fun a -> CoreM a
runPluginM PluginCtx
pctx PluginM uni fun a
act = do
  Either (CompileError uni fun Ann) a
res <- ExceptT (CompileError uni fun Ann) CoreM a
-> CoreM (Either (CompileError uni fun Ann) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (CompileError uni fun Ann) CoreM a
 -> CoreM (Either (CompileError uni fun Ann) a))
-> ExceptT (CompileError uni fun Ann) CoreM a
-> CoreM (Either (CompileError uni fun Ann) a)
forall a b. (a -> b) -> a -> b
$ PluginM uni fun a
-> PluginCtx -> ExceptT (CompileError uni fun Ann) CoreM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT PluginM uni fun a
act PluginCtx
pctx
  case Either (CompileError uni fun Ann) a
res of
    Right a
x -> a -> CoreM a
forall a. a -> CoreM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Left CompileError uni fun Ann
err ->
      let errInGhc :: GhcException
errInGhc = CommandLineOption -> GhcException
GHC.ProgramError (CommandLineOption -> GhcException)
-> (Doc Any -> CommandLineOption) -> Doc Any -> GhcException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> CommandLineOption
forall a. Show a => a -> CommandLineOption
show (Doc Any -> GhcException) -> Doc Any -> GhcException
forall a b. (a -> b) -> a -> b
$ Doc Any
"GHC Core to PLC plugin:" Doc Any -> Doc Any -> Doc Any
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> CompileError uni fun Ann -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. CompileError uni fun Ann -> Doc ann
PP.pretty CompileError uni fun Ann
err
       in IO a -> CoreM a
forall a. IO a -> CoreM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> CoreM a) -> IO a -> CoreM a
forall a b. (a -> b) -> a -> b
$ GhcException -> IO a
forall a. GhcException -> IO a
GHC.throwGhcExceptionIO GhcException
errInGhc

-- | Compiles all the marked expressions in the given binder into PLC literals.
compileBind :: GHC.CoreBind -> PluginM PLC.DefaultUni PLC.DefaultFun GHC.CoreBind
compileBind :: CoreBind
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreBind
compileBind = \case
  GHC.NonRec Var
b CoreExpr
rhs -> Var -> CoreExpr -> CoreBind
forall b. b -> Expr b -> Bind b
GHC.NonRec Var
b (CoreExpr -> CoreBind)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreBind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
rhs
  GHC.Rec [(Var, CoreExpr)]
bindsRhses ->
    [(Var, CoreExpr)] -> CoreBind
forall b. [(b, Expr b)] -> Bind b
GHC.Rec
      ([(Var, CoreExpr)] -> CoreBind)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     [(Var, CoreExpr)]
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreBind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( [(Var, CoreExpr)]
-> ((Var, CoreExpr)
    -> ReaderT
         PluginCtx
         (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
         (Var, CoreExpr))
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     [(Var, CoreExpr)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Var, CoreExpr)]
bindsRhses (((Var, CoreExpr)
  -> ReaderT
       PluginCtx
       (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
       (Var, CoreExpr))
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      [(Var, CoreExpr)])
-> ((Var, CoreExpr)
    -> ReaderT
         PluginCtx
         (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
         (Var, CoreExpr))
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     [(Var, CoreExpr)]
forall a b. (a -> b) -> a -> b
$ \(Var
b, CoreExpr
rhs) -> do
              CoreExpr
rhs' <- CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
rhs
              (Var, CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     (Var, CoreExpr)
forall a.
a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var
b, CoreExpr
rhs')
          )

{- Note [Hooking in the plugin]
Working out what to process and where to put it is tricky. We are going to turn the result in
to a 'CompiledCode', not the Haskell expression we started with!

Currently we look for calls to the @plc :: a -> CompiledCode a@ function,
and we replace the whole application with the generated code object, which will still be well-typed.
-}

{- Note [Polymorphic values and Any]
If you try and use the plugin on a polymorphic expression, then GHC will replace the quantified
types with 'Any' and remove the type lambdas. This is pretty annoying, and I don't entirely
understand why it happens, despite poking around in GHC a fair bit.

Possibly it has to do with the type that is given to 'plc' being unconstrained, resulting in GHC
putting 'Any' there, and that then propagating into the type of the quote. It's tricky to experiment
with this, since you can't really specify a polymorphic type in a type application or in the
resulting 'CompiledCode' because that's impredicative polymorphism.
-}

-- | Compiles all the core-expressions surrounded by plc in the given expression into PLC literals.
compileMarkedExprs :: GHC.CoreExpr -> PluginM PLC.DefaultUni PLC.DefaultFun GHC.CoreExpr
compileMarkedExprs :: CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
expr = do
  Name
markerName <- (PluginCtx -> Name)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     Name
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PluginCtx -> Name
pcMarkerName
  case CoreExpr
expr of
    GHC.App
      ( GHC.App
          ( GHC.App
              ( GHC.App
                  -- function id
                  -- sometimes GHCi sticks ticks around this for some reason
                  (CoreExpr -> CoreExpr
stripTicks -> (GHC.Var Var
fid))
                  -- first type argument, must be a string literal type
                  (GHC.Type (Type -> Maybe FastString
GHC.isStrLitTy -> Just FastString
fs_locStr))
                )
              -- second type argument
              (GHC.Type Type
codeTy)
            )
          CoreExpr
_
        )
      -- value argument
      CoreExpr
inner
        | Name
markerName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Var -> Name
GHC.idName Var
fid -> CommandLineOption
-> Type
-> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprOrDefer (FastString -> CommandLineOption
forall a. Show a => a -> CommandLineOption
show FastString
fs_locStr) Type
codeTy CoreExpr
inner
    e :: CoreExpr
e@(GHC.Var Var
fid)
      | Name
markerName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Var -> Name
GHC.idName Var
fid ->
          CompileError DefaultUni DefaultFun Ann
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a.
CompileError DefaultUni DefaultFun Ann
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError DefaultUni DefaultFun Ann
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      CoreExpr)
-> (SDoc -> CompileError DefaultUni DefaultFun Ann)
-> SDoc
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error DefaultUni DefaultFun Ann
-> CompileError DefaultUni DefaultFun Ann
forall c e. e -> WithContext c e
NoContext (Error DefaultUni DefaultFun Ann
 -> CompileError DefaultUni DefaultFun Ann)
-> (SDoc -> Error DefaultUni DefaultFun Ann)
-> SDoc
-> CompileError DefaultUni DefaultFun Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandLineOption -> Error DefaultUni DefaultFun Ann
forall (uni :: * -> *) fun a. CommandLineOption -> Error uni fun a
InvalidMarkerError (CommandLineOption -> Error DefaultUni DefaultFun Ann)
-> (SDoc -> CommandLineOption)
-> SDoc
-> Error DefaultUni DefaultFun Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> CommandLineOption
GHC.showSDocUnsafe (SDoc
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      CoreExpr)
-> SDoc
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr CoreExpr
e
    GHC.App CoreExpr
e CoreExpr
a -> CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
GHC.App (CoreExpr -> CoreExpr -> CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     (CoreExpr -> CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
e ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  (CoreExpr -> CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a b.
ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  (a -> b)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
a
    GHC.Lam Var
b CoreExpr
e -> Var -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
GHC.Lam Var
b (CoreExpr -> CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
e
    GHC.Let CoreBind
bnd CoreExpr
e -> CoreBind -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
GHC.Let (CoreBind -> CoreExpr -> CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreBind
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     (CoreExpr -> CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreBind
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreBind
compileBind CoreBind
bnd ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  (CoreExpr -> CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a b.
ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  (a -> b)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
e
    GHC.Case CoreExpr
e Var
b Type
t [Alt Var]
alts -> do
      CoreExpr
e' <- CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
e
      let expAlt :: Alt Var
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     (Alt Var)
expAlt (GHC.Alt AltCon
a [Var]
bs CoreExpr
rhs) = AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
GHC.Alt AltCon
a [Var]
bs (CoreExpr -> Alt Var)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     (Alt Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
rhs
      [Alt Var]
alts' <- (Alt Var
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      (Alt Var))
-> [Alt Var]
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     [Alt Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Alt Var
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     (Alt Var)
expAlt [Alt Var]
alts
      CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a.
a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      CoreExpr)
-> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
GHC.Case CoreExpr
e' Var
b Type
t [Alt Var]
alts'
    GHC.Cast CoreExpr
e CoercionR
c -> (CoreExpr -> CoercionR -> CoreExpr)
-> CoercionR -> CoreExpr -> CoreExpr
forall a b c. (a -> b -> c) -> b -> a -> c
flip CoreExpr -> CoercionR -> CoreExpr
forall b. Expr b -> CoercionR -> Expr b
GHC.Cast CoercionR
c (CoreExpr -> CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
e
    GHC.Tick CoreTickish
t CoreExpr
e -> CoreTickish -> CoreExpr -> CoreExpr
forall b. CoreTickish -> Expr b -> Expr b
GHC.Tick CoreTickish
t (CoreExpr -> CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprs CoreExpr
e
    e :: CoreExpr
e@(GHC.Coercion CoercionR
_) -> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a.
a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoreExpr
e
    e :: CoreExpr
e@(GHC.Lit Literal
_) -> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a.
a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoreExpr
e
    e :: CoreExpr
e@(GHC.Var Var
_) -> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a.
a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoreExpr
e
    e :: CoreExpr
e@(GHC.Type Type
_) -> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a.
a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoreExpr
e

{-| Behaves the same as 'compileMarkedExpr', unless a compilation error occurs ;
if a compilation error happens and the 'defer-errors' option is turned on,
the compilation error is suppressed and the original hs expression is replaced with a
haskell runtime-error expression.
-}
compileMarkedExprOrDefer
  :: String -> GHC.Type -> GHC.CoreExpr -> PluginM PLC.DefaultUni PLC.DefaultFun GHC.CoreExpr
compileMarkedExprOrDefer :: CommandLineOption
-> Type
-> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExprOrDefer CommandLineOption
locStr Type
codeTy CoreExpr
origE = do
  PluginOptions
opts <- (PluginCtx -> PluginOptions)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     PluginOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PluginCtx -> PluginOptions
pcOpts
  let compileAct :: ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  CoreExpr
compileAct = CommandLineOption
-> Type
-> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExpr CommandLineOption
locStr Type
codeTy CoreExpr
origE
  if PluginOptions -> Bool
_posDeferErrors PluginOptions
opts
    -- TODO: we could perhaps move this catchError to the "runExceptT" module-level, but
    -- it leads to uglier code and difficulty of handling other pure errors
    then ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  CoreExpr
compileAct ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  CoreExpr
-> (CompileError DefaultUni DefaultFun Ann
    -> ReaderT
         PluginCtx
         (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
         CoreExpr)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a.
ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  a
-> (CompileError DefaultUni DefaultFun Ann
    -> ReaderT
         PluginCtx
         (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
         a)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` Type
-> CompileError DefaultUni DefaultFun Ann
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall (uni :: * -> *) fun.
(PrettyUni uni, Pretty fun) =>
Type -> CompileError uni fun Ann -> PluginM uni fun CoreExpr
emitRuntimeError Type
codeTy
    else ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  CoreExpr
compileAct

{-| Given an expected Haskell type 'a', it generates Haskell code which throws a GHC runtime error
\"as\" 'CompiledCode a'.
-}
emitRuntimeError
  :: (PLC.PrettyUni uni, PP.Pretty fun)
  => GHC.Type -> CompileError uni fun Ann -> PluginM uni fun GHC.CoreExpr
emitRuntimeError :: forall (uni :: * -> *) fun.
(PrettyUni uni, Pretty fun) =>
Type -> CompileError uni fun Ann -> PluginM uni fun CoreExpr
emitRuntimeError Type
codeTy CompileError uni fun Ann
e = do
  PluginOptions
opts <- (PluginCtx -> PluginOptions)
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) PluginOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PluginCtx -> PluginOptions
pcOpts
  let shown :: CommandLineOption
shown = Doc Any -> CommandLineOption
forall a. Show a => a -> CommandLineOption
show (Doc Any -> CommandLineOption) -> Doc Any -> CommandLineOption
forall a b. (a -> b) -> a -> b
$ CompileError uni fun Ann -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. CompileError uni fun Ann -> Doc ann
PP.pretty (Int -> CompileError uni fun Ann -> CompileError uni fun Ann
forall c e. Int -> WithContext c e -> WithContext c e
pruneContext (PluginOptions -> Int
_posContextLevel PluginOptions
opts) CompileError uni fun Ann
e)
  Name
tcName <- Name -> PluginM uni fun Name
forall (uni :: * -> *) fun. Name -> PluginM uni fun Name
thNameToGhcNameOrFail ''CompiledCode
  TyCon
tc <- ExceptT (CompileError uni fun Ann) CoreM TyCon
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon
forall (m :: * -> *) a. Monad m => m a -> ReaderT PluginCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (CompileError uni fun Ann) CoreM TyCon
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon)
-> (CoreM TyCon -> ExceptT (CompileError uni fun Ann) CoreM TyCon)
-> CoreM TyCon
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreM TyCon -> ExceptT (CompileError uni fun Ann) CoreM TyCon
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (CompileError uni fun Ann) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CoreM TyCon
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon)
-> CoreM TyCon
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon
forall a b. (a -> b) -> a -> b
$ Name -> CoreM TyCon
forall (m :: * -> *). MonadThings m => Name -> m TyCon
GHC.lookupTyCon Name
tcName
  CoreExpr -> PluginM uni fun CoreExpr
forall a.
a -> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr -> PluginM uni fun CoreExpr)
-> CoreExpr -> PluginM uni fun CoreExpr
forall a b. (a -> b) -> a -> b
$ Type -> CommandLineOption -> CoreExpr
GHC.mkImpossibleExpr (TyCon -> [Type] -> Type
GHC.mkTyConApp TyCon
tc [Type
codeTy]) CommandLineOption
shown

{-| Compile the core expression that is surrounded by a 'plc' marker,
and return a core expression which evaluates to the compiled plc AST as a serialized bytestring,
to be injected back to the Haskell program.
-}
compileMarkedExpr
  :: String -> GHC.Type -> GHC.CoreExpr -> PluginM PLC.DefaultUni PLC.DefaultFun GHC.CoreExpr
compileMarkedExpr :: CommandLineOption
-> Type
-> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
compileMarkedExpr CommandLineOption
locStr Type
codeTy CoreExpr
origE = do
  DynFlags
flags <- ReaderT
  PluginCtx
  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
  DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
GHC.getDynFlags
  FamInstEnvs
famEnvs <- (PluginCtx -> FamInstEnvs)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     FamInstEnvs
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PluginCtx -> FamInstEnvs
pcFamEnvs
  PluginOptions
opts <- (PluginCtx -> PluginOptions)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     PluginOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PluginCtx -> PluginOptions
pcOpts
  ModuleName
moduleName <- (PluginCtx -> ModuleName)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     ModuleName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PluginCtx -> ModuleName
pcModuleName
  let moduleNameStr :: CommandLineOption
moduleNameStr =
        DynFlags -> UnitState -> NamePprCtx -> SDoc -> CommandLineOption
GHC.showSDocForUser DynFlags
flags UnitState
GHC.emptyUnitState NamePprCtx
GHC.alwaysQualify (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr ModuleName
moduleName)
  -- We need to do this out here, since it has to run in CoreM
  NameInfo
nameInfo <-
    [Name] -> PluginM DefaultUni DefaultFun NameInfo
forall (uni :: * -> *) fun. [Name] -> PluginM uni fun NameInfo
makePrimitiveNameInfo ([Name] -> PluginM DefaultUni DefaultFun NameInfo)
-> [Name] -> PluginM DefaultUni DefaultFun NameInfo
forall a b. (a -> b) -> a -> b
$
      [Name]
builtinNames
        [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [ ''Bool
           , 'False
           , 'True
           , 'traceBool
           , 'GHC.Num.Integer.integerNegate
           , '(PlutusTx.Bool.&&)
           , '(PlutusTx.Bool.||)
           , 'PlutusTx.AsData.Internal.wrapTail
           , 'PlutusTx.AsData.Internal.wrapUnsafeDataAsConstr
           , 'PlutusTx.Function.fix
           , 'PlutusTx.Optimize.Inline.inline
           , 'useToOpaque
           , 'useFromOpaque
           , 'mkNilOpaque
           , 'PlutusTx.Builtins.equalsInteger
           ]
  Maybe ModBreaks
modBreaks <- (PluginCtx -> Maybe ModBreaks)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     (Maybe ModBreaks)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PluginCtx -> Maybe ModBreaks
pcModuleModBreaks
  let coverage :: CoverageOpts
coverage =
        Set CoverageType -> CoverageOpts
CoverageOpts (Set CoverageType -> CoverageOpts)
-> ([CoverageType] -> Set CoverageType)
-> [CoverageType]
-> CoverageOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoverageType] -> Set CoverageType
forall a. Ord a => [a] -> Set a
Set.fromList ([CoverageType] -> CoverageOpts) -> [CoverageType] -> CoverageOpts
forall a b. (a -> b) -> a -> b
$
          [CoverageType
l | PluginOptions -> Bool
_posCoverageAll PluginOptions
opts, CoverageType
l <- [CoverageType
forall a. Bounded a => a
minBound .. CoverageType
forall a. Bounded a => a
maxBound]]
            [CoverageType] -> [CoverageType] -> [CoverageType]
forall a. [a] -> [a] -> [a]
++ [CoverageType
LocationCoverage | PluginOptions -> Bool
_posCoverageLocation PluginOptions
opts]
            [CoverageType] -> [CoverageType] -> [CoverageType]
forall a. [a] -> [a] -> [a]
++ [CoverageType
BooleanCoverage | PluginOptions -> Bool
_posCoverageBoolean PluginOptions
opts]
  let ctx :: CompileContext DefaultUni DefaultFun
ctx =
        CompileContext
          { ccOpts :: CompileOptions
ccOpts =
              CompileOptions
                { coProfile :: ProfileOpts
coProfile = PluginOptions -> ProfileOpts
_posProfile PluginOptions
opts
                , coCoverage :: CoverageOpts
coCoverage = CoverageOpts
coverage
                , coDatatypeStyle :: DatatypeStyle
coDatatypeStyle =
                    if PluginOptions -> Version
_posPlcTargetVersion PluginOptions
opts Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
PLC.plcVersion110
                      then DatatypeStyle
PIR.ScottEncoding
                      else DatatypeCompilationOpts -> DatatypeStyle
PIR._dcoStyle (DatatypeCompilationOpts -> DatatypeStyle)
-> DatatypeCompilationOpts -> DatatypeStyle
forall a b. (a -> b) -> a -> b
$ PluginOptions -> DatatypeCompilationOpts
_posDatatypes PluginOptions
opts
                , coRemoveTrace :: Bool
coRemoveTrace = PluginOptions -> Bool
_posRemoveTrace PluginOptions
opts
                , coInlineFix :: Bool
coInlineFix = PluginOptions -> Bool
_posInlineFix PluginOptions
opts
                }
          , ccFlags :: DynFlags
ccFlags = DynFlags
flags
          , ccFamInstEnvs :: FamInstEnvs
ccFamInstEnvs = FamInstEnvs
famEnvs
          , ccNameInfo :: NameInfo
ccNameInfo = NameInfo
nameInfo
          , ccScope :: Scope DefaultUni DefaultFun
ccScope = Scope DefaultUni DefaultFun
forall (uni :: * -> *) fun. Scope uni fun
initialScope
          , ccBlackholed :: Set Name
ccBlackholed = Set Name
forall a. Monoid a => a
mempty
          , ccCurDef :: Maybe LexName
ccCurDef = Maybe LexName
forall a. Maybe a
Nothing
          , ccModBreaks :: Maybe ModBreaks
ccModBreaks = Maybe ModBreaks
modBreaks
          , ccBuiltinsInfo :: BuiltinsInfo DefaultUni DefaultFun
ccBuiltinsInfo = BuiltinsInfo DefaultUni DefaultFun
forall a. Default a => a
def
          , ccBuiltinCostModel :: CostingPart DefaultUni DefaultFun
ccBuiltinCostModel = BuiltinCostModel
CostingPart DefaultUni DefaultFun
forall a. Default a => a
def
          , ccDebugTraceOn :: Bool
ccDebugTraceOn = PluginOptions -> Bool
_posDumpCompilationTrace PluginOptions
opts
          , ccRewriteRules :: RewriteRules DefaultUni DefaultFun
ccRewriteRules = PluginOptions -> RewriteRules DefaultUni DefaultFun
makeRewriteRules PluginOptions
opts
          , ccSafeToInline :: Bool
ccSafeToInline = Bool
False
          }
      st :: CompileState
st = Int -> [Int] -> CompileState
CompileState Int
0 [Int]
forall a. Monoid a => a
mempty
  -- See Note [Occurrence analysis]
  let origE' :: CoreExpr
origE' = CoreExpr -> CoreExpr
GHC.occurAnalyseExpr CoreExpr
origE

  ((PIRProgram DefaultUni DefaultFun
pirP, UPLCProgram DefaultUni DefaultFun
uplcP), CoverageIndex
covIdx) <-
    WriterT
  CoverageIndex
  (ReaderT
     PluginCtx (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))
  (PIRProgram DefaultUni DefaultFun,
   UPLCProgram DefaultUni DefaultFun)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     ((PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun),
      CoverageIndex)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   CoverageIndex
   (ReaderT
      PluginCtx (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))
   (PIRProgram DefaultUni DefaultFun,
    UPLCProgram DefaultUni DefaultFun)
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      ((PIRProgram DefaultUni DefaultFun,
        UPLCProgram DefaultUni DefaultFun),
       CoverageIndex))
-> (StateT
      CompileState
      (ReaderT
         (CompileContext DefaultUni DefaultFun)
         (QuoteT
            (WriterT
               CoverageIndex
               (ReaderT
                  PluginCtx
                  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
      (PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun)
    -> WriterT
         CoverageIndex
         (ReaderT
            PluginCtx (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))
         (PIRProgram DefaultUni DefaultFun,
          UPLCProgram DefaultUni DefaultFun))
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     ((PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun),
      CoverageIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteT
  (WriterT
     CoverageIndex
     (ReaderT
        PluginCtx
        (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))
  (PIRProgram DefaultUni DefaultFun,
   UPLCProgram DefaultUni DefaultFun)
-> WriterT
     CoverageIndex
     (ReaderT
        PluginCtx (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT (QuoteT
   (WriterT
      CoverageIndex
      (ReaderT
         PluginCtx
         (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))
   (PIRProgram DefaultUni DefaultFun,
    UPLCProgram DefaultUni DefaultFun)
 -> WriterT
      CoverageIndex
      (ReaderT
         PluginCtx (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))
      (PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun))
-> (StateT
      CompileState
      (ReaderT
         (CompileContext DefaultUni DefaultFun)
         (QuoteT
            (WriterT
               CoverageIndex
               (ReaderT
                  PluginCtx
                  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
      (PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun)
    -> QuoteT
         (WriterT
            CoverageIndex
            (ReaderT
               PluginCtx
               (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))
         (PIRProgram DefaultUni DefaultFun,
          UPLCProgram DefaultUni DefaultFun))
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
-> WriterT
     CoverageIndex
     (ReaderT
        PluginCtx (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT
   (CompileContext DefaultUni DefaultFun)
   (QuoteT
      (WriterT
         CoverageIndex
         (ReaderT
            PluginCtx
            (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))))
   (PIRProgram DefaultUni DefaultFun,
    UPLCProgram DefaultUni DefaultFun)
 -> CompileContext DefaultUni DefaultFun
 -> QuoteT
      (WriterT
         CoverageIndex
         (ReaderT
            PluginCtx
            (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))
      (PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun))
-> CompileContext DefaultUni DefaultFun
-> ReaderT
     (CompileContext DefaultUni DefaultFun)
     (QuoteT
        (WriterT
           CoverageIndex
           (ReaderT
              PluginCtx
              (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
-> QuoteT
     (WriterT
        CoverageIndex
        (ReaderT
           PluginCtx
           (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (CompileContext DefaultUni DefaultFun)
  (QuoteT
     (WriterT
        CoverageIndex
        (ReaderT
           PluginCtx
           (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))))
  (PIRProgram DefaultUni DefaultFun,
   UPLCProgram DefaultUni DefaultFun)
-> CompileContext DefaultUni DefaultFun
-> QuoteT
     (WriterT
        CoverageIndex
        (ReaderT
           PluginCtx
           (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompileContext DefaultUni DefaultFun
ctx (ReaderT
   (CompileContext DefaultUni DefaultFun)
   (QuoteT
      (WriterT
         CoverageIndex
         (ReaderT
            PluginCtx
            (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))))
   (PIRProgram DefaultUni DefaultFun,
    UPLCProgram DefaultUni DefaultFun)
 -> QuoteT
      (WriterT
         CoverageIndex
         (ReaderT
            PluginCtx
            (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))
      (PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun))
-> (StateT
      CompileState
      (ReaderT
         (CompileContext DefaultUni DefaultFun)
         (QuoteT
            (WriterT
               CoverageIndex
               (ReaderT
                  PluginCtx
                  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
      (PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun)
    -> ReaderT
         (CompileContext DefaultUni DefaultFun)
         (QuoteT
            (WriterT
               CoverageIndex
               (ReaderT
                  PluginCtx
                  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))))
         (PIRProgram DefaultUni DefaultFun,
          UPLCProgram DefaultUni DefaultFun))
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
-> QuoteT
     (WriterT
        CoverageIndex
        (ReaderT
           PluginCtx
           (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   CompileState
   (ReaderT
      (CompileContext DefaultUni DefaultFun)
      (QuoteT
         (WriterT
            CoverageIndex
            (ReaderT
               PluginCtx
               (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
   (PIRProgram DefaultUni DefaultFun,
    UPLCProgram DefaultUni DefaultFun)
 -> CompileState
 -> ReaderT
      (CompileContext DefaultUni DefaultFun)
      (QuoteT
         (WriterT
            CoverageIndex
            (ReaderT
               PluginCtx
               (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))))
      (PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun))
-> CompileState
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
-> ReaderT
     (CompileContext DefaultUni DefaultFun)
     (QuoteT
        (WriterT
           CoverageIndex
           (ReaderT
              PluginCtx
              (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  CompileState
  (ReaderT
     (CompileContext DefaultUni DefaultFun)
     (QuoteT
        (WriterT
           CoverageIndex
           (ReaderT
              PluginCtx
              (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
  (PIRProgram DefaultUni DefaultFun,
   UPLCProgram DefaultUni DefaultFun)
-> CompileState
-> ReaderT
     (CompileContext DefaultUni DefaultFun)
     (QuoteT
        (WriterT
           CoverageIndex
           (ReaderT
              PluginCtx
              (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT CompileState
st (StateT
   CompileState
   (ReaderT
      (CompileContext DefaultUni DefaultFun)
      (QuoteT
         (WriterT
            CoverageIndex
            (ReaderT
               PluginCtx
               (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
   (PIRProgram DefaultUni DefaultFun,
    UPLCProgram DefaultUni DefaultFun)
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      ((PIRProgram DefaultUni DefaultFun,
        UPLCProgram DefaultUni DefaultFun),
       CoverageIndex))
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     ((PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun),
      CoverageIndex)
forall a b. (a -> b) -> a -> b
$
      Int
-> SDoc
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall (uni :: * -> *) fun (m :: * -> *) e a.
(MonadReader (CompileContext uni fun) m, MonadState CompileState m,
 MonadError (WithContext Text e) m) =>
Int -> SDoc -> m a -> m a
traceCompilation Int
1 (SDoc
"Compiling expr at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
GHC.<+> CommandLineOption -> SDoc
forall doc. IsLine doc => CommandLineOption -> doc
GHC.text CommandLineOption
locStr) (StateT
   CompileState
   (ReaderT
      (CompileContext DefaultUni DefaultFun)
      (QuoteT
         (WriterT
            CoverageIndex
            (ReaderT
               PluginCtx
               (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
   (PIRProgram DefaultUni DefaultFun,
    UPLCProgram DefaultUni DefaultFun)
 -> StateT
      CompileState
      (ReaderT
         (CompileContext DefaultUni DefaultFun)
         (QuoteT
            (WriterT
               CoverageIndex
               (ReaderT
                  PluginCtx
                  (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
      (PIRProgram DefaultUni DefaultFun,
       UPLCProgram DefaultUni DefaultFun))
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall a b. (a -> b) -> a -> b
$
        CommandLineOption
-> PluginOptions
-> CoreExpr
-> StateT
     CompileState
     (ReaderT
        (CompileContext DefaultUni DefaultFun)
        (QuoteT
           (WriterT
              CoverageIndex
              (ReaderT
                 PluginCtx
                 (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)))))
     (PIRProgram DefaultUni DefaultFun,
      UPLCProgram DefaultUni DefaultFun)
forall (uni :: * -> *) fun (m :: * -> *).
(uni ~ DefaultUni, fun ~ DefaultFun,
 MonadReader (CompileContext uni fun) m, MonadState CompileState m,
 MonadWriter CoverageIndex m, MonadQuote m,
 MonadError (CompileError uni fun Ann) m, MonadIO m) =>
CommandLineOption
-> PluginOptions
-> CoreExpr
-> m (PIRProgram uni fun, UPLCProgram uni fun)
runCompiler CommandLineOption
moduleNameStr PluginOptions
opts CoreExpr
origE'

  -- serialize the PIR, PLC, and coverageindex outputs into a bytestring.
  CoreExpr
bsPir <- ByteString
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall (uni :: * -> *) fun. ByteString -> PluginM uni fun CoreExpr
makeByteStringLiteral (ByteString
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      CoreExpr)
-> ByteString
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a b. (a -> b) -> a -> b
$ PIRProgram DefaultUni DefaultFun -> ByteString
forall a. Flat a => a -> ByteString
flat PIRProgram DefaultUni DefaultFun
pirP
  CoreExpr
bsPlc <- ByteString
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall (uni :: * -> *) fun. ByteString -> PluginM uni fun CoreExpr
makeByteStringLiteral (ByteString
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      CoreExpr)
-> ByteString
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a b. (a -> b) -> a -> b
$ UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun SrcSpans
-> ByteString
forall a. Flat a => a -> ByteString
flat (UPLCProgram DefaultUni DefaultFun
-> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun SrcSpans
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UPLC.UnrestrictedProgram UPLCProgram DefaultUni DefaultFun
uplcP)
  CoreExpr
covIdxFlat <- ByteString
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall (uni :: * -> *) fun. ByteString -> PluginM uni fun CoreExpr
makeByteStringLiteral (ByteString
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      CoreExpr)
-> ByteString
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a b. (a -> b) -> a -> b
$ CoverageIndex -> ByteString
forall a. Flat a => a -> ByteString
flat CoverageIndex
covIdx

  Var
builder <- ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM Var
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     Var
forall (m :: * -> *) a. Monad m => m a -> ReaderT PluginCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM Var
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      Var)
-> (Name
    -> ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM Var)
-> Name
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreM Var
-> ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM Var
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (CompileError DefaultUni DefaultFun Ann) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CoreM Var
 -> ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM Var)
-> (Name -> CoreM Var)
-> Name
-> ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CoreM Var
forall (m :: * -> *). MonadThings m => Name -> m Var
GHC.lookupId (Name
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      Var)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     Name
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     Var
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     Name
forall (uni :: * -> *) fun. Name -> PluginM uni fun Name
thNameToGhcNameOrFail 'mkCompiledCode

  -- inject the three bytestrings back as Haskell code.
  CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a.
a
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CoreExpr
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
      CoreExpr)
-> CoreExpr
-> ReaderT
     PluginCtx
     (ExceptT (CompileError DefaultUni DefaultFun Ann) CoreM)
     CoreExpr
forall a b. (a -> b) -> a -> b
$
    Var -> CoreExpr
forall b. Var -> Expr b
GHC.Var Var
builder
      CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`GHC.App` Type -> CoreExpr
forall b. Type -> Expr b
GHC.Type Type
codeTy
      CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`GHC.App` CoreExpr
bsPlc
      CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`GHC.App` CoreExpr
bsPir
      CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`GHC.App` CoreExpr
covIdxFlat

{-| The GHC.Core to PIR to PLC compiler pipeline. Returns both the PIR and PLC output.
It invokes the whole compiler chain:  Core expr -> PIR expr -> PLC expr -> UPLC expr.
-}
runCompiler
  :: forall uni fun m
   . ( uni ~ PLC.DefaultUni
     , fun ~ PLC.DefaultFun
     , MonadReader (CompileContext uni fun) m
     , MonadState CompileState m
     , MonadWriter CoverageIndex m
     , MonadQuote m
     , MonadError (CompileError uni fun Ann) m
     , MonadIO m
     )
  => String
  -> PluginOptions
  -> GHC.CoreExpr
  -> m (PIRProgram uni fun, UPLCProgram uni fun)
runCompiler :: forall (uni :: * -> *) fun (m :: * -> *).
(uni ~ DefaultUni, fun ~ DefaultFun,
 MonadReader (CompileContext uni fun) m, MonadState CompileState m,
 MonadWriter CoverageIndex m, MonadQuote m,
 MonadError (CompileError uni fun Ann) m, MonadIO m) =>
CommandLineOption
-> PluginOptions
-> CoreExpr
-> m (PIRProgram uni fun, UPLCProgram uni fun)
runCompiler CommandLineOption
moduleName PluginOptions
opts CoreExpr
expr = do
  -- Plc configuration
  TypeCheckConfig DefaultUni DefaultFun
plcTcConfig <-
    (TypeError
   (Term TyName Name DefaultUni DefaultFun ())
   DefaultUni
   DefaultFun
   (Provenance Ann)
 -> CompileError DefaultUni DefaultFun Ann)
-> ExceptT
     (TypeError
        (Term TyName Name DefaultUni DefaultFun ())
        DefaultUni
        DefaultFun
        (Provenance Ann))
     m
     (TypeCheckConfig DefaultUni DefaultFun)
-> m (TypeCheckConfig DefaultUni DefaultFun)
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError (Error DefaultUni DefaultFun Ann
-> CompileError DefaultUni DefaultFun Ann
forall c e. e -> WithContext c e
NoContext (Error DefaultUni DefaultFun Ann
 -> CompileError DefaultUni DefaultFun Ann)
-> (TypeError
      (Term TyName Name DefaultUni DefaultFun ())
      DefaultUni
      DefaultFun
      (Provenance Ann)
    -> Error DefaultUni DefaultFun Ann)
-> TypeError
     (Term TyName Name DefaultUni DefaultFun ())
     DefaultUni
     DefaultFun
     (Provenance Ann)
-> CompileError DefaultUni DefaultFun Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error DefaultUni DefaultFun (Provenance Ann)
-> Error DefaultUni DefaultFun Ann
forall (uni :: * -> *) fun a.
Error uni fun (Provenance a) -> Error uni fun a
PIRError (Error DefaultUni DefaultFun (Provenance Ann)
 -> Error DefaultUni DefaultFun Ann)
-> (TypeError
      (Term TyName Name DefaultUni DefaultFun ())
      DefaultUni
      DefaultFun
      (Provenance Ann)
    -> Error DefaultUni DefaultFun (Provenance Ann))
-> TypeError
     (Term TyName Name DefaultUni DefaultFun ())
     DefaultUni
     DefaultFun
     (Provenance Ann)
-> Error DefaultUni DefaultFun Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeError
  (Term TyName Name DefaultUni DefaultFun ())
  DefaultUni
  DefaultFun
  (Provenance Ann)
-> Error DefaultUni DefaultFun (Provenance Ann)
forall (uni :: * -> *) fun a.
TypeError (Term TyName Name uni fun ()) uni fun a
-> Error uni fun a
PIR.PLCTypeError) (ExceptT
   (TypeError
      (Term TyName Name DefaultUni DefaultFun ())
      DefaultUni
      DefaultFun
      (Provenance Ann))
   m
   (TypeCheckConfig DefaultUni DefaultFun)
 -> m (TypeCheckConfig DefaultUni DefaultFun))
-> ExceptT
     (TypeError
        (Term TyName Name DefaultUni DefaultFun ())
        DefaultUni
        DefaultFun
        (Provenance Ann))
     m
     (TypeCheckConfig DefaultUni DefaultFun)
-> m (TypeCheckConfig DefaultUni DefaultFun)
forall a b. (a -> b) -> a -> b
$
      Provenance Ann
-> ExceptT
     (TypeError
        (Term TyName Name DefaultUni DefaultFun ())
        DefaultUni
        DefaultFun
        (Provenance Ann))
     m
     (TypeCheckConfig DefaultUni DefaultFun)
forall term (uni :: * -> *) fun ann (m :: * -> *).
(MonadKindCheck (TypeError term uni fun ann) term uni fun ann m,
 Typecheckable uni fun) =>
ann -> m (TypeCheckConfig uni fun)
PLC.getDefTypeCheckConfig Provenance Ann
forall a. Provenance a
PIR.noProvenance
  DatatypeStyle
datatypeStyle <- (CompileContext DefaultUni DefaultFun -> DatatypeStyle)
-> m DatatypeStyle
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((CompileContext DefaultUni DefaultFun -> DatatypeStyle)
 -> m DatatypeStyle)
-> (CompileContext DefaultUni DefaultFun -> DatatypeStyle)
-> m DatatypeStyle
forall a b. (a -> b) -> a -> b
$ CompileOptions -> DatatypeStyle
coDatatypeStyle (CompileOptions -> DatatypeStyle)
-> (CompileContext DefaultUni DefaultFun -> CompileOptions)
-> CompileContext DefaultUni DefaultFun
-> DatatypeStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileContext DefaultUni DefaultFun -> CompileOptions
forall (uni :: * -> *) fun.
CompileContext uni fun -> CompileOptions
ccOpts
  let plcVersion :: Version
plcVersion = PluginOptions
opts PluginOptions -> Getting Version PluginOptions Version -> Version
forall s a. s -> Getting a s a -> a
^. Getting Version PluginOptions Version
Lens' PluginOptions Version
posPlcTargetVersion
      hints :: InlineHints name (Provenance Ann)
hints = (Provenance Ann -> name -> Inline)
-> InlineHints name (Provenance Ann)
forall name a. (a -> name -> Inline) -> InlineHints name a
UPLC.InlineHints ((Provenance Ann -> name -> Inline)
 -> InlineHints name (Provenance Ann))
-> (Provenance Ann -> name -> Inline)
-> InlineHints name (Provenance Ann)
forall a b. (a -> b) -> a -> b
$ \Provenance Ann
ann name
_ -> case Provenance Ann
ann of
        -- See Note [The problem of inlining destructors]
        -- We want to inline destructors, but even in UPLC our inlining heuristics
        -- aren't quite smart enough to tell that they're good inlining candidates,
        -- so we just explicitly tell the inliner to inline them all.
        --
        -- In fact, this instructs the inliner to inline *any* binding inside a destructor,
        -- which is a slightly large hammer but is actually what we want since it will mean
        -- that we also aggressively reduce the bindings inside the destructor.
        PIR.DatatypeComponent DatatypeComponent
PIR.Destructor Provenance Ann
_ -> Inline
AlwaysInline
        Provenance Ann
_
          | Inline
AlwaysInline Inline -> [Inline] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Ann -> Inline) -> [Ann] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ann -> Inline
annInline (Provenance Ann -> [Ann]
forall a. Provenance a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Provenance Ann
ann) -> Inline
AlwaysInline
          | Inline
SafeToInline Inline -> [Inline] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Ann -> Inline) -> [Ann] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ann -> Inline
annInline (Provenance Ann -> [Ann]
forall a. Provenance a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Provenance Ann
ann) -> Inline
SafeToInline
          | Bool
otherwise -> Inline
MayInline

  RewriteRules DefaultUni DefaultFun
rewriteRules <- (CompileContext DefaultUni DefaultFun
 -> RewriteRules DefaultUni DefaultFun)
-> m (RewriteRules DefaultUni DefaultFun)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CompileContext DefaultUni DefaultFun
-> RewriteRules DefaultUni DefaultFun
forall (uni :: * -> *) fun.
CompileContext uni fun -> RewriteRules uni fun
ccRewriteRules

  -- Compilation configuration
  -- pir's tc-config is based on plc tcconfig
  let pirTcConfig :: PirTCConfig DefaultUni DefaultFun
pirTcConfig = TypeCheckConfig DefaultUni DefaultFun
-> AllowEscape -> PirTCConfig DefaultUni DefaultFun
forall (uni :: * -> *) fun.
TypeCheckConfig uni fun -> AllowEscape -> PirTCConfig uni fun
PIR.PirTCConfig TypeCheckConfig DefaultUni DefaultFun
plcTcConfig AllowEscape
PIR.YesEscape
      pirCtx :: CompilationCtx DefaultUni DefaultFun Ann
pirCtx =
        TypeCheckConfig DefaultUni DefaultFun
-> CompilationCtx DefaultUni DefaultFun Ann
forall (uni :: * -> *) fun a.
(Default (BuiltinsInfo uni fun), Default (CostingPart uni fun),
 Default (RewriteRules uni fun)) =>
TypeCheckConfig uni fun -> CompilationCtx uni fun a
PIR.toDefaultCompilationCtx TypeCheckConfig DefaultUni DefaultFun
plcTcConfig
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coOptimize) (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posOptimize)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coTypecheck) (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDoTypecheck)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coPedantic) (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posPedantic)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coVerbose) (PluginOptions
opts PluginOptions
-> Getting Verbosity PluginOptions Verbosity -> Verbosity
forall s a. s -> Getting a s a -> a
^. Getting Verbosity PluginOptions Verbosity
Lens' PluginOptions Verbosity
posVerbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coDebug) (PluginOptions
opts PluginOptions
-> Getting Verbosity PluginOptions Verbosity -> Verbosity
forall s a. s -> Getting a s a -> a
^. Getting Verbosity PluginOptions Verbosity
Lens' PluginOptions Verbosity
posVerbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Debug)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Int
  Int
-> Int
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Int -> Identity Int)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Int
     Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coMaxSimplifierIterations)
            (PluginOptions
opts PluginOptions -> Getting Int PluginOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int PluginOptions Int
Lens' PluginOptions Int
posMaxSimplifierIterationsPir)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (PirTCConfig DefaultUni DefaultFun)
  (PirTCConfig DefaultUni DefaultFun)
-> PirTCConfig DefaultUni DefaultFun
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (PirTCConfig DefaultUni DefaultFun)
  (PirTCConfig DefaultUni DefaultFun)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(PirTCConfig uni fun -> f (PirTCConfig uni fun))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccTypeCheckConfig PirTCConfig DefaultUni DefaultFun
pirTcConfig
          -- Simplifier options
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coDoSimplifierUnwrapCancel)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDoSimplifierUnwrapCancel)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coDoSimplifierBeta)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDoSimplifierBeta)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coDoSimplifierInline)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDoSimplifierInline)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coDoSimplifierEvaluateBuiltins)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDoSimplifierEvaluateBuiltins)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coDoSimplifierStrictifyBindings)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDoSimplifierStrictifyBindings)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coDoSimplifierRemoveDeadBindings)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDoSimplifierRemoveDeadBindings)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coInlineConstants)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posInlineConstants)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coInlineFix)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posInlineFix)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (InlineHints Name (Provenance Ann))
  (InlineHints Name (Provenance Ann))
-> InlineHints Name (Provenance Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((InlineHints Name (Provenance Ann)
     -> Identity (InlineHints Name (Provenance Ann)))
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     (InlineHints Name (Provenance Ann))
     (InlineHints Name (Provenance Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InlineHints Name (Provenance Ann)
 -> Identity (InlineHints Name (Provenance Ann)))
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a1 a2 (f :: * -> *).
Functor f =>
(InlineHints Name (Provenance a1)
 -> f (InlineHints Name (Provenance a2)))
-> CompilationOpts a1 -> f (CompilationOpts a2)
PIR.coInlineHints) InlineHints Name (Provenance Ann)
forall {name}. InlineHints name (Provenance Ann)
hints
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Size
  Size
-> Size
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Size -> Identity Size)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Size
     Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Identity Size)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Size -> f Size) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coInlineCallsiteGrowth)
            (PluginOptions
opts PluginOptions -> Getting Size PluginOptions Size -> Size
forall s a. s -> Getting a s a -> a
^. (Int -> Const Size Int)
-> PluginOptions -> Const Size PluginOptions
Lens' PluginOptions Int
posInlineCallsiteGrowth ((Int -> Const Size Int)
 -> PluginOptions -> Const Size PluginOptions)
-> ((Size -> Const Size Size) -> Int -> Const Size Int)
-> Getting Size PluginOptions Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Size) -> (Size -> Const Size Size) -> Int -> Const Size Int
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coRelaxedFloatin) (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posRelaxedFloatin)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coCaseOfCaseConservative)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posCaseOfCaseConservative)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  Bool
  Bool
-> Bool
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((Bool -> Identity Bool)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coPreserveLogging) (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posPreserveLogging)
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  DatatypeStyle
  DatatypeStyle
-> DatatypeStyle
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> Identity (CompilationCtx DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccOpts ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> Identity (CompilationCtx DefaultUni DefaultFun Ann))
-> ((DatatypeStyle -> Identity DatatypeStyle)
    -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
     (CompilationCtx DefaultUni DefaultFun Ann)
     (CompilationCtx DefaultUni DefaultFun Ann)
     DatatypeStyle
     DatatypeStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DatatypeCompilationOpts -> Identity DatatypeCompilationOpts)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann)
forall a (f :: * -> *).
Functor f =>
(DatatypeCompilationOpts -> f DatatypeCompilationOpts)
-> CompilationOpts a -> f (CompilationOpts a)
PIR.coDatatypes ((DatatypeCompilationOpts -> Identity DatatypeCompilationOpts)
 -> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ((DatatypeStyle -> Identity DatatypeStyle)
    -> DatatypeCompilationOpts -> Identity DatatypeCompilationOpts)
-> (DatatypeStyle -> Identity DatatypeStyle)
-> CompilationOpts Ann
-> Identity (CompilationOpts Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DatatypeStyle -> Identity DatatypeStyle)
-> DatatypeCompilationOpts -> Identity DatatypeCompilationOpts
Iso' DatatypeCompilationOpts DatatypeStyle
PIR.dcoStyle) DatatypeStyle
datatypeStyle
          -- TODO: ensure the same as the one used in the plugin
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (BuiltinsInfo DefaultUni DefaultFun)
  (BuiltinsInfo DefaultUni DefaultFun)
-> BuiltinsInfo DefaultUni DefaultFun
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (BuiltinsInfo DefaultUni DefaultFun)
  (BuiltinsInfo DefaultUni DefaultFun)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(BuiltinsInfo uni fun -> f (BuiltinsInfo uni fun))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccBuiltinsInfo BuiltinsInfo DefaultUni DefaultFun
forall a. Default a => a
def
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CostingPart DefaultUni DefaultFun)
  (CostingPart DefaultUni DefaultFun)
-> CostingPart DefaultUni DefaultFun
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CostingPart DefaultUni DefaultFun)
  (CostingPart DefaultUni DefaultFun)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CostingPart uni fun -> f (CostingPart uni fun))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccBuiltinCostModel CostingPart DefaultUni DefaultFun
forall a. Default a => a
def
          CompilationCtx DefaultUni DefaultFun Ann
-> (CompilationCtx DefaultUni DefaultFun Ann
    -> CompilationCtx DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (RewriteRules DefaultUni DefaultFun)
  (RewriteRules DefaultUni DefaultFun)
-> RewriteRules DefaultUni DefaultFun
-> CompilationCtx DefaultUni DefaultFun Ann
-> CompilationCtx DefaultUni DefaultFun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (CompilationCtx DefaultUni DefaultFun Ann)
  (CompilationCtx DefaultUni DefaultFun Ann)
  (RewriteRules DefaultUni DefaultFun)
  (RewriteRules DefaultUni DefaultFun)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(RewriteRules uni fun -> f (RewriteRules uni fun))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
PIR.ccRewriteRules RewriteRules DefaultUni DefaultFun
rewriteRules
      plcOpts :: CompilationOpts name2 DefaultFun (Provenance Ann)
plcOpts =
        CompilationOpts Any DefaultFun Any
forall fun name a.
Default (BuiltinSemanticsVariant fun) =>
CompilationOpts name fun a
PLC.defaultCompilationOpts
          CompilationOpts Any DefaultFun Any
-> (CompilationOpts Any DefaultFun Any
    -> CompilationOpts Any DefaultFun Any)
-> CompilationOpts Any DefaultFun Any
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationOpts Any DefaultFun Any)
  (CompilationOpts Any DefaultFun Any)
  Int
  Int
-> Int
-> CompilationOpts Any DefaultFun Any
-> CompilationOpts Any DefaultFun Any
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
-> CompilationOpts Any DefaultFun Any
-> Identity (CompilationOpts Any DefaultFun Any)
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
PLC.coSimplifyOpts ((SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
 -> CompilationOpts Any DefaultFun Any
 -> Identity (CompilationOpts Any DefaultFun Any))
-> ((Int -> Identity Int)
    -> SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
-> ASetter
     (CompilationOpts Any DefaultFun Any)
     (CompilationOpts Any DefaultFun Any)
     Int
     Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int)
-> SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any)
forall name a (f :: * -> *).
Functor f =>
(Int -> f Int) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soMaxSimplifierIterations)
            (PluginOptions
opts PluginOptions -> Getting Int PluginOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int PluginOptions Int
Lens' PluginOptions Int
posMaxSimplifierIterationsUPlc)
          CompilationOpts Any DefaultFun Any
-> (CompilationOpts Any DefaultFun Any
    -> CompilationOpts Any DefaultFun Any)
-> CompilationOpts Any DefaultFun Any
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationOpts Any DefaultFun Any)
  (CompilationOpts Any DefaultFun Any)
  Int
  Int
-> Int
-> CompilationOpts Any DefaultFun Any
-> CompilationOpts Any DefaultFun Any
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
-> CompilationOpts Any DefaultFun Any
-> Identity (CompilationOpts Any DefaultFun Any)
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
PLC.coSimplifyOpts ((SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
 -> CompilationOpts Any DefaultFun Any
 -> Identity (CompilationOpts Any DefaultFun Any))
-> ((Int -> Identity Int)
    -> SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
-> ASetter
     (CompilationOpts Any DefaultFun Any)
     (CompilationOpts Any DefaultFun Any)
     Int
     Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int)
-> SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any)
forall name a (f :: * -> *).
Functor f =>
(Int -> f Int) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soMaxCseIterations)
            (PluginOptions
opts PluginOptions -> Getting Int PluginOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int PluginOptions Int
Lens' PluginOptions Int
posMaxCseIterations)
          CompilationOpts Any DefaultFun Any
-> (CompilationOpts Any DefaultFun Any
    -> CompilationOpts Any DefaultFun Any)
-> CompilationOpts Any DefaultFun Any
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationOpts Any DefaultFun Any)
  (CompilationOpts Any DefaultFun Any)
  Bool
  Bool
-> Bool
-> CompilationOpts Any DefaultFun Any
-> CompilationOpts Any DefaultFun Any
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
-> CompilationOpts Any DefaultFun Any
-> Identity (CompilationOpts Any DefaultFun Any)
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
PLC.coSimplifyOpts ((SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
 -> CompilationOpts Any DefaultFun Any
 -> Identity (CompilationOpts Any DefaultFun Any))
-> ((Bool -> Identity Bool)
    -> SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any))
-> ASetter
     (CompilationOpts Any DefaultFun Any)
     (CompilationOpts Any DefaultFun Any)
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> SimplifyOpts Any Any -> Identity (SimplifyOpts Any Any)
forall name a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soConservativeOpts)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posConservativeOpts)
          CompilationOpts Any DefaultFun Any
-> (CompilationOpts Any DefaultFun Any
    -> CompilationOpts name2 DefaultFun (Provenance Ann))
-> CompilationOpts name2 DefaultFun (Provenance Ann)
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationOpts Any DefaultFun Any)
  (CompilationOpts name2 DefaultFun (Provenance Ann))
  (InlineHints Any Any)
  (InlineHints name2 (Provenance Ann))
-> InlineHints name2 (Provenance Ann)
-> CompilationOpts Any DefaultFun Any
-> CompilationOpts name2 DefaultFun (Provenance Ann)
forall s t a b. ASetter s t a b -> b -> s -> t
set ((SimplifyOpts Any Any
 -> Identity (SimplifyOpts name2 (Provenance Ann)))
-> CompilationOpts Any DefaultFun Any
-> Identity (CompilationOpts name2 DefaultFun (Provenance Ann))
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
PLC.coSimplifyOpts ((SimplifyOpts Any Any
  -> Identity (SimplifyOpts name2 (Provenance Ann)))
 -> CompilationOpts Any DefaultFun Any
 -> Identity (CompilationOpts name2 DefaultFun (Provenance Ann)))
-> ((InlineHints Any Any
     -> Identity (InlineHints name2 (Provenance Ann)))
    -> SimplifyOpts Any Any
    -> Identity (SimplifyOpts name2 (Provenance Ann)))
-> ASetter
     (CompilationOpts Any DefaultFun Any)
     (CompilationOpts name2 DefaultFun (Provenance Ann))
     (InlineHints Any Any)
     (InlineHints name2 (Provenance Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InlineHints Any Any
 -> Identity (InlineHints name2 (Provenance Ann)))
-> SimplifyOpts Any Any
-> Identity (SimplifyOpts name2 (Provenance Ann))
forall name1 a1 name2 a2 (f :: * -> *).
Functor f =>
(InlineHints name1 a1 -> f (InlineHints name2 a2))
-> SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2)
UPLC.soInlineHints) InlineHints name2 (Provenance Ann)
forall {name}. InlineHints name (Provenance Ann)
hints
          CompilationOpts name2 DefaultFun (Provenance Ann)
-> (CompilationOpts name2 DefaultFun (Provenance Ann)
    -> CompilationOpts name2 DefaultFun (Provenance Ann))
-> CompilationOpts name2 DefaultFun (Provenance Ann)
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationOpts name2 DefaultFun (Provenance Ann))
  (CompilationOpts name2 DefaultFun (Provenance Ann))
  Bool
  Bool
-> Bool
-> CompilationOpts name2 DefaultFun (Provenance Ann)
-> CompilationOpts name2 DefaultFun (Provenance Ann)
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((SimplifyOpts name2 (Provenance Ann)
 -> Identity (SimplifyOpts name2 (Provenance Ann)))
-> CompilationOpts name2 DefaultFun (Provenance Ann)
-> Identity (CompilationOpts name2 DefaultFun (Provenance Ann))
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
PLC.coSimplifyOpts ((SimplifyOpts name2 (Provenance Ann)
  -> Identity (SimplifyOpts name2 (Provenance Ann)))
 -> CompilationOpts name2 DefaultFun (Provenance Ann)
 -> Identity (CompilationOpts name2 DefaultFun (Provenance Ann)))
-> ((Bool -> Identity Bool)
    -> SimplifyOpts name2 (Provenance Ann)
    -> Identity (SimplifyOpts name2 (Provenance Ann)))
-> ASetter
     (CompilationOpts name2 DefaultFun (Provenance Ann))
     (CompilationOpts name2 DefaultFun (Provenance Ann))
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> SimplifyOpts name2 (Provenance Ann)
-> Identity (SimplifyOpts name2 (Provenance Ann))
forall name a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soInlineConstants)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posInlineConstants)
          CompilationOpts name2 DefaultFun (Provenance Ann)
-> (CompilationOpts name2 DefaultFun (Provenance Ann)
    -> CompilationOpts name2 DefaultFun (Provenance Ann))
-> CompilationOpts name2 DefaultFun (Provenance Ann)
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationOpts name2 DefaultFun (Provenance Ann))
  (CompilationOpts name2 DefaultFun (Provenance Ann))
  Size
  Size
-> Size
-> CompilationOpts name2 DefaultFun (Provenance Ann)
-> CompilationOpts name2 DefaultFun (Provenance Ann)
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((SimplifyOpts name2 (Provenance Ann)
 -> Identity (SimplifyOpts name2 (Provenance Ann)))
-> CompilationOpts name2 DefaultFun (Provenance Ann)
-> Identity (CompilationOpts name2 DefaultFun (Provenance Ann))
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
PLC.coSimplifyOpts ((SimplifyOpts name2 (Provenance Ann)
  -> Identity (SimplifyOpts name2 (Provenance Ann)))
 -> CompilationOpts name2 DefaultFun (Provenance Ann)
 -> Identity (CompilationOpts name2 DefaultFun (Provenance Ann)))
-> ((Size -> Identity Size)
    -> SimplifyOpts name2 (Provenance Ann)
    -> Identity (SimplifyOpts name2 (Provenance Ann)))
-> ASetter
     (CompilationOpts name2 DefaultFun (Provenance Ann))
     (CompilationOpts name2 DefaultFun (Provenance Ann))
     Size
     Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Identity Size)
-> SimplifyOpts name2 (Provenance Ann)
-> Identity (SimplifyOpts name2 (Provenance Ann))
forall name a (f :: * -> *).
Functor f =>
(Size -> f Size) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soInlineCallsiteGrowth)
            (PluginOptions
opts PluginOptions -> Getting Size PluginOptions Size -> Size
forall s a. s -> Getting a s a -> a
^. (Int -> Const Size Int)
-> PluginOptions -> Const Size PluginOptions
Lens' PluginOptions Int
posInlineCallsiteGrowth ((Int -> Const Size Int)
 -> PluginOptions -> Const Size PluginOptions)
-> ((Size -> Const Size Size) -> Int -> Const Size Int)
-> Getting Size PluginOptions Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Size) -> (Size -> Const Size Size) -> Int -> Const Size Int
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
          CompilationOpts name2 DefaultFun (Provenance Ann)
-> (CompilationOpts name2 DefaultFun (Provenance Ann)
    -> CompilationOpts name2 DefaultFun (Provenance Ann))
-> CompilationOpts name2 DefaultFun (Provenance Ann)
forall a b. a -> (a -> b) -> b
& ASetter
  (CompilationOpts name2 DefaultFun (Provenance Ann))
  (CompilationOpts name2 DefaultFun (Provenance Ann))
  Bool
  Bool
-> Bool
-> CompilationOpts name2 DefaultFun (Provenance Ann)
-> CompilationOpts name2 DefaultFun (Provenance Ann)
forall s t a b. ASetter s t a b -> b -> s -> t
set
            ((SimplifyOpts name2 (Provenance Ann)
 -> Identity (SimplifyOpts name2 (Provenance Ann)))
-> CompilationOpts name2 DefaultFun (Provenance Ann)
-> Identity (CompilationOpts name2 DefaultFun (Provenance Ann))
forall name1 fun a1 name2 a2 (f :: * -> *).
Functor f =>
(SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2))
-> CompilationOpts name1 fun a1 -> f (CompilationOpts name2 fun a2)
PLC.coSimplifyOpts ((SimplifyOpts name2 (Provenance Ann)
  -> Identity (SimplifyOpts name2 (Provenance Ann)))
 -> CompilationOpts name2 DefaultFun (Provenance Ann)
 -> Identity (CompilationOpts name2 DefaultFun (Provenance Ann)))
-> ((Bool -> Identity Bool)
    -> SimplifyOpts name2 (Provenance Ann)
    -> Identity (SimplifyOpts name2 (Provenance Ann)))
-> ASetter
     (CompilationOpts name2 DefaultFun (Provenance Ann))
     (CompilationOpts name2 DefaultFun (Provenance Ann))
     Bool
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> SimplifyOpts name2 (Provenance Ann)
-> Identity (SimplifyOpts name2 (Provenance Ann))
forall name a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soPreserveLogging)
            (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posPreserveLogging)

  -- GHC.Core -> Pir translation.
  Term TyName Name DefaultUni DefaultFun (Provenance Ann)
pirT <- Term TyName Name DefaultUni DefaultFun Ann
-> Term TyName Name DefaultUni DefaultFun (Provenance Ann)
forall (f :: * -> *) a. Functor f => f a -> f (Provenance a)
original (Term TyName Name DefaultUni DefaultFun Ann
 -> Term TyName Name DefaultUni DefaultFun (Provenance Ann))
-> m (Term TyName Name DefaultUni DefaultFun Ann)
-> m (Term TyName Name DefaultUni DefaultFun (Provenance Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ann
-> DefT
     LexName
     DefaultUni
     DefaultFun
     Ann
     m
     (Term TyName Name DefaultUni DefaultFun Ann)
-> m (Term TyName Name DefaultUni DefaultFun Ann)
forall (m :: * -> *) key ann (uni :: * -> *) fun.
(Monad m, Ord key) =>
ann
-> DefT key uni fun ann m (Term TyName Name uni fun ann)
-> m (Term TyName Name uni fun ann)
PIR.runDefT Ann
forall a. AnnInline a => a
annMayInline (DefT
   LexName
   DefaultUni
   DefaultFun
   Ann
   m
   (Term TyName Name DefaultUni DefaultFun Ann)
 -> m (Term TyName Name DefaultUni DefaultFun Ann))
-> DefT
     LexName
     DefaultUni
     DefaultFun
     Ann
     m
     (Term TyName Name DefaultUni DefaultFun Ann)
-> m (Term TyName Name DefaultUni DefaultFun Ann)
forall a b. (a -> b) -> a -> b
$ CoreExpr
-> DefT
     LexName
     DefaultUni
     DefaultFun
     Ann
     m
     (Term TyName Name DefaultUni DefaultFun Ann)
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
CoreExpr -> m (PIRTerm uni fun)
compileExprWithDefs CoreExpr
expr)
  let pirP :: Program TyName Name DefaultUni DefaultFun (Provenance Ann)
pirP = Provenance Ann
-> Version
-> Term TyName Name DefaultUni DefaultFun (Provenance Ann)
-> Program TyName Name DefaultUni DefaultFun (Provenance Ann)
forall tyname name (uni :: * -> *) fun ann.
ann
-> Version
-> Term tyname name uni fun ann
-> Program tyname name uni fun ann
PIR.Program Provenance Ann
forall a. Provenance a
noProvenance Version
plcVersion Term TyName Name DefaultUni DefaultFun (Provenance Ann)
pirT
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDumpPir) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    Program TyName Name DefaultUni DefaultFun ()
-> CommandLineOption -> CommandLineOption -> IO ()
forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat (Program TyName Name DefaultUni DefaultFun (Provenance Ann)
-> Program TyName Name DefaultUni DefaultFun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Program TyName Name DefaultUni DefaultFun (Provenance Ann)
pirP) CommandLineOption
"initial PIR program" (CommandLineOption
moduleName CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
"_initial.pir-flat")

  -- Pir -> (Simplified) Pir pass. We can then dump/store a more legible PIR program.
  Program TyName Name DefaultUni DefaultFun (Provenance Ann)
spirP <-
    (ReaderT
   (CompilationCtx DefaultUni DefaultFun Ann)
   m
   (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> m (Program TyName Name DefaultUni DefaultFun (Provenance Ann)))
-> CompilationCtx DefaultUni DefaultFun Ann
-> ReaderT
     (CompilationCtx DefaultUni DefaultFun Ann)
     m
     (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
-> m (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (CompilationCtx DefaultUni DefaultFun Ann)
  m
  (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> m (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilationCtx DefaultUni DefaultFun Ann
pirCtx (ReaderT
   (CompilationCtx DefaultUni DefaultFun Ann)
   m
   (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
 -> m (Program TyName Name DefaultUni DefaultFun (Provenance Ann)))
-> ReaderT
     (CompilationCtx DefaultUni DefaultFun Ann)
     m
     (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
-> m (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
forall a b. (a -> b) -> a -> b
$
      (Error DefaultUni DefaultFun (Provenance Ann)
 -> CompileError DefaultUni DefaultFun Ann)
-> ExceptT
     (Error DefaultUni DefaultFun (Provenance Ann))
     (ReaderT (CompilationCtx DefaultUni DefaultFun Ann) m)
     (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
-> ReaderT
     (CompilationCtx DefaultUni DefaultFun Ann)
     m
     (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError (Error DefaultUni DefaultFun Ann
-> CompileError DefaultUni DefaultFun Ann
forall c e. e -> WithContext c e
NoContext (Error DefaultUni DefaultFun Ann
 -> CompileError DefaultUni DefaultFun Ann)
-> (Error DefaultUni DefaultFun (Provenance Ann)
    -> Error DefaultUni DefaultFun Ann)
-> Error DefaultUni DefaultFun (Provenance Ann)
-> CompileError DefaultUni DefaultFun Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error DefaultUni DefaultFun (Provenance Ann)
-> Error DefaultUni DefaultFun Ann
forall (uni :: * -> *) fun a.
Error uni fun (Provenance a) -> Error uni fun a
PIRError) (ExceptT
   (Error DefaultUni DefaultFun (Provenance Ann))
   (ReaderT (CompilationCtx DefaultUni DefaultFun Ann) m)
   (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
 -> ReaderT
      (CompilationCtx DefaultUni DefaultFun Ann)
      m
      (Program TyName Name DefaultUni DefaultFun (Provenance Ann)))
-> ExceptT
     (Error DefaultUni DefaultFun (Provenance Ann))
     (ReaderT (CompilationCtx DefaultUni DefaultFun Ann) m)
     (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
-> ReaderT
     (CompilationCtx DefaultUni DefaultFun Ann)
     m
     (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
forall a b. (a -> b) -> a -> b
$
        Program TyName Name DefaultUni DefaultFun (Provenance Ann)
-> ExceptT
     (Error DefaultUni DefaultFun (Provenance Ann))
     (ReaderT (CompilationCtx DefaultUni DefaultFun Ann) m)
     (Program TyName Name DefaultUni DefaultFun (Provenance Ann))
forall (m :: * -> *) (uni :: * -> *) fun a b.
(Compiling m uni fun a, b ~ Provenance a) =>
Program TyName Name uni fun b -> m (Program TyName Name uni fun b)
PIR.compileToReadable Program TyName Name DefaultUni DefaultFun (Provenance Ann)
pirP
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDumpPir) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
      Program TyName Name DefaultUni DefaultFun ()
-> CommandLineOption -> CommandLineOption -> IO ()
forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat (Program TyName Name DefaultUni DefaultFun (Provenance Ann)
-> Program TyName Name DefaultUni DefaultFun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Program TyName Name DefaultUni DefaultFun (Provenance Ann)
spirP) CommandLineOption
"simplified PIR program" (CommandLineOption
moduleName CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
"_simplified.pir-flat")

  -- (Simplified) Pir -> Plc translation.
  PLCProgram DefaultUni DefaultFun Ann
plcP <- (ReaderT
   (CompilationCtx DefaultUni DefaultFun Ann)
   m
   (PLCProgram DefaultUni DefaultFun Ann)
 -> CompilationCtx DefaultUni DefaultFun Ann
 -> m (PLCProgram DefaultUni DefaultFun Ann))
-> CompilationCtx DefaultUni DefaultFun Ann
-> ReaderT
     (CompilationCtx DefaultUni DefaultFun Ann)
     m
     (PLCProgram DefaultUni DefaultFun Ann)
-> m (PLCProgram DefaultUni DefaultFun Ann)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (CompilationCtx DefaultUni DefaultFun Ann)
  m
  (PLCProgram DefaultUni DefaultFun Ann)
-> CompilationCtx DefaultUni DefaultFun Ann
-> m (PLCProgram DefaultUni DefaultFun Ann)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilationCtx DefaultUni DefaultFun Ann
pirCtx (ReaderT
   (CompilationCtx DefaultUni DefaultFun Ann)
   m
   (PLCProgram DefaultUni DefaultFun Ann)
 -> m (PLCProgram DefaultUni DefaultFun Ann))
-> ReaderT
     (CompilationCtx DefaultUni DefaultFun Ann)
     m
     (PLCProgram DefaultUni DefaultFun Ann)
-> m (PLCProgram DefaultUni DefaultFun Ann)
forall a b. (a -> b) -> a -> b
$
    (Error DefaultUni DefaultFun (Provenance Ann)
 -> CompileError DefaultUni DefaultFun Ann)
-> ExceptT
     (Error DefaultUni DefaultFun (Provenance Ann))
     (ReaderT (CompilationCtx DefaultUni DefaultFun Ann) m)
     (PLCProgram DefaultUni DefaultFun Ann)
-> ReaderT
     (CompilationCtx DefaultUni DefaultFun Ann)
     m
     (PLCProgram DefaultUni DefaultFun Ann)
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError (Error DefaultUni DefaultFun Ann
-> CompileError DefaultUni DefaultFun Ann
forall c e. e -> WithContext c e
NoContext (Error DefaultUni DefaultFun Ann
 -> CompileError DefaultUni DefaultFun Ann)
-> (Error DefaultUni DefaultFun (Provenance Ann)
    -> Error DefaultUni DefaultFun Ann)
-> Error DefaultUni DefaultFun (Provenance Ann)
-> CompileError DefaultUni DefaultFun Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error DefaultUni DefaultFun (Provenance Ann)
-> Error DefaultUni DefaultFun Ann
forall (uni :: * -> *) fun a.
Error uni fun (Provenance a) -> Error uni fun a
PIRError) (ExceptT
   (Error DefaultUni DefaultFun (Provenance Ann))
   (ReaderT (CompilationCtx DefaultUni DefaultFun Ann) m)
   (PLCProgram DefaultUni DefaultFun Ann)
 -> ReaderT
      (CompilationCtx DefaultUni DefaultFun Ann)
      m
      (PLCProgram DefaultUni DefaultFun Ann))
-> ExceptT
     (Error DefaultUni DefaultFun (Provenance Ann))
     (ReaderT (CompilationCtx DefaultUni DefaultFun Ann) m)
     (PLCProgram DefaultUni DefaultFun Ann)
-> ReaderT
     (CompilationCtx DefaultUni DefaultFun Ann)
     m
     (PLCProgram DefaultUni DefaultFun Ann)
forall a b. (a -> b) -> a -> b
$
      Program TyName Name DefaultUni DefaultFun (Provenance Ann)
-> ExceptT
     (Error DefaultUni DefaultFun (Provenance Ann))
     (ReaderT (CompilationCtx DefaultUni DefaultFun Ann) m)
     (PLCProgram DefaultUni DefaultFun Ann)
forall (m :: * -> *) (uni :: * -> *) fun a b.
(Compiling m uni fun a, b ~ Provenance a) =>
Program TyName Name uni fun b -> m (PLCProgram uni fun a)
PIR.compileReadableToPlc Program TyName Name DefaultUni DefaultFun (Provenance Ann)
spirP
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDumpPlc) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
      Program TyName Name DefaultUni DefaultFun ()
-> CommandLineOption -> CommandLineOption -> IO ()
forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat (PLCProgram DefaultUni DefaultFun Ann
-> Program TyName Name DefaultUni DefaultFun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void PLCProgram DefaultUni DefaultFun Ann
plcP) CommandLineOption
"typed PLC program" (CommandLineOption
moduleName CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
".tplc-flat")

  -- We do this after dumping the programs so that if we fail typechecking we still get the dump.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDoTypecheck) (m () -> m ())
-> (m (Normalized (Type TyName DefaultUni ())) -> m ())
-> m (Normalized (Type TyName DefaultUni ()))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Normalized (Type TyName DefaultUni ())) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Normalized (Type TyName DefaultUni ())) -> m ())
-> m (Normalized (Type TyName DefaultUni ())) -> m ()
forall a b. (a -> b) -> a -> b
$
      ExceptT
  (Error DefaultUni DefaultFun Ann)
  m
  (Normalized (Type TyName DefaultUni ()))
-> m (Normalized (Type TyName DefaultUni ()))
forall b. ExceptT (Error DefaultUni DefaultFun Ann) m b -> m b
liftExcept (ExceptT
   (Error DefaultUni DefaultFun Ann)
   m
   (Normalized (Type TyName DefaultUni ()))
 -> m (Normalized (Type TyName DefaultUni ())))
-> ExceptT
     (Error DefaultUni DefaultFun Ann)
     m
     (Normalized (Type TyName DefaultUni ()))
-> m (Normalized (Type TyName DefaultUni ()))
forall a b. (a -> b) -> a -> b
$
        (TypeErrorPlc DefaultUni DefaultFun Ann
 -> Error DefaultUni DefaultFun Ann)
-> ExceptT
     (TypeErrorPlc DefaultUni DefaultFun Ann)
     (ExceptT (Error DefaultUni DefaultFun Ann) m)
     (Normalized (Type TyName DefaultUni ()))
-> ExceptT
     (Error DefaultUni DefaultFun Ann)
     m
     (Normalized (Type TyName DefaultUni ()))
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError TypeErrorPlc DefaultUni DefaultFun Ann
-> Error DefaultUni DefaultFun Ann
forall (uni :: * -> *) fun ann.
TypeError (Term TyName Name uni fun ()) uni fun ann
-> Error uni fun ann
PLC.TypeErrorE (ExceptT
   (TypeErrorPlc DefaultUni DefaultFun Ann)
   (ExceptT (Error DefaultUni DefaultFun Ann) m)
   (Normalized (Type TyName DefaultUni ()))
 -> ExceptT
      (Error DefaultUni DefaultFun Ann)
      m
      (Normalized (Type TyName DefaultUni ())))
-> ExceptT
     (TypeErrorPlc DefaultUni DefaultFun Ann)
     (ExceptT (Error DefaultUni DefaultFun Ann) m)
     (Normalized (Type TyName DefaultUni ()))
-> ExceptT
     (Error DefaultUni DefaultFun Ann)
     m
     (Normalized (Type TyName DefaultUni ()))
forall a b. (a -> b) -> a -> b
$
          TypeCheckConfig DefaultUni DefaultFun
-> Program TyName Name DefaultUni DefaultFun Ann
-> ExceptT
     (TypeErrorPlc DefaultUni DefaultFun Ann)
     (ExceptT (Error DefaultUni DefaultFun Ann) m)
     (Normalized (Type TyName DefaultUni ()))
forall (uni :: * -> *) fun ann (m :: * -> *).
MonadTypeCheckPlc uni fun ann m =>
TypeCheckConfig uni fun
-> Program TyName Name uni fun ann
-> m (Normalized (Type TyName uni ()))
PLC.inferTypeOfProgram TypeCheckConfig DefaultUni DefaultFun
plcTcConfig (PLCProgram DefaultUni DefaultFun Ann
plcP PLCProgram DefaultUni DefaultFun Ann
-> Ann -> Program TyName Name DefaultUni DefaultFun Ann
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
forall a. AnnInline a => a
annMayInline)

  let optCertify :: Maybe CommandLineOption
optCertify = PluginOptions
opts PluginOptions
-> Getting
     (Maybe CommandLineOption) PluginOptions (Maybe CommandLineOption)
-> Maybe CommandLineOption
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe CommandLineOption) PluginOptions (Maybe CommandLineOption)
Lens' PluginOptions (Maybe CommandLineOption)
posCertify
  (Program Name DefaultUni DefaultFun (Provenance Ann)
uplcP, SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann)
simplTrace) <- (ReaderT
   (CompilationOpts Name DefaultFun (Provenance Ann))
   m
   (Program Name DefaultUni DefaultFun (Provenance Ann),
    SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
 -> CompilationOpts Name DefaultFun (Provenance Ann)
 -> m (Program Name DefaultUni DefaultFun (Provenance Ann),
       SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann)))
-> CompilationOpts Name DefaultFun (Provenance Ann)
-> ReaderT
     (CompilationOpts Name DefaultFun (Provenance Ann))
     m
     (Program Name DefaultUni DefaultFun (Provenance Ann),
      SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
-> m (Program Name DefaultUni DefaultFun (Provenance Ann),
      SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (CompilationOpts Name DefaultFun (Provenance Ann))
  m
  (Program Name DefaultUni DefaultFun (Provenance Ann),
   SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
-> CompilationOpts Name DefaultFun (Provenance Ann)
-> m (Program Name DefaultUni DefaultFun (Provenance Ann),
      SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilationOpts Name DefaultFun (Provenance Ann)
forall {name2}. CompilationOpts name2 DefaultFun (Provenance Ann)
plcOpts (ReaderT
   (CompilationOpts Name DefaultFun (Provenance Ann))
   m
   (Program Name DefaultUni DefaultFun (Provenance Ann),
    SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
 -> m (Program Name DefaultUni DefaultFun (Provenance Ann),
       SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann)))
-> ReaderT
     (CompilationOpts Name DefaultFun (Provenance Ann))
     m
     (Program Name DefaultUni DefaultFun (Provenance Ann),
      SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
-> m (Program Name DefaultUni DefaultFun (Provenance Ann),
      SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
forall a b. (a -> b) -> a -> b
$ PLCProgram DefaultUni DefaultFun Ann
-> ReaderT
     (CompilationOpts Name DefaultFun (Provenance Ann))
     m
     (Program Name DefaultUni DefaultFun (Provenance Ann),
      SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann))
forall (m :: * -> *) (uni :: * -> *) fun name a tyname.
(Compiling m uni fun name a,
 MonadReader (CompilationOpts name fun a) m) =>
Program tyname name uni fun a
-> m (Program name uni fun a, SimplifierTrace name uni fun a)
PLC.compileProgramWithTrace PLCProgram DefaultUni DefaultFun Ann
plcP
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ case Maybe CommandLineOption
optCertify of
      Just CommandLineOption
certName -> do
          Either CertifierError CertifierSuccess
result <- Certifier CertifierSuccess
-> IO (Either CertifierError CertifierSuccess)
forall a. Certifier a -> IO (Either CertifierError a)
runCertifier (Certifier CertifierSuccess
 -> IO (Either CertifierError CertifierSuccess))
-> Certifier CertifierSuccess
-> IO (Either CertifierError CertifierSuccess)
forall a b. (a -> b) -> a -> b
$ SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann)
-> CommandLineOption -> Certifier CertifierSuccess
forall a.
SimplifierTrace Name DefaultUni DefaultFun a
-> CommandLineOption -> Certifier CertifierSuccess
mkCertifier SimplifierTrace Name DefaultUni DefaultFun (Provenance Ann)
simplTrace CommandLineOption
certName
          case Either CertifierError CertifierSuccess
result of
              Right CertifierSuccess
certSuccess ->
                  Handle -> CommandLineOption -> IO ()
hPutStrLn Handle
stderr (CommandLineOption -> IO ()) -> CommandLineOption -> IO ()
forall a b. (a -> b) -> a -> b
$ CertifierSuccess -> CommandLineOption
prettyCertifierSuccess CertifierSuccess
certSuccess
              Left CertifierError
err ->
                 Handle -> CommandLineOption -> IO ()
hPutStrLn Handle
stderr (CommandLineOption -> IO ()) -> CommandLineOption -> IO ()
forall a b. (a -> b) -> a -> b
$ CertifierError -> CommandLineOption
prettyCertifierError CertifierError
err
      Maybe CommandLineOption
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann)
dbP <- ExceptT
  (Error DefaultUni DefaultFun Ann)
  m
  (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
-> m (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
forall b. ExceptT (Error DefaultUni DefaultFun Ann) m b -> m b
liftExcept (ExceptT
   (Error DefaultUni DefaultFun Ann)
   m
   (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
 -> m (Program
         NamedDeBruijn DefaultUni DefaultFun (Provenance Ann)))
-> ExceptT
     (Error DefaultUni DefaultFun Ann)
     m
     (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
-> m (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
forall a b. (a -> b) -> a -> b
$ (FreeVariableError -> Error DefaultUni DefaultFun Ann)
-> ExceptT
     FreeVariableError
     (ExceptT (Error DefaultUni DefaultFun Ann) m)
     (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
-> ExceptT
     (Error DefaultUni DefaultFun Ann)
     m
     (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError FreeVariableError -> Error DefaultUni DefaultFun Ann
forall (uni :: * -> *) fun ann.
FreeVariableError -> Error uni fun ann
PLC.FreeVariableErrorE (ExceptT
   FreeVariableError
   (ExceptT (Error DefaultUni DefaultFun Ann) m)
   (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
 -> ExceptT
      (Error DefaultUni DefaultFun Ann)
      m
      (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann)))
-> ExceptT
     FreeVariableError
     (ExceptT (Error DefaultUni DefaultFun Ann) m)
     (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
-> ExceptT
     (Error DefaultUni DefaultFun Ann)
     m
     (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
forall a b. (a -> b) -> a -> b
$ LensLike
  (ExceptT
     FreeVariableError (ExceptT (Error DefaultUni DefaultFun Ann) m))
  (Program Name DefaultUni DefaultFun (Provenance Ann))
  (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
  (Term Name DefaultUni DefaultFun (Provenance Ann))
  (Term NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
-> LensLike
     (ExceptT
        FreeVariableError (ExceptT (Error DefaultUni DefaultFun Ann) m))
     (Program Name DefaultUni DefaultFun (Provenance Ann))
     (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
     (Term Name DefaultUni DefaultFun (Provenance Ann))
     (Term NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  (ExceptT
     FreeVariableError (ExceptT (Error DefaultUni DefaultFun Ann) m))
  (Program Name DefaultUni DefaultFun (Provenance Ann))
  (Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
  (Term Name DefaultUni DefaultFun (Provenance Ann))
  (Term NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2
       (f :: * -> *).
Functor f =>
(Term name1 uni1 fun1 ann -> f (Term name2 uni2 fun2 ann))
-> Program name1 uni1 fun1 ann -> f (Program name2 uni2 fun2 ann)
UPLC.progTerm Term Name DefaultUni DefaultFun (Provenance Ann)
-> ExceptT
     FreeVariableError
     (ExceptT (Error DefaultUni DefaultFun Ann) m)
     (Term NamedDeBruijn DefaultUni DefaultFun (Provenance Ann))
forall (m :: * -> *) (uni :: * -> *) fun ann.
MonadError FreeVariableError m =>
Term Name uni fun ann -> m (Term NamedDeBruijn uni fun ann)
UPLC.deBruijnTerm Program Name DefaultUni DefaultFun (Provenance Ann)
uplcP
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PluginOptions
opts PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posDumpUPlc) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
      UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ()
-> CommandLineOption -> CommandLineOption -> IO ()
forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat
          (Program NamedDeBruijn DefaultUni DefaultFun ()
-> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UPLC.UnrestrictedProgram (Program NamedDeBruijn DefaultUni DefaultFun ()
 -> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ())
-> Program NamedDeBruijn DefaultUni DefaultFun ()
-> UnrestrictedProgram NamedDeBruijn DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann)
-> Program NamedDeBruijn DefaultUni DefaultFun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann)
dbP)
          CommandLineOption
"untyped PLC program"
          (CommandLineOption
moduleName CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
".uplc-flat")
  -- Discard the Provenance information at this point, just keep the SrcSpans
  -- TODO: keep it and do something useful with it
  (PIRProgram uni fun, UPLCProgram uni fun)
-> m (PIRProgram uni fun, UPLCProgram uni fun)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Provenance Ann -> SrcSpans)
-> Program TyName Name uni fun (Provenance Ann)
-> PIRProgram uni fun
forall a b.
(a -> b)
-> Program TyName Name uni fun a -> Program TyName Name uni fun b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Provenance Ann -> SrcSpans
getSrcSpans Program TyName Name uni fun (Provenance Ann)
Program TyName Name DefaultUni DefaultFun (Provenance Ann)
spirP, (Provenance Ann -> SrcSpans)
-> Program NamedDeBruijn uni fun (Provenance Ann)
-> UPLCProgram uni fun
forall a b.
(a -> b)
-> Program NamedDeBruijn uni fun a
-> Program NamedDeBruijn uni fun b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Provenance Ann -> SrcSpans
getSrcSpans Program NamedDeBruijn uni fun (Provenance Ann)
Program NamedDeBruijn DefaultUni DefaultFun (Provenance Ann)
dbP)
 where
  -- ugly trick to take out the concrete plc.error and in case of error, map it / rethrow it
  --  using our 'CompileError'
  liftExcept :: ExceptT (PLC.Error PLC.DefaultUni PLC.DefaultFun Ann) m b -> m b
  liftExcept :: forall b. ExceptT (Error DefaultUni DefaultFun Ann) m b -> m b
liftExcept = (Error DefaultUni DefaultFun Ann
 -> CompileError DefaultUni DefaultFun Ann)
-> ExceptT (Error DefaultUni DefaultFun Ann) m b -> m b
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError (Error DefaultUni DefaultFun Ann
-> CompileError DefaultUni DefaultFun Ann
forall c e. e -> WithContext c e
NoContext (Error DefaultUni DefaultFun Ann
 -> CompileError DefaultUni DefaultFun Ann)
-> (Error DefaultUni DefaultFun Ann
    -> Error DefaultUni DefaultFun Ann)
-> Error DefaultUni DefaultFun Ann
-> CompileError DefaultUni DefaultFun Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error DefaultUni DefaultFun Ann -> Error DefaultUni DefaultFun Ann
forall (uni :: * -> *) fun a. Error uni fun a -> Error uni fun a
PLCError)

  dumpFlat :: (Flat t) => t -> String -> String -> IO ()
  dumpFlat :: forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat t
t CommandLineOption
desc CommandLineOption
fileName = do
    (CommandLineOption
tPath, Handle
tHandle) <- CommandLineOption
-> CommandLineOption -> IO (CommandLineOption, Handle)
openBinaryTempFile CommandLineOption
"." CommandLineOption
fileName
    CommandLineOption -> IO ()
putStrLn (CommandLineOption -> IO ()) -> CommandLineOption -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption
"!!! dumping " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
desc CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
" to " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption -> CommandLineOption
forall a. Show a => a -> CommandLineOption
show CommandLineOption
tPath
    Handle -> ByteString -> IO ()
BS.hPut Handle
tHandle (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ t -> ByteString
forall a. Flat a => a -> ByteString
flat t
t

  getSrcSpans :: PIR.Provenance Ann -> SrcSpans
  getSrcSpans :: Provenance Ann -> SrcSpans
getSrcSpans = Set SrcSpan -> SrcSpans
SrcSpans (Set SrcSpan -> SrcSpans)
-> (Provenance Ann -> Set SrcSpan) -> Provenance Ann -> SrcSpans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set SrcSpan] -> Set SrcSpan
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set SrcSpan] -> Set SrcSpan)
-> (Provenance Ann -> [Set SrcSpan])
-> Provenance Ann
-> Set SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> Set SrcSpan) -> [Ann] -> [Set SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpans -> Set SrcSpan
unSrcSpans (SrcSpans -> Set SrcSpan)
-> (Ann -> SrcSpans) -> Ann -> Set SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> SrcSpans
annSrcSpans) ([Ann] -> [Set SrcSpan])
-> (Provenance Ann -> [Ann]) -> Provenance Ann -> [Set SrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Provenance Ann -> [Ann]
forall a. Provenance a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Get the 'GHC.Name' corresponding to the given 'TH.Name', or throw an error if we can't get it.
thNameToGhcNameOrFail :: TH.Name -> PluginM uni fun GHC.Name
thNameToGhcNameOrFail :: forall (uni :: * -> *) fun. Name -> PluginM uni fun Name
thNameToGhcNameOrFail Name
name = do
  Maybe Name
maybeName <- ExceptT (CompileError uni fun Ann) CoreM (Maybe Name)
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) (Maybe Name)
forall (m :: * -> *) a. Monad m => m a -> ReaderT PluginCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (CompileError uni fun Ann) CoreM (Maybe Name)
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) (Maybe Name))
-> (CoreM (Maybe Name)
    -> ExceptT (CompileError uni fun Ann) CoreM (Maybe Name))
-> CoreM (Maybe Name)
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) (Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreM (Maybe Name)
-> ExceptT (CompileError uni fun Ann) CoreM (Maybe Name)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (CompileError uni fun Ann) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CoreM (Maybe Name)
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) (Maybe Name))
-> CoreM (Maybe Name)
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) (Maybe Name)
forall a b. (a -> b) -> a -> b
$ Name -> CoreM (Maybe Name)
GHC.thNameToGhcName Name
name
  case Maybe Name
maybeName of
    Just Name
n  -> Name -> PluginM uni fun Name
forall a.
a -> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
    Maybe Name
Nothing -> CompileError uni fun Ann -> PluginM uni fun Name
forall a.
CompileError uni fun Ann
-> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError uni fun Ann -> PluginM uni fun Name)
-> (Error uni fun Ann -> CompileError uni fun Ann)
-> Error uni fun Ann
-> PluginM uni fun Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error uni fun Ann -> CompileError uni fun Ann
forall c e. e -> WithContext c e
NoContext (Error uni fun Ann -> PluginM uni fun Name)
-> Error uni fun Ann -> PluginM uni fun Name
forall a b. (a -> b) -> a -> b
$ Name -> Error uni fun Ann
forall (uni :: * -> *) fun a. Name -> Error uni fun a
CoreNameLookupError Name
name

-- | Create a GHC Core expression that will evaluate to the given ByteString at runtime.
makeByteStringLiteral :: BS.ByteString -> PluginM uni fun GHC.CoreExpr
makeByteStringLiteral :: forall (uni :: * -> *) fun. ByteString -> PluginM uni fun CoreExpr
makeByteStringLiteral ByteString
bs = do
  DynFlags
flags <- ReaderT
  PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
GHC.getDynFlags

  {-
  This entire section will crash horribly in a number of circumstances. Such is life.
  - If any of the names we need can't be found as GHC Names
  - If we then can't look up those GHC Names to get their IDs/types
  - If we make any mistakes creating the Core expression
  -}

  -- Get the names of functions/types that we need for our expression
  Var
upio <- ExceptT (CompileError uni fun Ann) CoreM Var
-> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var
forall (m :: * -> *) a. Monad m => m a -> ReaderT PluginCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (CompileError uni fun Ann) CoreM Var
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var)
-> (Name -> ExceptT (CompileError uni fun Ann) CoreM Var)
-> Name
-> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreM Var -> ExceptT (CompileError uni fun Ann) CoreM Var
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (CompileError uni fun Ann) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CoreM Var -> ExceptT (CompileError uni fun Ann) CoreM Var)
-> (Name -> CoreM Var)
-> Name
-> ExceptT (CompileError uni fun Ann) CoreM Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CoreM Var
forall (m :: * -> *). MonadThings m => Name -> m Var
GHC.lookupId (Name
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var)
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Name
-> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Name
forall (uni :: * -> *) fun. Name -> PluginM uni fun Name
thNameToGhcNameOrFail 'unsafePerformIO
  TyCon
bsTc <- ExceptT (CompileError uni fun Ann) CoreM TyCon
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon
forall (m :: * -> *) a. Monad m => m a -> ReaderT PluginCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (CompileError uni fun Ann) CoreM TyCon
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon)
-> (Name -> ExceptT (CompileError uni fun Ann) CoreM TyCon)
-> Name
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreM TyCon -> ExceptT (CompileError uni fun Ann) CoreM TyCon
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (CompileError uni fun Ann) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CoreM TyCon -> ExceptT (CompileError uni fun Ann) CoreM TyCon)
-> (Name -> CoreM TyCon)
-> Name
-> ExceptT (CompileError uni fun Ann) CoreM TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CoreM TyCon
forall (m :: * -> *). MonadThings m => Name -> m TyCon
GHC.lookupTyCon (Name
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon)
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Name
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Name
forall (uni :: * -> *) fun. Name -> PluginM uni fun Name
thNameToGhcNameOrFail ''BS.ByteString
  Var
upal <- ExceptT (CompileError uni fun Ann) CoreM Var
-> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var
forall (m :: * -> *) a. Monad m => m a -> ReaderT PluginCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (CompileError uni fun Ann) CoreM Var
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var)
-> (Name -> ExceptT (CompileError uni fun Ann) CoreM Var)
-> Name
-> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreM Var -> ExceptT (CompileError uni fun Ann) CoreM Var
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (CompileError uni fun Ann) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CoreM Var -> ExceptT (CompileError uni fun Ann) CoreM Var)
-> (Name -> CoreM Var)
-> Name
-> ExceptT (CompileError uni fun Ann) CoreM Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CoreM Var
forall (m :: * -> *). MonadThings m => Name -> m Var
GHC.lookupId (Name
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var)
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Name
-> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Var
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) Name
forall (uni :: * -> *) fun. Name -> PluginM uni fun Name
thNameToGhcNameOrFail 'BSUnsafe.unsafePackAddressLen

  -- We construct the following expression:
  -- unsafePerformIO $
  --     unsafePackAddressLen <length as int literal> <data as string literal address>
  -- This technique gratefully borrowed from the file-embed package

  -- The flags here are so GHC can check whether the int is in range for the current platform.
  let lenLit :: CoreExpr
lenLit = Platform -> Integer -> CoreExpr
GHC.mkIntExpr (DynFlags -> Platform
GHC.targetPlatform DynFlags
flags) (Integer -> CoreExpr) -> Integer -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
  -- This will have type Addr#, which is right for unsafePackAddressLen
  let bsLit :: Expr b
bsLit = Literal -> Expr b
forall b. Literal -> Expr b
GHC.Lit (ByteString -> Literal
GHC.LitString ByteString
bs)
  let upaled :: CoreExpr
upaled = CoreExpr -> [CoreExpr] -> CoreExpr
GHC.mkCoreApps (Var -> CoreExpr
forall b. Var -> Expr b
GHC.Var Var
upal) [CoreExpr
lenLit, CoreExpr
forall {b}. Expr b
bsLit]
  let upioed :: CoreExpr
upioed = CoreExpr -> [CoreExpr] -> CoreExpr
GHC.mkCoreApps (Var -> CoreExpr
forall b. Var -> Expr b
GHC.Var Var
upio) [Type -> CoreExpr
forall b. Type -> Expr b
GHC.Type (TyCon -> Type
GHC.mkTyConTy TyCon
bsTc), CoreExpr
upaled]

  CoreExpr -> PluginM uni fun CoreExpr
forall a.
a -> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoreExpr
upioed

-- | Strips all enclosing 'GHC.Tick's off an expression.
stripTicks :: GHC.CoreExpr -> GHC.CoreExpr
stripTicks :: CoreExpr -> CoreExpr
stripTicks = \case
  GHC.Tick CoreTickish
_ CoreExpr
e -> CoreExpr -> CoreExpr
stripTicks CoreExpr
e
  CoreExpr
e -> CoreExpr
e

-- | Helper to avoid doing too much construction of Core ourselves
mkCompiledCode :: forall a. BS.ByteString -> BS.ByteString -> BS.ByteString -> CompiledCode a
mkCompiledCode :: forall a. ByteString -> ByteString -> ByteString -> CompiledCode a
mkCompiledCode ByteString
plcBS ByteString
pirBS ByteString
ci = ByteString
-> Maybe ByteString
-> CoverageIndex
-> CompiledCodeIn DefaultUni DefaultFun a
forall (uni :: * -> *) fun a.
ByteString
-> Maybe ByteString -> CoverageIndex -> CompiledCodeIn uni fun a
SerializedCode ByteString
plcBS (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
pirBS) (Either DecodeException CoverageIndex -> CoverageIndex
forall m. Monoid m => Either DecodeException m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Either DecodeException CoverageIndex -> CoverageIndex)
-> (ByteString -> Either DecodeException CoverageIndex)
-> ByteString
-> CoverageIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecodeException CoverageIndex
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat (ByteString -> CoverageIndex) -> ByteString -> CoverageIndex
forall a b. (a -> b) -> a -> b
$ ByteString
ci)

{-| Make a 'NameInfo' mapping the given set of TH names to their
'GHC.TyThing's for later reference.
-}
makePrimitiveNameInfo :: [TH.Name] -> PluginM uni fun NameInfo
makePrimitiveNameInfo :: forall (uni :: * -> *) fun. [Name] -> PluginM uni fun NameInfo
makePrimitiveNameInfo [Name]
names = do
  [(Name, TyThing)]
infos <- [Name]
-> (Name
    -> ReaderT
         PluginCtx
         (ExceptT (CompileError uni fun Ann) CoreM)
         (Name, TyThing))
-> ReaderT
     PluginCtx
     (ExceptT (CompileError uni fun Ann) CoreM)
     [(Name, TyThing)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Name]
names ((Name
  -> ReaderT
       PluginCtx
       (ExceptT (CompileError uni fun Ann) CoreM)
       (Name, TyThing))
 -> ReaderT
      PluginCtx
      (ExceptT (CompileError uni fun Ann) CoreM)
      [(Name, TyThing)])
-> (Name
    -> ReaderT
         PluginCtx
         (ExceptT (CompileError uni fun Ann) CoreM)
         (Name, TyThing))
-> ReaderT
     PluginCtx
     (ExceptT (CompileError uni fun Ann) CoreM)
     [(Name, TyThing)]
forall a b. (a -> b) -> a -> b
$ \Name
name -> do
    Name
ghcName <- Name -> PluginM uni fun Name
forall (uni :: * -> *) fun. Name -> PluginM uni fun Name
thNameToGhcNameOrFail Name
name
    TyThing
thing <- ExceptT (CompileError uni fun Ann) CoreM TyThing
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyThing
forall (m :: * -> *) a. Monad m => m a -> ReaderT PluginCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (CompileError uni fun Ann) CoreM TyThing
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyThing)
-> (CoreM TyThing
    -> ExceptT (CompileError uni fun Ann) CoreM TyThing)
-> CoreM TyThing
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyThing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreM TyThing -> ExceptT (CompileError uni fun Ann) CoreM TyThing
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (CompileError uni fun Ann) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CoreM TyThing
 -> ReaderT
      PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyThing)
-> CoreM TyThing
-> ReaderT
     PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) TyThing
forall a b. (a -> b) -> a -> b
$ Name -> CoreM TyThing
forall (m :: * -> *). MonadThings m => Name -> m TyThing
GHC.lookupThing Name
ghcName
    (Name, TyThing)
-> ReaderT
     PluginCtx
     (ExceptT (CompileError uni fun Ann) CoreM)
     (Name, TyThing)
forall a.
a -> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
name, TyThing
thing)
  NameInfo -> PluginM uni fun NameInfo
forall a.
a -> ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) CoreM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NameInfo -> PluginM uni fun NameInfo)
-> NameInfo -> PluginM uni fun NameInfo
forall a b. (a -> b) -> a -> b
$ [(Name, TyThing)] -> NameInfo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, TyThing)]
infos

makeRewriteRules :: PluginOptions -> RewriteRules DefaultUni DefaultFun
makeRewriteRules :: PluginOptions -> RewriteRules DefaultUni DefaultFun
makeRewriteRules PluginOptions
options =
  [RewriteRules DefaultUni DefaultFun]
-> RewriteRules DefaultUni DefaultFun
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ Bool
-> RewriteRules DefaultUni DefaultFun
-> RewriteRules DefaultUni DefaultFun
forall a. Monoid a => Bool -> a -> a
mwhen (PluginOptions
options PluginOptions -> Getting Bool PluginOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool PluginOptions Bool
Lens' PluginOptions Bool
posRemoveTrace) RewriteRules DefaultUni DefaultFun
forall (uni :: * -> *). RewriteRules uni DefaultFun
rewriteRuleRemoveTrace
    , RewriteRules DefaultUni DefaultFun
defaultUniRewriteRules
    ]