{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -O0 #-}
module PlutusTx.Plugin (plugin, plc) where
import Data.Bifunctor
import PlutusPrelude
import PlutusTx.Bool ((&&), (||))
import PlutusTx.Builtins (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.Compiler.Utils
import PlutusTx.Coverage
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
#if MIN_VERSION_ghc(9,6,0)
import GHC.Core.Rules.Config qualified as GHC
#endif
import GHC.Core.Unfold qualified as GHC
import GHC.Plugins qualified as GHC
import GHC.Types.TyThing qualified as GHC
import GHC.Utils.Logger qualified as GHC
import PlutusCore qualified as PLC
import PlutusCore.Builtin 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 Data.Text qualified as Text
import Data.Type.Bool qualified as PlutusTx.Bool
import GHC.Num.Integer qualified
import PlutusCore.Default (DefaultFun, DefaultUni)
import PlutusIR.Analysis.Builtins
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 (openBinaryTempFile)
import System.IO.Unsafe (unsafePerformIO)
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
}
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
CoreToDo
simplPass <- DynFlags -> Logger -> CoreToDo
mkSimplPass (DynFlags -> Logger -> CoreToDo)
-> CoreM DynFlags -> CoreM (Logger -> CoreToDo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CoreM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
GHC.getDynFlags CoreM (Logger -> CoreToDo) -> CoreM Logger -> CoreM CoreToDo
forall a b. CoreM (a -> b) -> CoreM a -> CoreM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CoreM Logger
forall (m :: * -> *). HasLogger m => m Logger
GHC.getLogger
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
[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
mkSimplPass :: GHC.DynFlags -> GHC.Logger -> GHC.CoreToDo
mkSimplPass :: DynFlags -> Logger -> CoreToDo
mkSimplPass DynFlags
dflags Logger
logger =
#if MIN_VERSION_ghc(9,6,0)
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
}
#else
GHC.CoreDoSimplify 1 simplMode
#endif
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
, sm_pre_inline :: Bool
GHC.sm_pre_inline = Bool
True
, 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
#if MIN_VERSION_ghc(9,6,0)
, 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
#else
, GHC.sm_logger = logger
, GHC.sm_dflags = dflags
#endif
}
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
PackageFamInstEnv
p_fam_env <- CoreM PackageFamInstEnv
GHC.getPackageFamInstEnv
Maybe Name
maybeMarkerName <- Name -> CoreM (Maybe Name)
GHC.thNameToGhcName 'plc
case Maybe Name
maybeMarkerName of
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 (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
type PluginM uni fun = ReaderT PluginCtx (ExceptT (CompileError uni fun Ann) GHC.CoreM)
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
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'))
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
(CoreExpr -> CoreExpr
stripTicks -> (GHC.Var Var
fid))
(GHC.Type (Type -> Maybe FastString
GHC.isStrLitTy -> Just FastString
fs_locStr)))
(GHC.Type Type
codeTy))
CoreExpr
_)
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
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
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
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
#if MIN_VERSION_ghc(9,6,0)
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
#else
pure $ GHC.mkRuntimeErrorApp GHC.rUNTIME_ERROR_ID (GHC.mkTyConApp tc [codeTy]) shown
#endif
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)
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.||)
, 'useToOpaque
, 'useFromOpaque
, 'mkNilOpaque
]
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
,coRemoveTrace :: Bool
coRemoveTrace=PluginOptions -> Bool
_posRemoveTrace PluginOptions
opts},
ccFlags :: DynFlags
ccFlags = DynFlags
flags,
ccFamInstEnvs :: FamInstEnvs
ccFamInstEnvs = FamInstEnvs
famEnvs,
ccNameInfo :: NameInfo
ccNameInfo = NameInfo
nameInfo,
ccScope :: Scope DefaultUni
ccScope = Scope DefaultUni
forall (uni :: * -> *). Scope uni
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
}
st :: CompileState
st = Int -> [Int] -> CompileState
CompileState Int
0 [Int]
forall a. Monoid a => a
mempty
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'
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
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
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
TypeCheckConfig uni fun
plcTcConfig <- Provenance Ann -> m (TypeCheckConfig uni fun)
forall err term (uni :: * -> *) fun ann (m :: * -> *).
(MonadKindCheck err term uni fun ann m, Typecheckable uni fun) =>
ann -> m (TypeCheckConfig uni fun)
PLC.getDefTypeCheckConfig Provenance Ann
forall a. Provenance a
PIR.noProvenance
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
let hints :: InlineHints name (Provenance Ann)
hints = (Provenance Ann -> name -> Bool)
-> InlineHints name (Provenance Ann)
forall name a. (a -> name -> Bool) -> InlineHints name a
UPLC.InlineHints ((Provenance Ann -> name -> Bool)
-> InlineHints name (Provenance Ann))
-> (Provenance Ann -> name -> Bool)
-> InlineHints name (Provenance Ann)
forall a b. (a -> b) -> a -> b
$ \Provenance Ann
ann name
_ -> case Provenance Ann
ann of
PIR.DatatypeComponent DatatypeComponent
PIR.Destructor Provenance Ann
_ -> Bool
True
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)
RewriteRules uni fun
rewriteRules <- (CompileContext uni fun -> RewriteRules uni fun)
-> m (RewriteRules uni fun)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CompileContext uni fun -> RewriteRules uni fun
forall (uni :: * -> *) fun.
CompileContext uni fun -> RewriteRules uni fun
ccRewriteRules
let pirTcConfig :: PirTCConfig uni fun
pirTcConfig = TypeCheckConfig uni fun -> AllowEscape -> PirTCConfig uni fun
forall (uni :: * -> *) fun.
TypeCheckConfig uni fun -> AllowEscape -> PirTCConfig uni fun
PIR.PirTCConfig TypeCheckConfig uni fun
plcTcConfig AllowEscape
PIR.YesEscape
pirCtx :: CompilationCtx uni fun Ann
pirCtx = TypeCheckConfig uni fun -> CompilationCtx uni fun 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 uni fun
plcTcConfig
CompilationCtx uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Int Int
-> Int -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Int -> Identity Int)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
(PirTCConfig uni fun)
(PirTCConfig uni fun)
-> PirTCConfig uni fun
-> CompilationCtx uni fun Ann
-> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
(PirTCConfig uni fun)
(PirTCConfig uni fun)
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 uni fun
pirTcConfig
CompilationCtx uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
(InlineHints Name (Provenance Ann))
(InlineHints Name (Provenance Ann))
-> InlineHints Name (Provenance Ann)
-> CompilationCtx uni fun Ann
-> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((InlineHints Name (Provenance Ann)
-> Identity (InlineHints Name (Provenance Ann)))
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun Ann) Bool Bool
-> Bool -> CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((Bool -> Identity Bool)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann) (CompilationCtx uni fun 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 uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
DatatypeStyle
DatatypeStyle
-> DatatypeStyle
-> CompilationCtx uni fun Ann
-> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ((CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun 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 uni fun Ann
-> Identity (CompilationCtx uni fun Ann))
-> ((DatatypeStyle -> Identity DatatypeStyle)
-> CompilationOpts Ann -> Identity (CompilationOpts Ann))
-> ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun 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)
(if Version
plcVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
PLC.plcVersion110
then DatatypeStyle
PIR.ScottEncoding else DatatypeStyle
PIR.SumsOfProducts)
CompilationCtx uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
(BuiltinsInfo uni fun)
(BuiltinsInfo uni fun)
-> BuiltinsInfo uni fun
-> CompilationCtx uni fun Ann
-> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
(BuiltinsInfo uni fun)
(BuiltinsInfo uni fun)
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 uni fun
forall a. Default a => a
def
CompilationCtx uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
BuiltinCostModel
BuiltinCostModel
-> BuiltinCostModel
-> CompilationCtx uni fun Ann
-> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
BuiltinCostModel
BuiltinCostModel
(CostingPart uni fun -> Identity (CostingPart uni fun))
-> CompilationCtx uni fun Ann
-> Identity (CompilationCtx uni fun Ann)
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 BuiltinCostModel
forall a. Default a => a
def
CompilationCtx uni fun Ann
-> (CompilationCtx uni fun Ann -> CompilationCtx uni fun Ann)
-> CompilationCtx uni fun Ann
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
(RewriteRules uni fun)
(RewriteRules uni fun)
-> RewriteRules uni fun
-> CompilationCtx uni fun Ann
-> CompilationCtx uni fun Ann
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
(CompilationCtx uni fun Ann)
(CompilationCtx uni fun Ann)
(RewriteRules uni fun)
(RewriteRules uni fun)
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 uni fun
rewriteRules
plcOpts :: CompilationOpts Name 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 Name DefaultFun (Provenance Ann))
-> CompilationOpts Name DefaultFun (Provenance Ann)
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationOpts Any DefaultFun Any)
(CompilationOpts Name DefaultFun (Provenance Ann))
(InlineHints Any Any)
(InlineHints Name (Provenance Ann))
-> InlineHints Name (Provenance Ann)
-> CompilationOpts Any DefaultFun Any
-> CompilationOpts Name DefaultFun (Provenance Ann)
forall s t a b. ASetter s t a b -> b -> s -> t
set ((SimplifyOpts Any Any
-> Identity (SimplifyOpts Name (Provenance Ann)))
-> CompilationOpts Any DefaultFun Any
-> Identity (CompilationOpts Name 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 Name (Provenance Ann)))
-> CompilationOpts Any DefaultFun Any
-> Identity (CompilationOpts Name DefaultFun (Provenance Ann)))
-> ((InlineHints Any Any
-> Identity (InlineHints Name (Provenance Ann)))
-> SimplifyOpts Any Any
-> Identity (SimplifyOpts Name (Provenance Ann)))
-> ASetter
(CompilationOpts Any DefaultFun Any)
(CompilationOpts Name DefaultFun (Provenance Ann))
(InlineHints Any Any)
(InlineHints Name (Provenance Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InlineHints Any Any
-> Identity (InlineHints Name (Provenance Ann)))
-> SimplifyOpts Any Any
-> Identity (SimplifyOpts Name (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 Name (Provenance Ann)
forall {name}. InlineHints name (Provenance Ann)
hints
CompilationOpts Name DefaultFun (Provenance Ann)
-> (CompilationOpts Name DefaultFun (Provenance Ann)
-> CompilationOpts Name DefaultFun (Provenance Ann))
-> CompilationOpts Name DefaultFun (Provenance Ann)
forall a b. a -> (a -> b) -> b
& ASetter
(CompilationOpts Name DefaultFun (Provenance Ann))
(CompilationOpts Name DefaultFun (Provenance Ann))
Bool
Bool
-> Bool
-> CompilationOpts Name DefaultFun (Provenance Ann)
-> CompilationOpts Name DefaultFun (Provenance Ann)
forall s t a b. ASetter s t a b -> b -> s -> t
set ((SimplifyOpts Name (Provenance Ann)
-> Identity (SimplifyOpts Name (Provenance Ann)))
-> CompilationOpts Name DefaultFun (Provenance Ann)
-> Identity (CompilationOpts Name 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 Name (Provenance Ann)
-> Identity (SimplifyOpts Name (Provenance Ann)))
-> CompilationOpts Name DefaultFun (Provenance Ann)
-> Identity (CompilationOpts Name DefaultFun (Provenance Ann)))
-> ((Bool -> Identity Bool)
-> SimplifyOpts Name (Provenance Ann)
-> Identity (SimplifyOpts Name (Provenance Ann)))
-> ASetter
(CompilationOpts Name DefaultFun (Provenance Ann))
(CompilationOpts Name DefaultFun (Provenance Ann))
Bool
Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> SimplifyOpts Name (Provenance Ann)
-> Identity (SimplifyOpts Name (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)
Term TyName Name uni fun (Provenance Ann)
pirT <- Term TyName Name uni fun Ann
-> Term TyName Name uni fun (Provenance Ann)
forall (f :: * -> *) a. Functor f => f a -> f (Provenance a)
original (Term TyName Name uni fun Ann
-> Term TyName Name uni fun (Provenance Ann))
-> m (Term TyName Name uni fun Ann)
-> m (Term TyName Name uni fun (Provenance Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ann
-> DefT LexName uni fun Ann m (Term TyName Name uni fun Ann)
-> m (Term TyName Name uni fun 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
annMayInline (DefT LexName uni fun Ann m (Term TyName Name uni fun Ann)
-> m (Term TyName Name uni fun Ann))
-> DefT LexName uni fun Ann m (Term TyName Name uni fun Ann)
-> m (Term TyName Name uni fun Ann)
forall a b. (a -> b) -> a -> b
$ CoreExpr
-> DefT LexName uni fun Ann m (Term TyName Name uni fun Ann)
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
CoreExpr -> m (PIRTerm uni fun)
compileExprWithDefs CoreExpr
expr)
let pirP :: Program TyName Name uni fun (Provenance Ann)
pirP = Provenance Ann
-> Version
-> Term TyName Name uni fun (Provenance Ann)
-> Program TyName Name uni fun (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 uni fun (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 uni fun ()
-> CommandLineOption -> CommandLineOption -> IO ()
forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat (Program TyName Name uni fun (Provenance Ann)
-> Program TyName Name uni fun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Program TyName Name uni fun (Provenance Ann)
pirP) CommandLineOption
"initial PIR program" (CommandLineOption
moduleName CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
"_initial.pir-flat")
Program TyName Name uni fun (Provenance Ann)
spirP <- (ReaderT
(CompilationCtx uni fun Ann)
m
(Program TyName Name uni fun (Provenance Ann))
-> CompilationCtx uni fun Ann
-> m (Program TyName Name uni fun (Provenance Ann)))
-> CompilationCtx uni fun Ann
-> ReaderT
(CompilationCtx uni fun Ann)
m
(Program TyName Name uni fun (Provenance Ann))
-> m (Program TyName Name uni fun (Provenance Ann))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
(CompilationCtx uni fun Ann)
m
(Program TyName Name uni fun (Provenance Ann))
-> CompilationCtx uni fun Ann
-> m (Program TyName Name uni fun (Provenance Ann))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilationCtx uni fun Ann
pirCtx (ReaderT
(CompilationCtx uni fun Ann)
m
(Program TyName Name uni fun (Provenance Ann))
-> m (Program TyName Name uni fun (Provenance Ann)))
-> ReaderT
(CompilationCtx uni fun Ann)
m
(Program TyName Name uni fun (Provenance Ann))
-> m (Program TyName Name uni fun (Provenance Ann))
forall a b. (a -> b) -> a -> b
$ Program TyName Name uni fun (Provenance Ann)
-> ReaderT
(CompilationCtx uni fun Ann)
m
(Program TyName Name uni fun (Provenance Ann))
forall (m :: * -> *) e (uni :: * -> *) fun a b.
(Compiling m e uni fun a, b ~ Provenance a) =>
Program TyName Name uni fun b -> m (Program TyName Name uni fun b)
PIR.compileToReadable Program TyName Name uni fun (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 uni fun ()
-> CommandLineOption -> CommandLineOption -> IO ()
forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat (Program TyName Name uni fun (Provenance Ann)
-> Program TyName Name uni fun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Program TyName Name uni fun (Provenance Ann)
spirP) CommandLineOption
"simplified PIR program" (CommandLineOption
moduleName CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
"_simplified.pir-flat")
PLCProgram uni fun Ann
plcP <- (ReaderT (CompilationCtx uni fun Ann) m (PLCProgram uni fun Ann)
-> CompilationCtx uni fun Ann -> m (PLCProgram uni fun Ann))
-> CompilationCtx uni fun Ann
-> ReaderT (CompilationCtx uni fun Ann) m (PLCProgram uni fun Ann)
-> m (PLCProgram uni fun Ann)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (CompilationCtx uni fun Ann) m (PLCProgram uni fun Ann)
-> CompilationCtx uni fun Ann -> m (PLCProgram uni fun Ann)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilationCtx uni fun Ann
pirCtx (ReaderT (CompilationCtx uni fun Ann) m (PLCProgram uni fun Ann)
-> m (PLCProgram uni fun Ann))
-> ReaderT (CompilationCtx uni fun Ann) m (PLCProgram uni fun Ann)
-> m (PLCProgram uni fun Ann)
forall a b. (a -> b) -> a -> b
$ Program TyName Name uni fun (Provenance Ann)
-> ReaderT (CompilationCtx uni fun Ann) m (PLCProgram uni fun Ann)
forall (m :: * -> *) e (uni :: * -> *) fun a b.
(Compiling m e uni fun a, b ~ Provenance a) =>
Program TyName Name uni fun b -> m (PLCProgram uni fun a)
PIR.compileReadableToPlc Program TyName Name uni fun (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 uni fun ()
-> CommandLineOption -> CommandLineOption -> IO ()
forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat (PLCProgram uni fun Ann -> Program TyName Name uni fun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void PLCProgram uni fun Ann
plcP) CommandLineOption
"typed PLC program" (CommandLineOption
moduleName CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
".tplc-flat")
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 uni ())) -> m ())
-> m (Normalized (Type TyName uni ()))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Normalized (Type TyName uni ())) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Normalized (Type TyName uni ())) -> m ())
-> m (Normalized (Type TyName uni ())) -> m ()
forall a b. (a -> b) -> a -> b
$
ExceptT
(Error DefaultUni DefaultFun Ann)
m
(Normalized (Type TyName uni ()))
-> m (Normalized (Type TyName uni ()))
forall b. ExceptT (Error DefaultUni DefaultFun Ann) m b -> m b
liftExcept (ExceptT
(Error DefaultUni DefaultFun Ann)
m
(Normalized (Type TyName uni ()))
-> m (Normalized (Type TyName uni ())))
-> ExceptT
(Error DefaultUni DefaultFun Ann)
m
(Normalized (Type TyName uni ()))
-> m (Normalized (Type TyName uni ()))
forall a b. (a -> b) -> a -> b
$ TypeCheckConfig uni fun
-> Program TyName Name uni fun Ann
-> ExceptT
(Error DefaultUni DefaultFun Ann)
m
(Normalized (Type TyName uni ()))
forall err (uni :: * -> *) fun ann (m :: * -> *).
MonadTypeCheckPlc err uni fun ann m =>
TypeCheckConfig uni fun
-> Program TyName Name uni fun ann
-> m (Normalized (Type TyName uni ()))
PLC.inferTypeOfProgram TypeCheckConfig uni fun
plcTcConfig (PLCProgram uni fun Ann
plcP PLCProgram uni fun Ann -> Ann -> Program TyName Name uni fun Ann
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline)
Program Name uni fun (Provenance Ann)
uplcP <- (ReaderT
(CompilationOpts Name DefaultFun (Provenance Ann))
m
(Program Name uni fun (Provenance Ann))
-> CompilationOpts Name DefaultFun (Provenance Ann)
-> m (Program Name uni fun (Provenance Ann)))
-> CompilationOpts Name DefaultFun (Provenance Ann)
-> ReaderT
(CompilationOpts Name DefaultFun (Provenance Ann))
m
(Program Name uni fun (Provenance Ann))
-> m (Program Name uni fun (Provenance Ann))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
(CompilationOpts Name DefaultFun (Provenance Ann))
m
(Program Name uni fun (Provenance Ann))
-> CompilationOpts Name DefaultFun (Provenance Ann)
-> m (Program Name uni fun (Provenance Ann))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompilationOpts Name DefaultFun (Provenance Ann)
plcOpts (ReaderT
(CompilationOpts Name DefaultFun (Provenance Ann))
m
(Program Name uni fun (Provenance Ann))
-> m (Program Name uni fun (Provenance Ann)))
-> ReaderT
(CompilationOpts Name DefaultFun (Provenance Ann))
m
(Program Name uni fun (Provenance Ann))
-> m (Program Name uni fun (Provenance Ann))
forall a b. (a -> b) -> a -> b
$ PLCProgram uni fun Ann
-> ReaderT
(CompilationOpts Name DefaultFun (Provenance Ann))
m
(Program Name uni fun (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)
PLC.compileProgram PLCProgram uni fun Ann
plcP
Program NamedDeBruijn uni fun (Provenance Ann)
dbP <- ExceptT
(Error DefaultUni DefaultFun Ann)
m
(Program NamedDeBruijn uni fun (Provenance Ann))
-> m (Program NamedDeBruijn uni fun (Provenance Ann))
forall b. ExceptT (Error DefaultUni DefaultFun Ann) m b -> m b
liftExcept (ExceptT
(Error DefaultUni DefaultFun Ann)
m
(Program NamedDeBruijn uni fun (Provenance Ann))
-> m (Program NamedDeBruijn uni fun (Provenance Ann)))
-> ExceptT
(Error DefaultUni DefaultFun Ann)
m
(Program NamedDeBruijn uni fun (Provenance Ann))
-> m (Program NamedDeBruijn uni fun (Provenance Ann))
forall a b. (a -> b) -> a -> b
$ LensLike
(ExceptT (Error DefaultUni DefaultFun Ann) m)
(Program Name uni fun (Provenance Ann))
(Program NamedDeBruijn uni fun (Provenance Ann))
(Term Name uni fun (Provenance Ann))
(Term NamedDeBruijn uni fun (Provenance Ann))
-> LensLike
(ExceptT (Error DefaultUni DefaultFun Ann) m)
(Program Name uni fun (Provenance Ann))
(Program NamedDeBruijn uni fun (Provenance Ann))
(Term Name uni fun (Provenance Ann))
(Term NamedDeBruijn uni fun (Provenance Ann))
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
(ExceptT (Error DefaultUni DefaultFun Ann) m)
(Program Name uni fun (Provenance Ann))
(Program NamedDeBruijn uni fun (Provenance Ann))
(Term Name uni fun (Provenance Ann))
(Term NamedDeBruijn uni fun (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 uni fun (Provenance Ann)
-> ExceptT
(Error DefaultUni DefaultFun Ann)
m
(Term NamedDeBruijn uni fun (Provenance Ann))
forall e (m :: * -> *) (uni :: * -> *) fun ann.
(AsFreeVariableError e, MonadError e m) =>
Term Name uni fun ann -> m (Term NamedDeBruijn uni fun ann)
UPLC.deBruijnTerm Program Name uni fun (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 uni fun ()
-> CommandLineOption -> CommandLineOption -> IO ()
forall t.
Flat t =>
t -> CommandLineOption -> CommandLineOption -> IO ()
dumpFlat
(Program NamedDeBruijn uni fun ()
-> UnrestrictedProgram NamedDeBruijn uni fun ()
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UPLC.UnrestrictedProgram (Program NamedDeBruijn uni fun ()
-> UnrestrictedProgram NamedDeBruijn uni fun ())
-> Program NamedDeBruijn uni fun ()
-> UnrestrictedProgram NamedDeBruijn uni fun ()
forall a b. (a -> b) -> a -> b
$ Program NamedDeBruijn uni fun (Provenance Ann)
-> Program NamedDeBruijn uni fun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Program NamedDeBruijn uni fun (Provenance Ann)
dbP)
CommandLineOption
"untyped PLC program"
(CommandLineOption
moduleName CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
".uplc-flat")
(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)
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)
dbP)
where
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 ExceptT (Error DefaultUni DefaultFun Ann) m b
act = do
Either (Error DefaultUni DefaultFun Ann) b
plcTcError <- ExceptT (Error DefaultUni DefaultFun Ann) m b
-> m (Either (Error DefaultUni DefaultFun Ann) b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT (Error DefaultUni DefaultFun Ann) m b
act
Either (CompileError DefaultUni DefaultFun Ann) b -> m b
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either (CompileError DefaultUni DefaultFun Ann) b -> m b)
-> Either (CompileError DefaultUni DefaultFun Ann) b -> m b
forall a b. (a -> b) -> a -> b
$ (Error DefaultUni DefaultFun Ann
-> CompileError DefaultUni DefaultFun Ann)
-> Either (Error DefaultUni DefaultFun Ann) b
-> Either (CompileError DefaultUni DefaultFun Ann) b
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Getting
(CompileError DefaultUni DefaultFun Ann)
(Error DefaultUni DefaultFun (Provenance Ann))
(CompileError DefaultUni DefaultFun Ann)
-> Error DefaultUni DefaultFun (Provenance Ann)
-> CompileError DefaultUni DefaultFun Ann
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AReview
(CompileError DefaultUni DefaultFun Ann)
(Error DefaultUni DefaultFun (Provenance Ann))
-> Getter
(Error DefaultUni DefaultFun (Provenance Ann))
(CompileError DefaultUni DefaultFun Ann)
forall t b. AReview t b -> Getter b t
re AReview
(CompileError DefaultUni DefaultFun Ann)
(Error DefaultUni DefaultFun (Provenance Ann))
forall r (uni :: * -> *) fun a.
AsError r uni fun a =>
Prism' r (Error uni fun a)
Prism'
(CompileError DefaultUni DefaultFun Ann)
(Error DefaultUni DefaultFun (Provenance Ann))
PIR._PLCError) (Error DefaultUni DefaultFun (Provenance Ann)
-> CompileError DefaultUni DefaultFun Ann)
-> (Error DefaultUni DefaultFun Ann
-> Error DefaultUni DefaultFun (Provenance Ann))
-> Error DefaultUni DefaultFun Ann
-> CompileError DefaultUni DefaultFun Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> Provenance Ann)
-> Error DefaultUni DefaultFun Ann
-> Error DefaultUni DefaultFun (Provenance Ann)
forall a b.
(a -> b)
-> Error DefaultUni DefaultFun a -> Error DefaultUni DefaultFun b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ann -> Provenance Ann
forall a. a -> Provenance a
PIR.Original) Either (Error DefaultUni DefaultFun Ann) b
plcTcError
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
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
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
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
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
let bsLit :: CoreExpr
bsLit = Literal -> CoreExpr
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
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
stripTicks :: GHC.CoreExpr -> GHC.CoreExpr
stripTicks :: CoreExpr -> CoreExpr
stripTicks = \case
GHC.Tick CoreTickish
_ CoreExpr
e -> CoreExpr -> CoreExpr
stripTicks CoreExpr
e
CoreExpr
e -> CoreExpr
e
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)
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
]