{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module PlutusIR.Compiler.Lower where
import PlutusIR
import PlutusIR.Compiler.Types
import PlutusIR.Error
import PlutusCore qualified as PLC
import Control.Monad.Error.Lens
lowerTerm :: Compiling m e uni fun a => PIRTerm uni fun a -> m (PLCTerm uni fun a)
lowerTerm :: forall (m :: * -> *) e (uni :: * -> *) fun a.
Compiling m e uni fun a =>
PIRTerm uni fun a -> m (PLCTerm uni fun a)
lowerTerm = \case
Let Provenance a
x Recursivity
_ NonEmpty (Binding TyName Name uni fun (Provenance a))
_ PIRTerm uni fun a
_ -> AReview e (Error uni fun (Provenance a))
-> Error uni fun (Provenance a) -> m (PLCTerm uni fun a)
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e (Error uni fun (Provenance a))
forall r (uni :: * -> *) fun a.
AsError r uni fun a =>
Prism' r (Error uni fun a)
Prism' e (Error uni fun (Provenance a))
_Error (Error uni fun (Provenance a) -> m (PLCTerm uni fun a))
-> Error uni fun (Provenance a) -> m (PLCTerm uni fun a)
forall a b. (a -> b) -> a -> b
$
Provenance a -> Text -> Error uni fun (Provenance a)
forall (uni :: * -> *) fun a. a -> Text -> Error uni fun a
CompilationError Provenance a
x Text
"Let bindings should have been eliminated before lowering"
Var Provenance a
x Name
n -> PLCTerm uni fun a -> m (PLCTerm uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PLCTerm uni fun a -> m (PLCTerm uni fun a))
-> PLCTerm uni fun a -> m (PLCTerm uni fun a)
forall a b. (a -> b) -> a -> b
$ Provenance a -> Name -> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann -> name -> Term tyname name uni fun ann
PLC.Var Provenance a
x Name
n
TyAbs Provenance a
x TyName
n Kind (Provenance a)
k PIRTerm uni fun a
t -> Provenance a
-> TyName
-> Kind (Provenance a)
-> PLCTerm uni fun a
-> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann
-> tyname
-> Kind ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
PLC.TyAbs Provenance a
x TyName
n Kind (Provenance a)
k (PLCTerm uni fun a -> PLCTerm uni fun a)
-> m (PLCTerm uni fun a) -> m (PLCTerm uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 PIRTerm uni fun a
t
LamAbs Provenance a
x Name
n Type TyName uni (Provenance a)
ty PIRTerm uni fun a
t -> Provenance a
-> Name
-> Type TyName uni (Provenance a)
-> PLCTerm uni fun a
-> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann
-> name
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
PLC.LamAbs Provenance a
x Name
n Type TyName uni (Provenance a)
ty (PLCTerm uni fun a -> PLCTerm uni fun a)
-> m (PLCTerm uni fun a) -> m (PLCTerm uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 PIRTerm uni fun a
t
Apply Provenance a
x PIRTerm uni fun a
t1 PIRTerm uni fun a
t2 -> Provenance a
-> PLCTerm uni fun a -> PLCTerm uni fun a -> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
PLC.Apply Provenance a
x (PLCTerm uni fun a -> PLCTerm uni fun a -> PLCTerm uni fun a)
-> m (PLCTerm uni fun a)
-> m (PLCTerm uni fun a -> PLCTerm uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 PIRTerm uni fun a
t1 m (PLCTerm uni fun a -> PLCTerm uni fun a)
-> m (PLCTerm uni fun a) -> m (PLCTerm uni fun a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 PIRTerm uni fun a
t2
Constant Provenance a
x Some (ValueOf uni)
c -> PLCTerm uni fun a -> m (PLCTerm uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PLCTerm uni fun a -> m (PLCTerm uni fun a))
-> PLCTerm uni fun a -> m (PLCTerm uni fun a)
forall a b. (a -> b) -> a -> b
$ Provenance a -> Some (ValueOf uni) -> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann -> Some (ValueOf uni) -> Term tyname name uni fun ann
PLC.Constant Provenance a
x Some (ValueOf uni)
c
Builtin Provenance a
x fun
bi -> PLCTerm uni fun a -> m (PLCTerm uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PLCTerm uni fun a -> m (PLCTerm uni fun a))
-> PLCTerm uni fun a -> m (PLCTerm uni fun a)
forall a b. (a -> b) -> a -> b
$ Provenance a -> fun -> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann -> fun -> Term tyname name uni fun ann
PLC.Builtin Provenance a
x fun
bi
TyInst Provenance a
x PIRTerm uni fun a
t Type TyName uni (Provenance a)
ty -> Provenance a
-> PLCTerm uni fun a
-> Type TyName uni (Provenance a)
-> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann
-> Term tyname name uni fun ann
-> Type tyname uni ann
-> Term tyname name uni fun ann
PLC.TyInst Provenance a
x (PLCTerm uni fun a
-> Type TyName uni (Provenance a) -> PLCTerm uni fun a)
-> m (PLCTerm uni fun a)
-> m (Type TyName uni (Provenance a) -> PLCTerm uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 PIRTerm uni fun a
t m (Type TyName uni (Provenance a) -> PLCTerm uni fun a)
-> m (Type TyName uni (Provenance a)) -> m (PLCTerm uni fun a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type TyName uni (Provenance a)
-> m (Type TyName uni (Provenance a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type TyName uni (Provenance a)
ty
Error Provenance a
x Type TyName uni (Provenance a)
ty -> PLCTerm uni fun a -> m (PLCTerm uni fun a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PLCTerm uni fun a -> m (PLCTerm uni fun a))
-> PLCTerm uni fun a -> m (PLCTerm uni fun a)
forall a b. (a -> b) -> a -> b
$ Provenance a -> Type TyName uni (Provenance a) -> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann -> Type tyname uni ann -> Term tyname name uni fun ann
PLC.Error Provenance a
x Type TyName uni (Provenance a)
ty
IWrap Provenance a
x Type TyName uni (Provenance a)
tn Type TyName uni (Provenance a)
ty PIRTerm uni fun a
t -> Provenance a
-> Type TyName uni (Provenance a)
-> Type TyName uni (Provenance a)
-> PLCTerm uni fun a
-> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
PLC.IWrap Provenance a
x Type TyName uni (Provenance a)
tn Type TyName uni (Provenance a)
ty (PLCTerm uni fun a -> PLCTerm uni fun a)
-> m (PLCTerm uni fun a) -> m (PLCTerm uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 PIRTerm uni fun a
t
Unwrap Provenance a
x PIRTerm uni fun a
t -> Provenance a -> PLCTerm uni fun a -> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann -> Term tyname name uni fun ann -> Term tyname name uni fun ann
PLC.Unwrap Provenance a
x (PLCTerm uni fun a -> PLCTerm uni fun a)
-> m (PLCTerm uni fun a) -> m (PLCTerm uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 PIRTerm uni fun a
t
Constr Provenance a
x Type TyName uni (Provenance a)
ty Word64
i [PIRTerm uni fun a]
es -> Provenance a
-> Type TyName uni (Provenance a)
-> Word64
-> [PLCTerm uni fun a]
-> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann
-> Type tyname uni ann
-> Word64
-> [Term tyname name uni fun ann]
-> Term tyname name uni fun ann
PLC.Constr Provenance a
x Type TyName uni (Provenance a)
ty Word64
i ([PLCTerm uni fun a] -> PLCTerm uni fun a)
-> m [PLCTerm uni fun a] -> m (PLCTerm uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PIRTerm uni fun a -> m (PLCTerm uni fun a))
-> [PIRTerm uni fun a] -> m [PLCTerm uni fun a]
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 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 [PIRTerm uni fun a]
es
Case Provenance a
x Type TyName uni (Provenance a)
ty PIRTerm uni fun a
arg [PIRTerm uni fun a]
cs -> Provenance a
-> Type TyName uni (Provenance a)
-> PLCTerm uni fun a
-> [PLCTerm uni fun a]
-> PLCTerm uni fun a
forall tyname name (uni :: * -> *) fun ann.
ann
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> [Term tyname name uni fun ann]
-> Term tyname name uni fun ann
PLC.Case Provenance a
x Type TyName uni (Provenance a)
ty (PLCTerm uni fun a -> [PLCTerm uni fun a] -> PLCTerm uni fun a)
-> m (PLCTerm uni fun a)
-> m ([PLCTerm uni fun a] -> PLCTerm uni fun a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 PIRTerm uni fun a
arg m ([PLCTerm uni fun a] -> PLCTerm uni fun a)
-> m [PLCTerm uni fun a] -> m (PLCTerm uni fun a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PIRTerm uni fun a -> m (PLCTerm uni fun a))
-> [PIRTerm uni fun a] -> m [PLCTerm uni fun a]
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 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 [PIRTerm uni fun a]
cs