-- editorconfig-checker-disable-file
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
module PlutusIR.Compiler (
    compileProgram,
    compileToReadable,
    compileReadableToPlc,
    Compiling,
    Error (..),
    AsError (..),
    AsTypeError (..),
    AsTypeErrorExt (..),
    Provenance (..),
    DatatypeComponent (..),
    noProvenance,
    CompilationOpts (..),
    coOptimize,
    coTypecheck,
    coPedantic,
    coVerbose,
    coDebug,
    coMaxSimplifierIterations,
    coDoSimplifierUnwrapCancel,
    coDoSimplifierBeta,
    coDoSimplifierInline,
    coDoSimplifierEvaluateBuiltins,
    coDoSimplifierStrictifyBindings,
    coDoSimplifierRewrite,
    coDoSimplifierKnownCon,
    coInlineHints,
    coProfile,
    coRelaxedFloatin,
    coCaseOfCaseConservative,
    coPreserveLogging,
    coDatatypes,
    dcoStyle,
    DatatypeStyle (..),
    defaultCompilationOpts,
    CompilationCtx,
    ccOpts,
    ccEnclosing,
    ccTypeCheckConfig,
    ccBuiltinsInfo,
    ccBuiltinCostModel,
    PirTCConfig(..),
    AllowEscape(..),
    toDefaultCompilationCtx,
    runCompilerPass,
    simplifier
    ) where

import Control.Lens
import Control.Monad
import Control.Monad.Except
import Control.Monad.Extra (orM, whenM)
import Data.Monoid
import Data.Monoid.Extra (mwhen)
import Debug.Trace (traceM)
import PlutusCore qualified as PLC
import PlutusCore.Error (throwingEither)
import PlutusIR
import PlutusIR.Compiler.Let qualified as Let
import PlutusIR.Compiler.Lower
import PlutusIR.Compiler.Provenance
import PlutusIR.Compiler.Types
import PlutusIR.Error
import PlutusIR.Pass qualified as P
import PlutusIR.Transform.Beta qualified as Beta
import PlutusIR.Transform.CaseReduce qualified as CaseReduce
import PlutusIR.Transform.DeadCode qualified as DeadCode
import PlutusIR.Transform.EvaluateBuiltins qualified as EvaluateBuiltins
import PlutusIR.Transform.Inline.Inline qualified as Inline
import PlutusIR.Transform.KnownCon qualified as KnownCon
import PlutusIR.Transform.LetFloatIn qualified as LetFloatIn
import PlutusIR.Transform.LetFloatOut qualified as LetFloatOut
import PlutusIR.Transform.LetMerge qualified as LetMerge
import PlutusIR.Transform.NonStrict qualified as NonStrict
import PlutusIR.Transform.RecSplit qualified as RecSplit
import PlutusIR.Transform.Rename ()
import PlutusIR.Transform.RewriteRules qualified as RewriteRules
import PlutusIR.Transform.StrictifyBindings qualified as StrictifyBindings
import PlutusIR.Transform.ThunkRecursions qualified as ThunkRec
import PlutusIR.Transform.Unwrap qualified as Unwrap
import PlutusPrelude

isVerbose :: Compiling m e uni fun a => m Bool
isVerbose :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m Bool
isVerbose = Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool (CompilationCtx uni fun a) Bool -> m Bool)
-> Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coVerbose

isDebug :: Compiling m e uni fun a => m Bool
isDebug :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m Bool
isDebug = Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool (CompilationCtx uni fun a) Bool -> m Bool)
-> Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDebug

logVerbose :: Compiling m e uni fun a => String -> m ()
logVerbose :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
String -> m ()
logVerbose = m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ([m Bool] -> m Bool
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
orM [m Bool
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m Bool
isVerbose, m Bool
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m Bool
isDebug]) (m () -> m ()) -> (String -> m ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM

logDebug :: Compiling m e uni fun a => String -> m ()
logDebug :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
String -> m ()
logDebug = m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m Bool
isDebug (m () -> m ()) -> (String -> m ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM

runCompilerPass :: (Compiling m e uni fun a, b ~ Provenance a) => m (P.Pass m tyname name uni fun b) -> Term tyname name uni fun b -> m (Term tyname name uni fun b)
runCompilerPass :: forall (m :: * -> *) e (uni :: * -> *) fun a b tyname name.
(Compiling m e uni fun a, b ~ Provenance a) =>
m (Pass m tyname name uni fun b)
-> Term tyname name uni fun b -> m (Term tyname name uni fun b)
runCompilerPass m (Pass m tyname name uni fun b)
mpasses Term tyname name uni fun b
t = do
  Pass m tyname name uni fun b
passes <- m (Pass m tyname name uni fun b)
mpasses
  Bool
pedantic <- Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coPedantic)
  Either (Error uni fun b) (Term tyname name uni fun b)
res <- ExceptT (Error uni fun b) m (Term tyname name uni fun b)
-> m (Either (Error uni fun b) (Term tyname name uni fun b))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Error uni fun b) m (Term tyname name uni fun b)
 -> m (Either (Error uni fun b) (Term tyname name uni fun b)))
