{-# 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

-- | Turns a PIR 'Term' with no remaining PIR-specific features into a PLC 'PLC.Term' by simply
-- translating the constructors across.
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