{-# 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 :: 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)
_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 (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 (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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type TyName uni (Provenance a)
-> m (Type TyName uni (Provenance 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 (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