-> ExceptT (Error uni fun b) m (Term tyname name uni fun b)
-> m (Either (Error uni fun b) (Term tyname name uni fun b))
forall a b. (a -> b) -> a -> b
$ (String -> m ())
-> Bool
-> Pass m tyname name uni fun b
-> Term tyname name uni fun b
-> ExceptT (Error uni fun b) m (Term tyname name uni fun b)
forall (m :: * -> *) tyname name (uni :: * -> *) fun a.
Monad m =>
(String -> m ())
-> Bool
-> Pass m tyname name uni fun a
-> Term tyname name uni fun a
-> ExceptT (Error uni fun a) m (Term tyname name uni fun a)
P.runPass String -> m ()
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
String -> m ()
logVerbose Bool
pedantic Pass m tyname name uni fun b
passes Term tyname name uni fun b
t
  AReview e (Error uni fun b)
-> Either (Error uni fun b) (Term tyname name uni fun b)
-> m (Term tyname name uni fun b)
forall e (m :: * -> *) t a.
MonadError e m =>
AReview e t -> Either t a -> m a
throwingEither AReview e (Error uni fun b)
forall r (uni :: * -> *) fun a.
AsError r uni fun a =>
Prism' r (Error uni fun a)
Prism' e (Error uni fun b)
_Error Either (Error uni fun b) (Term tyname name uni fun b)
res

floatOutPasses :: Compiling m e uni fun a => m (P.Pass m TyName Name uni fun (Provenance a))
floatOutPasses :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
floatOutPasses = do
  Bool
optimize <- Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coOptimize)
  PirTCConfig uni fun
tcconfig <- Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig
  BuiltinsInfo uni fun
binfo <- Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (BuiltinsInfo uni fun)
-> m (BuiltinsInfo uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (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)
ccBuiltinsInfo
  Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pass m TyName Name uni fun (Provenance a)
 -> m (Pass m TyName Name uni fun (Provenance a)))
-> Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a b. (a -> b) -> a -> b
$ Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen Bool
optimize (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ String
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) tyname name (uni :: * -> *) fun a.
String
-> Pass m tyname name uni fun a -> Pass m tyname name uni fun a
P.NamedPass String
"float-out" (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ [Pass m TyName Name uni fun (Provenance a)]
-> Pass m TyName Name uni fun (Provenance a)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ PirTCConfig uni fun
-> BuiltinsInfo uni fun
-> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) (uni :: * -> *) fun a.
(Typecheckable uni fun, GEq uni, Ord a, Semigroup a,
 MonadQuote m) =>
PirTCConfig uni fun
-> BuiltinsInfo uni fun -> Pass m TyName Name uni fun a
LetFloatOut.floatTermPassSC PirTCConfig uni fun
tcconfig BuiltinsInfo uni fun
binfo
        , PirTCConfig uni fun -> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, Applicative m) =>
PirTCConfig uni fun -> Pass m TyName Name uni fun a
RecSplit.recSplitPass PirTCConfig uni fun
tcconfig
        , PirTCConfig uni fun -> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, Applicative m) =>
PirTCConfig uni fun -> Pass m TyName Name uni fun a
LetMerge.letMergePass PirTCConfig uni fun
tcconfig
        ]

floatInPasses :: Compiling m e uni fun a => m (P.Pass m TyName Name uni fun (Provenance a))
floatInPasses :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
floatInPasses = do
  Bool
optimize <- Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coOptimize)
  PirTCConfig uni fun
tcconfig <- Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig
  BuiltinsInfo uni fun
binfo <- Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (BuiltinsInfo uni fun)
-> m (BuiltinsInfo uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (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)
ccBuiltinsInfo
  Bool
relaxed <- Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coRelaxedFloatin)
  Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pass m TyName Name uni fun (Provenance a)
 -> m (Pass m TyName Name uni fun (Provenance a)))
-> Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a b. (a -> b) -> a -> b
$ Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen Bool
optimize (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ String
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) tyname name (uni :: * -> *) fun a.
String
-> Pass m tyname name uni fun a -> Pass m tyname name uni fun a
P.NamedPass String
"float-in" (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ [Pass m TyName Name uni fun (Provenance a)]
-> Pass m TyName Name uni fun (Provenance a)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ PirTCConfig uni fun
-> BuiltinsInfo uni fun
-> Bool
-> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) (uni :: * -> *) fun a.
(Typecheckable uni fun, GEq uni, Ord a, MonadQuote m) =>
PirTCConfig uni fun
-> BuiltinsInfo uni fun -> Bool -> Pass m TyName Name uni fun a
LetFloatIn.floatTermPassSC PirTCConfig uni fun
tcconfig BuiltinsInfo uni fun
binfo Bool
relaxed
        , PirTCConfig uni fun -> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, Applicative m) =>
PirTCConfig uni fun -> Pass m TyName Name uni fun a
LetMerge.letMergePass PirTCConfig uni fun
tcconfig
        ]

simplifierIteration :: Compiling m e uni fun a => String -> m (P.Pass m TyName Name uni fun (Provenance a))
simplifierIteration :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
String -> m (Pass m TyName Name uni fun (Provenance a))
simplifierIteration String
suffix = do
  CompilationOpts a
opts <- Getting
  (CompilationOpts a) (CompilationCtx uni fun a) (CompilationOpts a)
-> m (CompilationOpts a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CompilationOpts a) (CompilationCtx uni fun a) (CompilationOpts a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts
  PirTCConfig uni fun
tcconfig <- Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig
  BuiltinsInfo uni fun
binfo <- Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (BuiltinsInfo uni fun)
-> m (BuiltinsInfo uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (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)
ccBuiltinsInfo
  CostingPart uni fun
costModel <- Getting
  (CostingPart uni fun)
  (CompilationCtx uni fun a)
  (CostingPart uni fun)
-> m (CostingPart uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CostingPart uni fun)
  (CompilationCtx uni fun a)
  (CostingPart uni fun)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CostingPart uni fun -> f (CostingPart uni fun))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccBuiltinCostModel
  InlineHints Name (Provenance a)
hints <- Getting
  (InlineHints Name (Provenance a))
  (CompilationCtx uni fun a)
  (InlineHints Name (Provenance a))
-> m (InlineHints Name (Provenance a))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a
 -> Const (InlineHints Name (Provenance a)) (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const
     (InlineHints Name (Provenance a)) (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a
  -> Const (InlineHints Name (Provenance a)) (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const
      (InlineHints Name (Provenance a)) (CompilationCtx uni fun a))
-> ((InlineHints Name (Provenance a)
     -> Const
          (InlineHints Name (Provenance a))
          (InlineHints Name (Provenance a)))
    -> CompilationOpts a
    -> Const (InlineHints Name (Provenance a)) (CompilationOpts a))
-> Getting
     (InlineHints Name (Provenance a))
     (CompilationCtx uni fun a)
     (InlineHints Name (Provenance a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InlineHints Name (Provenance a)
 -> Const
      (InlineHints Name (Provenance a))
      (InlineHints Name (Provenance a)))
-> CompilationOpts a
-> Const (InlineHints Name (Provenance a)) (CompilationOpts a)
forall a1 a2 (f :: * -> *).
Functor f =>
(InlineHints Name (Provenance a1)
 -> f (InlineHints Name (Provenance a2)))
-> CompilationOpts a1 -> f (CompilationOpts a2)
coInlineHints)
  Bool
preserveLogging <- Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coPreserveLogging)
  RewriteRules uni fun
rules <- Getting
  (RewriteRules uni fun)
  (CompilationCtx uni fun a)
  (RewriteRules uni fun)
-> m (RewriteRules uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (RewriteRules uni fun)
  (CompilationCtx uni fun a)
  (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)
ccRewriteRules
  Bool
ic <- Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coInlineConstants)

  Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pass m TyName Name uni fun (Provenance a)
 -> m (Pass m TyName Name uni fun (Provenance a)))
-> Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a b. (a -> b) -> a -> b
$ String
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) tyname name (uni :: * -> *) fun a.
String
-> Pass m tyname name uni fun a -> Pass m tyname name uni fun a
P.NamedPass (String
"simplifier" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ [Pass m TyName Name uni fun (Provenance a)]
-> Pass m TyName Name uni fun (Provenance a)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
      [ Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierUnwrapCancel) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ PirTCConfig uni fun -> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, Applicative m) =>
PirTCConfig uni fun -> Pass m TyName Name uni fun a
Unwrap.unwrapCancelPass PirTCConfig uni fun
tcconfig
      , Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierCaseReduce) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ PirTCConfig uni fun -> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, Applicative m) =>
PirTCConfig uni fun -> Pass m TyName Name uni fun a
CaseReduce.caseReducePass PirTCConfig uni fun
tcconfig
      , Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierKnownCon) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ PirTCConfig uni fun -> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) (uni :: * -> *) fun a.
(Typecheckable uni fun, GEq uni, Ord a, MonadQuote m) =>
PirTCConfig uni fun -> Pass m TyName Name uni fun a
KnownCon.knownConPassSC PirTCConfig uni fun
tcconfig
      , Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierBeta) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ PirTCConfig uni fun -> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, MonadQuote m, Ord a) =>
PirTCConfig uni fun -> Pass m TyName Name uni fun a
Beta.betaPassSC PirTCConfig uni fun
tcconfig
      , Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierStrictifyBindings ) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ PirTCConfig uni fun
-> BuiltinsInfo uni fun
-> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) (uni :: * -> *) fun a.
(Typecheckable uni fun, GEq uni, Applicative m) =>
PirTCConfig uni fun
-> BuiltinsInfo uni fun -> Pass m TyName Name uni fun a
StrictifyBindings.strictifyBindingsPass PirTCConfig uni fun
tcconfig BuiltinsInfo uni fun
binfo
      , Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierEvaluateBuiltins) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ PirTCConfig uni fun
-> Bool
-> BuiltinsInfo uni fun
-> CostingPart uni fun
-> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, Applicative m) =>
PirTCConfig uni fun
-> Bool
-> BuiltinsInfo uni fun
-> CostingPart uni fun
-> Pass m TyName Name uni fun a
EvaluateBuiltins.evaluateBuiltinsPass PirTCConfig uni fun
tcconfig Bool
preserveLogging BuiltinsInfo uni fun
binfo CostingPart uni fun
costModel
      , Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierInline) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ Bool
-> PirTCConfig uni fun
-> InlineHints Name (Provenance a)
-> BuiltinsInfo uni fun
-> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun ann (m :: * -> *).
(Typecheckable uni fun, GEq uni, Ord ann,
 ExternalConstraints TyName Name uni fun m) =>
Bool
-> PirTCConfig uni fun
-> InlineHints Name ann
-> BuiltinsInfo uni fun
-> Pass m TyName Name uni fun ann
Inline.inlinePassSC Bool
ic PirTCConfig uni fun
tcconfig InlineHints Name (Provenance a)
hints BuiltinsInfo uni fun
binfo
      , Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierRewrite) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ PirTCConfig uni fun
-> RewriteRules uni fun
-> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) (uni :: * -> *) fun a.
(Typecheckable uni fun, GEq uni, Ord a, MonadQuote m, Monoid a) =>
PirTCConfig uni fun
-> RewriteRules uni fun -> Pass m TyName Name uni fun a
RewriteRules.rewritePassSC PirTCConfig uni fun
tcconfig RewriteRules uni fun
rules
      ]


simplifier :: Compiling m e uni fun a => m (P.Pass m TyName Name uni fun (Provenance a))
simplifier :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
simplifier = do
  Bool
optimize <- Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coOptimize)
  Int
maxIterations <- Getting Int (CompilationCtx uni fun a) Int -> m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Int (CompilationOpts a))
-> CompilationCtx uni fun a -> Const Int (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Int (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Int (CompilationCtx uni fun a))
-> ((Int -> Const Int Int)
    -> CompilationOpts a -> Const Int (CompilationOpts a))
-> Getting Int (CompilationCtx uni fun a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> CompilationOpts a -> Const Int (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> CompilationOpts a -> f (CompilationOpts a)
coMaxSimplifierIterations)
  [Pass m TyName Name uni fun (Provenance a)]
passes <- [Int]
-> (Int -> m (Pass m TyName Name uni fun (Provenance a)))
-> m [Pass m TyName Name uni fun (Provenance a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Int
1 .. Int
maxIterations] ((Int -> m (Pass m TyName Name uni fun (Provenance a)))
 -> m [Pass m TyName Name uni fun (Provenance a)])
-> (Int -> m (Pass m TyName Name uni fun (Provenance a)))
-> m [Pass m TyName Name uni fun (Provenance a)]
forall a b. (a -> b) -> a -> b
$ \Int
i -> String -> m (Pass m TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
String -> m (Pass m TyName Name uni fun (Provenance a))
simplifierIteration (String
" (pass " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
  Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pass m TyName Name uni fun (Provenance a)
 -> m (Pass m TyName Name uni fun (Provenance a)))
-> Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a b. (a -> b) -> a -> b
$ Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen Bool
optimize (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ String
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) tyname name (uni :: * -> *) fun a.
String
-> Pass m tyname name uni fun a -> Pass m tyname name uni fun a
P.NamedPass String
"simplifier" ([Pass m TyName Name uni fun (Provenance a)]
-> Pass m TyName Name uni fun (Provenance a)
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Pass m TyName Name uni fun (Provenance a)]
passes)

-- | Typecheck a PIR Term iff the context demands it.
typeCheckTerm :: (Compiling m e uni fun a) => m (P.Pass m TyName Name uni fun (Provenance a))
typeCheckTerm :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
typeCheckTerm = do
  Bool
doTc <- Getting Bool (CompilationCtx uni fun a) Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((CompilationOpts a -> Const Bool (CompilationOpts a))
-> CompilationCtx uni fun a
-> Const Bool (CompilationCtx uni fun a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts ((CompilationOpts a -> Const Bool (CompilationOpts a))
 -> CompilationCtx uni fun a
 -> Const Bool (CompilationCtx uni fun a))
-> ((Bool -> Const Bool Bool)
    -> CompilationOpts a -> Const Bool (CompilationOpts a))
-> Getting Bool (CompilationCtx uni fun a) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> CompilationOpts a -> Const Bool (CompilationOpts a)
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coTypecheck)
  PirTCConfig uni fun
tcconfig <- Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig
  Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pass m TyName Name uni fun (Provenance a)
 -> m (Pass m TyName Name uni fun (Provenance a)))
-> Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a b. (a -> b) -> a -> b
$ Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen Bool
doTc (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$ PirTCConfig uni fun -> Pass m TyName Name uni fun (Provenance a)
forall err (uni :: * -> *) fun a (m :: * -> *).
(MonadTypeCheckPir err uni fun a m, Ord a) =>
PirTCConfig uni fun -> Pass m TyName Name uni fun a
P.typecheckPass PirTCConfig uni fun
tcconfig

dce :: Compiling m e uni fun a => m (P.Pass m TyName Name uni fun (Provenance a))
dce :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
dce = do
  CompilationOpts a
opts <- Getting
  (CompilationOpts a) (CompilationCtx uni fun a) (CompilationOpts a)
-> m (CompilationOpts a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CompilationOpts a) (CompilationCtx uni fun a) (CompilationOpts a)
forall (uni :: * -> *) fun a (f :: * -> *).
Functor f =>
(CompilationOpts a -> f (CompilationOpts a))
-> CompilationCtx uni fun a -> f (CompilationCtx uni fun a)
ccOpts
  PirTCConfig uni fun
typeCheckConfig <- Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig
  BuiltinsInfo uni fun
builtinsInfo <- Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (BuiltinsInfo uni fun)
-> m (BuiltinsInfo uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (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)
ccBuiltinsInfo
  Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pass m TyName Name uni fun (Provenance a)
 -> m (Pass m TyName Name uni fun (Provenance a)))
-> Pass m TyName Name uni fun (Provenance a)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a b. (a -> b) -> a -> b
$
    Bool
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a. Monoid a => Bool -> a -> a
mwhen (CompilationOpts a
opts CompilationOpts a -> Getting Bool (CompilationOpts a) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (CompilationOpts a) Bool
forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> CompilationOpts a -> f (CompilationOpts a)
coDoSimplifierRemoveDeadBindings) (Pass m TyName Name uni fun (Provenance a)
 -> Pass m TyName Name uni fun (Provenance a))
-> Pass m TyName Name uni fun (Provenance a)
-> Pass m TyName Name uni fun (Provenance a)
forall a b. (a -> b) -> a -> b
$
      PirTCConfig uni fun
-> BuiltinsInfo uni fun
-> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun a (m :: * -> *).
(Typecheckable uni fun, GEq uni, Ord a, MonadQuote m) =>
PirTCConfig uni fun
-> BuiltinsInfo uni fun -> Pass m TyName Name uni fun a
DeadCode.removeDeadBindingsPassSC PirTCConfig uni fun
typeCheckConfig BuiltinsInfo uni fun
builtinsInfo

-- | The 1st half of the PIR compiler pipeline up to floating/merging the lets.
-- We stop momentarily here to give a chance to the tx-plugin
-- to dump a "readable" version of pir (i.e. floated).
compileToReadable
  :: 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)
compileToReadable :: 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)
compileToReadable (Program b
a Version
v Term TyName Name uni fun b
t) = do
  Version -> m ()
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
Version -> m ()
validateOpts Version
v
  let pipeline :: m (P.Pass m TyName Name uni fun b)
      pipeline :: m (Pass m TyName Name uni fun b)
pipeline = (Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
 -> Ap m (Pass m TyName Name uni fun (Provenance a)))
-> ((Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
     -> Ap m (Pass m TyName Name uni fun (Provenance a)))
    -> [m (Pass m TyName Name uni fun (Provenance a))]
    -> Ap m (Pass m TyName Name uni fun (Provenance a)))
-> [m (Pass m TyName Name uni fun (Provenance a))]
-> Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
forall (f :: * -> *) s t.
(Functor f, Rewrapping s t) =>
(Unwrapped s -> s)
-> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s)
ala m (Pass m TyName Name uni fun (Provenance a))
-> Ap m (Pass m TyName Name uni fun (Provenance a))
Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
-> Ap m (Pass m TyName Name uni fun (Provenance a))
forall {k} (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
 -> Ap m (Pass m TyName Name uni fun (Provenance a)))
-> [m (Pass m TyName Name uni fun (Provenance a))]
-> Ap m (Pass m TyName Name uni fun (Provenance a))
(Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
 -> Ap m (Pass m TyName Name uni fun (Provenance a)))
-> [Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))]
-> Ap m (Pass m TyName Name uni fun (Provenance a))
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [m (Pass m TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
typeCheckTerm, m (Pass m TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
dce, m (Pass m TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
simplifier, m (Pass m TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
floatOutPasses]
  b
-> Version
-> Term TyName Name uni fun b
-> Program TyName Name uni fun b
forall tyname name (uni :: * -> *) fun ann.
ann
-> Version
-> Term tyname name uni fun ann
-> Program tyname name uni fun ann
Program b
a Version
v (Term TyName Name uni fun b -> Program TyName Name uni fun b)
-> m (Term TyName Name uni fun b)
-> m (Program TyName Name uni fun b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Pass m TyName Name uni fun b)
-> Term TyName Name uni fun b -> m (Term TyName Name uni fun b)
forall (m :: * -> *) e (uni :: * -> *) fun a b tyname name.
(Compiling m e uni fun a, b ~ Provenance a) =>
m (Pass m tyname name uni fun b)
-> Term tyname name uni fun b -> m (Term tyname name uni fun b)
runCompilerPass m (Pass m TyName Name uni fun b)
pipeline Term TyName Name uni fun b
t

-- | The 2nd half of the PIR compiler pipeline.
-- Compiles a 'Term' into a PLC Term, by removing/translating step-by-step the PIR's language constructs to PLC.
-- Note: the result *does* have globally unique names.
compileReadableToPlc :: 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)
compileReadableToPlc :: 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)
compileReadableToPlc (Program b
a Version
v Term TyName Name uni fun b
t) = do

  let
    pipeline :: m (P.Pass m TyName Name uni fun b)
    pipeline :: m (Pass m TyName Name uni fun b)
pipeline = (Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
 -> Ap m (Pass m TyName Name uni fun (Provenance a)))
-> ((Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
     -> Ap m (Pass m TyName Name uni fun (Provenance a)))
    -> [m (Pass m TyName Name uni fun (Provenance a))]
    -> Ap m (Pass m TyName Name uni fun (Provenance a)))
-> [m (Pass m TyName Name uni fun (Provenance a))]
-> Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
forall (f :: * -> *) s t.
(Functor f, Rewrapping s t) =>
(Unwrapped s -> s)
-> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s)
ala m (Pass m TyName Name uni fun (Provenance a))
-> Ap m (Pass m TyName Name uni fun (Provenance a))
Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
-> Ap m (Pass m TyName Name uni fun (Provenance a))
forall {k} (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
 -> Ap m (Pass m TyName Name uni fun (Provenance a)))
-> [m (Pass m TyName Name uni fun (Provenance a))]
-> Ap m (Pass m TyName Name uni fun (Provenance a))
(Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))
 -> Ap m (Pass m TyName Name uni fun (Provenance a)))
-> [Unwrapped (Ap m (Pass m TyName Name uni fun (Provenance a)))]
-> Ap m (Pass m TyName Name uni fun (Provenance a))
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        [ m (Pass m TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
floatInPasses
        , PirTCConfig uni fun
-> Bool -> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, MonadQuote m, Ord a) =>
PirTCConfig uni fun -> Bool -> Pass m TyName Name uni fun a
NonStrict.compileNonStrictBindingsPassSC (PirTCConfig uni fun
 -> Bool -> Pass m TyName Name uni fun (Provenance a))
-> m (PirTCConfig uni fun)
-> m (Bool -> Pass m TyName Name uni fun (Provenance a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig m (Bool -> Pass m TyName Name uni fun (Provenance a))
-> m Bool -> m (Pass m TyName Name uni fun (Provenance a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        , PirTCConfig uni fun
-> BuiltinsInfo uni fun
-> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, Applicative m) =>
PirTCConfig uni fun
-> BuiltinsInfo uni fun -> Pass m TyName Name uni fun a
ThunkRec.thunkRecursionsPass (PirTCConfig uni fun
 -> BuiltinsInfo uni fun
 -> Pass m TyName Name uni fun (Provenance a))
-> m (PirTCConfig uni fun)
-> m (BuiltinsInfo uni fun
      -> Pass m TyName Name uni fun (Provenance a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig m (BuiltinsInfo uni fun
   -> Pass m TyName Name uni fun (Provenance a))
-> m (BuiltinsInfo uni fun)
-> m (Pass m TyName Name uni fun (Provenance a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (BuiltinsInfo uni fun)
-> m (BuiltinsInfo uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (BuiltinsInfo uni fun)
  (CompilationCtx uni fun a)
  (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)
ccBuiltinsInfo
        -- Process only the non-strict bindings created by 'thunkRecursions' with unit delay/forces
        -- See Note [Using unit versus force/delay]
        , PirTCConfig uni fun
-> Bool -> Pass m TyName Name uni fun (Provenance a)
forall (uni :: * -> *) fun (m :: * -> *) a.
(Typecheckable uni fun, GEq uni, MonadQuote m, Ord a) =>
PirTCConfig uni fun -> Bool -> Pass m TyName Name uni fun a
NonStrict.compileNonStrictBindingsPassSC (PirTCConfig uni fun
 -> Bool -> Pass m TyName Name uni fun (Provenance a))
-> m (PirTCConfig uni fun)
-> m (Bool -> Pass m TyName Name uni fun (Provenance a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig m (Bool -> Pass m TyName Name uni fun (Provenance a))
-> m Bool -> m (Pass m TyName Name uni fun (Provenance a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        , PirTCConfig uni fun
-> LetKind -> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
PirTCConfig uni fun
-> LetKind -> Pass m TyName Name uni fun (Provenance a)
Let.compileLetsPassSC (PirTCConfig uni fun
 -> LetKind -> Pass m TyName Name uni fun (Provenance a))
-> m (PirTCConfig uni fun)
-> m (LetKind -> Pass m TyName Name uni fun (Provenance a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig m (LetKind -> Pass m TyName Name uni fun (Provenance a))
-> m LetKind -> m (Pass m TyName Name uni fun (Provenance a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LetKind -> m LetKind
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LetKind
Let.DataTypes
        , PirTCConfig uni fun
-> LetKind -> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
PirTCConfig uni fun
-> LetKind -> Pass m TyName Name uni fun (Provenance a)
Let.compileLetsPassSC (PirTCConfig uni fun
 -> LetKind -> Pass m TyName Name uni fun (Provenance a))
-> m (PirTCConfig uni fun)
-> m (LetKind -> Pass m TyName Name uni fun (Provenance a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig m (LetKind -> Pass m TyName Name uni fun (Provenance a))
-> m LetKind -> m (Pass m TyName Name uni fun (Provenance a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LetKind -> m LetKind
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LetKind
Let.RecTerms
        -- We introduce some non-recursive let bindings while eliminating recursive let-bindings,
        -- so we can eliminate any of them which are unused here.
        , m (Pass m TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
dce
        , m (Pass m TyName Name uni fun (Provenance a))
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
m (Pass m TyName Name uni fun (Provenance a))
simplifier
        , PirTCConfig uni fun
-> LetKind -> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
PirTCConfig uni fun
-> LetKind -> Pass m TyName Name uni fun (Provenance a)
Let.compileLetsPassSC (PirTCConfig uni fun
 -> LetKind -> Pass m TyName Name uni fun (Provenance a))
-> m (PirTCConfig uni fun)
-> m (LetKind -> Pass m TyName Name uni fun (Provenance a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig m (LetKind -> Pass m TyName Name uni fun (Provenance a))
-> m LetKind -> m (Pass m TyName Name uni fun (Provenance a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LetKind -> m LetKind
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LetKind
Let.Types
        , PirTCConfig uni fun
-> LetKind -> Pass m TyName Name uni fun (Provenance a)
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
PirTCConfig uni fun
-> LetKind -> Pass m TyName Name uni fun (Provenance a)
Let.compileLetsPassSC (PirTCConfig uni fun
 -> LetKind -> Pass m TyName Name uni fun (Provenance a))
-> m (PirTCConfig uni fun)
-> m (LetKind -> Pass m TyName Name uni fun (Provenance a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (PirTCConfig uni fun)
-> m (PirTCConfig uni fun)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (PirTCConfig uni fun)
  (CompilationCtx uni fun a)
  (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)
ccTypeCheckConfig m (LetKind -> Pass m TyName Name uni fun (Provenance a))
-> m LetKind -> m (Pass m TyName Name uni fun (Provenance a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LetKind -> m LetKind
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LetKind
Let.NonRecTerms
        ]

    go :: Term TyName Name uni fun b -> m (PLCTerm uni fun a)
go =
        m (Pass m TyName Name uni fun b)
-> Term TyName Name uni fun b -> m (Term TyName Name uni fun b)
forall (m :: * -> *) e (uni :: * -> *) fun a b tyname name.
(Compiling m e uni fun a, b ~ Provenance a) =>
m (Pass m tyname name uni fun b)
-> Term tyname name uni fun b -> m (Term tyname name uni fun b)
runCompilerPass m (Pass m TyName Name uni fun b)
pipeline
        (Term TyName Name uni fun b -> m (Term TyName Name uni fun b))
-> (Term TyName Name uni fun b -> m (PLCTerm uni fun a))
-> Term TyName Name uni fun b
-> m (PLCTerm uni fun a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Term TyName Name uni fun b
-> m () -> m (Term TyName Name uni fun b)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m ()
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
String -> m ()
logVerbose String
"  !!! lowerTerm")
        (Term TyName Name uni fun b -> m (Term TyName Name uni fun b))
-> (Term TyName Name uni fun b -> m (PLCTerm uni fun a))
-> Term TyName Name uni fun b
-> m (PLCTerm uni fun a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Term TyName Name uni fun b -> m (PLCTerm uni fun a)
PIRTerm uni fun a -> m (PLCTerm uni fun a)
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
PIRTerm uni fun a -> m (PLCTerm uni fun a)
lowerTerm

  Provenance a
-> Version -> PLCTerm uni fun a -> PLCProgram uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann
-> Version
-> Term tyname name uni fun ann
-> Program tyname name uni fun ann
PLC.Program b
Provenance a
a Version
v (PLCTerm uni fun a -> PLCProgram uni fun a)
-> m (PLCTerm uni fun a) -> m (PLCProgram uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term TyName Name uni fun b -> m (PLCTerm uni fun a)
go Term TyName Name uni fun b
t

--- | Compile a 'Program' into a PLC Program. Note: the result *does* have globally unique names.
compileProgram :: Compiling m e uni fun a
            => Program TyName Name uni fun a -> m (PLCProgram uni fun a)
compileProgram :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
Program TyName Name uni fun a -> m (PLCProgram uni fun a)
compileProgram =
  (Program TyName Name uni fun (Provenance a)
-> m (Program TyName Name uni fun (Provenance a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Program TyName Name uni fun (Provenance a)
 -> m (Program TyName Name uni fun (Provenance a)))
-> (Program TyName Name uni fun a
    -> Program TyName Name uni fun (Provenance a))
-> Program TyName Name uni fun a
-> m (Program TyName Name uni fun (Provenance a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program TyName Name uni fun a
-> Program TyName Name uni fun (Provenance a)
forall (f :: * -> *) a. Functor f => f a -> f (Provenance a)
original)
  (Program TyName Name uni fun a
 -> m (Program TyName Name uni fun (Provenance a)))
-> (Program TyName Name uni fun (Provenance a)
    -> m (PLCProgram uni fun a))
-> Program TyName Name uni fun a
-> m (PLCProgram uni fun a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Program TyName Name uni fun (Provenance a)
-> m () -> m (Program TyName Name uni fun (Provenance a))
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m ()
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
String -> m ()
logDebug String
"!!! compileToReadable")
  (Program TyName Name uni fun (Provenance a)
 -> m (Program TyName Name uni fun (Provenance a)))
-> (Program TyName Name uni fun (Provenance a)
    -> m (PLCProgram uni fun a))
-> Program TyName Name uni fun (Provenance a)
-> m (PLCProgram uni fun a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Program TyName Name uni fun (Provenance a)
-> m (Program TyName Name uni fun (Provenance a))
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)
compileToReadable
  (Program TyName Name uni fun (Provenance a)
 -> m (Program TyName Name uni fun (Provenance a)))
-> (Program TyName Name uni fun (Provenance a)
    -> m (PLCProgram uni fun a))
-> Program TyName Name uni fun (Provenance a)
-> m (PLCProgram uni fun a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Program TyName Name uni fun (Provenance a)
-> m () -> m (Program TyName Name uni fun (Provenance a))
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m ()
forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
String -> m ()
logDebug String
"!!! compileReadableToPlc")
  (Program TyName Name uni fun (Provenance a)
 -> m (Program TyName Name uni fun (Provenance a)))
-> (Program TyName Name uni fun (Provenance a)
    -> m (PLCProgram uni fun a))
-> Program TyName Name uni fun (Provenance a)
-> m (PLCProgram uni fun a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Program TyName Name uni fun (Provenance a)
-> m (PLCProgram uni fun a)
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)
compileReadableToPlc