{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module PlutusTx.Compiler.Builtins (
builtinNames
, defineBuiltinTypes
, defineBuiltinTerms
, lookupBuiltinTerm
, lookupBuiltinType
, errorFunc) where
import PlutusTx.Builtins.HasOpaque qualified as Builtins
import PlutusTx.Builtins.Internal qualified as Builtins
import PlutusTx.Compiler.Error
import PlutusTx.Compiler.Names
import PlutusTx.Compiler.Types
import PlutusTx.Compiler.Utils
import PlutusTx.PIRTypes
import PlutusIR qualified as PIR
import PlutusIR.Compiler.Definitions qualified as PIR
import PlutusIR.Compiler.Names
import PlutusIR.MkPir qualified as PIR
import PlutusIR.Purity qualified as PIR
import PlutusCore qualified as PLC
import PlutusCore.Builtin qualified as PLC
import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1
import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2
import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing
import PlutusCore.Data qualified as PLC
import PlutusCore.Quote
import PlutusCore.StdLib.Data.Pair qualified as PLC
import GHC.Plugins qualified as GHC
import Language.Haskell.TH.Syntax qualified as TH
import Control.Monad.Reader (asks)
import Data.ByteString qualified as BS
import Data.Functor
import Data.Proxy
import Data.Text (Text)
import PlutusPrelude (enumerate, for_)
mkBuiltin :: fun -> PIR.Term tyname name uni fun Ann
mkBuiltin :: forall fun tyname name (uni :: * -> *).
fun -> Term tyname name uni fun Ann
mkBuiltin = Ann -> fun -> Term tyname name uni fun Ann
forall tyname name (uni :: * -> *) fun a.
a -> fun -> Term tyname name uni fun a
PIR.Builtin Ann
annMayInline
builtinNames :: [TH.Name]
builtinNames :: [Name]
builtinNames = [
''Builtins.BuiltinByteString
, ''Builtins.BuiltinByteStringHex
, ''Builtins.BuiltinByteStringUtf8
, 'Builtins.appendByteString
, 'Builtins.consByteString
, 'Builtins.sliceByteString
, 'Builtins.lengthOfByteString
, 'Builtins.indexByteString
, 'Builtins.sha2_256
, 'Builtins.sha3_256
, 'Builtins.blake2b_224
, 'Builtins.blake2b_256
, 'Builtins.keccak_256
, 'Builtins.ripemd_160
, 'Builtins.equalsByteString
, 'Builtins.lessThanByteString
, 'Builtins.lessThanEqualsByteString
, 'Builtins.emptyByteString
, 'Builtins.decodeUtf8
, 'Builtins.stringToBuiltinByteString
, 'Builtins.stringToBuiltinByteStringHex
, 'Builtins.stringToBuiltinByteStringUtf8
, 'Builtins.verifyEcdsaSecp256k1Signature
, 'Builtins.verifySchnorrSecp256k1Signature
, 'Builtins.verifyEd25519Signature
, ''Builtins.BuiltinInteger
, ''Integer
, 'Builtins.addInteger
, 'Builtins.subtractInteger
, 'Builtins.multiplyInteger
, 'Builtins.divideInteger
, 'Builtins.modInteger
, 'Builtins.quotientInteger
, 'Builtins.remainderInteger
, 'Builtins.lessThanInteger
, 'Builtins.lessThanEqualsInteger
, 'Builtins.equalsInteger
, 'Builtins.error
, ''Builtins.BuiltinString
, 'Builtins.appendString
, 'Builtins.emptyString
, 'Builtins.equalsString
, 'Builtins.encodeUtf8
, 'Builtins.integerToByteString
, 'Builtins.byteStringToInteger
, 'Builtins.stringToBuiltinString
, 'Builtins.trace
, ''Builtins.BuiltinBool
, 'Builtins.ifThenElse
, 'Builtins.true
, 'Builtins.false
, ''Builtins.BuiltinUnit
, 'Builtins.unitval
, 'Builtins.chooseUnit
, ''Builtins.BuiltinPair
, 'Builtins.fst
, 'Builtins.snd
, 'Builtins.mkPairData
, ''Builtins.BuiltinList
, 'Builtins.null
, 'Builtins.head
, 'Builtins.tail
, 'Builtins.chooseList
, 'Builtins.caseList'
, 'Builtins.mkNilData
, 'Builtins.mkNilPairData
, 'Builtins.mkCons
, ''Builtins.BuiltinData
, 'Builtins.chooseData
, 'Builtins.caseData'
, 'Builtins.equalsData
, 'Builtins.serialiseData
, 'Builtins.mkConstr
, 'Builtins.mkMap
, 'Builtins.mkList
, 'Builtins.mkI
, 'Builtins.mkB
, 'Builtins.unsafeDataAsConstr
, 'Builtins.unsafeDataAsMap
, 'Builtins.unsafeDataAsList
, 'Builtins.unsafeDataAsB
, 'Builtins.unsafeDataAsI
, ''Builtins.BuiltinBLS12_381_G1_Element
, 'Builtins.bls12_381_G1_equals
, 'Builtins.bls12_381_G1_add
, 'Builtins.bls12_381_G1_neg
, 'Builtins.bls12_381_G1_scalarMul
, 'Builtins.bls12_381_G1_compress
, 'Builtins.bls12_381_G1_uncompress
, 'Builtins.bls12_381_G1_hashToGroup
, 'Builtins.bls12_381_G1_compressed_zero
, 'Builtins.bls12_381_G1_compressed_generator
, ''Builtins.BuiltinBLS12_381_G2_Element
, 'Builtins.bls12_381_G2_equals
, 'Builtins.bls12_381_G2_add
, 'Builtins.bls12_381_G2_neg
, 'Builtins.bls12_381_G2_scalarMul
, 'Builtins.bls12_381_G2_compress
, 'Builtins.bls12_381_G2_uncompress
, 'Builtins.bls12_381_G2_hashToGroup
, 'Builtins.bls12_381_G2_compressed_zero
, 'Builtins.bls12_381_G2_compressed_generator
, ''Builtins.BuiltinBLS12_381_MlResult
, 'Builtins.bls12_381_millerLoop
, 'Builtins.bls12_381_mulMlResult
, 'Builtins.bls12_381_finalVerify
, 'Builtins.integerToByteString
, 'Builtins.byteStringToInteger
, 'Builtins.andByteString
, 'Builtins.orByteString
, 'Builtins.xorByteString
, 'Builtins.complementByteString
, 'Builtins.readBit
, 'Builtins.writeBits
, 'Builtins.replicateByte
, 'Builtins.shiftByteString
, 'Builtins.rotateByteString
, 'Builtins.countSetBits
, 'Builtins.findFirstSetBit
, 'Builtins.expModInteger
]
defineBuiltinTerm :: CompilingDefault uni fun m ann => Ann -> TH.Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm :: forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
ann Name
name PIRTerm uni fun
term = do
Id
ghcId <- Name -> m Id
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> m Id
lookupGhcId Name
name
PLCVar uni
var <- Ann -> Id -> m (PLCVar uni)
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Id -> m (PLCVar uni)
compileVarFresh Ann
ann Id
ghcId
BuiltinsInfo uni fun
binfo <- (CompileContext uni fun -> BuiltinsInfo uni fun)
-> m (BuiltinsInfo uni fun)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CompileContext uni fun -> BuiltinsInfo uni fun
forall (uni :: * -> *) fun.
CompileContext uni fun -> BuiltinsInfo uni fun
ccBuiltinsInfo
let strictness :: Strictness
strictness = if BuiltinsInfo uni fun
-> VarsInfo TyName Name uni Ann -> PIRTerm uni fun -> Bool
forall (uni :: * -> *) fun name tyname a.
(ToBuiltinMeaning uni fun, HasUnique name TermUnique) =>
BuiltinsInfo uni fun
-> VarsInfo tyname name uni a -> Term tyname name uni fun a -> Bool
PIR.isPure BuiltinsInfo uni fun
binfo VarsInfo TyName Name uni Ann
forall a. Monoid a => a
mempty PIRTerm uni fun
term then Strictness
PIR.Strict else Strictness
PIR.NonStrict
def :: Def (PLCVar uni) (PIRTerm uni fun, Strictness)
def = PLCVar uni
-> (PIRTerm uni fun, Strictness)
-> Def (PLCVar uni) (PIRTerm uni fun, Strictness)
forall var val. var -> val -> Def var val
PIR.Def PLCVar uni
var (PIRTerm uni fun
term, Strictness
strictness)
LexName
-> Def (PLCVar uni) (PIRTerm uni fun, Strictness)
-> Set LexName
-> m ()
forall key (uni :: * -> *) fun ann (m :: * -> *).
MonadDefs key uni fun ann m =>
key -> TermDefWithStrictness uni fun ann -> Set key -> m ()
PIR.defineTerm (Name -> LexName
LexName (Name -> LexName) -> Name -> LexName
forall a b. (a -> b) -> a -> b
$ Id -> Name
forall a. NamedThing a => a -> Name
GHC.getName Id
ghcId) Def (PLCVar uni) (PIRTerm uni fun, Strictness)
def Set LexName
forall a. Monoid a => a
mempty
defineBuiltinType :: forall uni fun m ann. Compiling uni fun m ann => TH.Name -> PIRType uni -> m ()
defineBuiltinType :: forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType Name
name PIRType uni
ty = do
TyCon
tc <- Name -> m TyCon
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> m TyCon
lookupGhcTyCon Name
name
PLCTyVar
var <- TyCon -> m PLCTyVar
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
TyCon -> m PLCTyVar
compileTcTyVarFresh TyCon
tc
LexName -> TypeDef TyName uni Ann -> Set LexName -> m ()
forall key (uni :: * -> *) fun ann (m :: * -> *).
MonadDefs key uni fun ann m =>
key -> TypeDef TyName uni ann -> Set key -> m ()
PIR.defineType (Name -> LexName
LexName (Name -> LexName) -> Name -> LexName
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
forall a. NamedThing a => a -> Name
GHC.getName TyCon
tc) (PLCTyVar -> PIRType uni -> TypeDef TyName uni Ann
forall var val. var -> val -> Def var val
PIR.Def PLCTyVar
var PIRType uni
ty) Set LexName
forall a. Monoid a => a
mempty
LexName -> m ()
forall key (uni :: * -> *) fun ann (m :: * -> *).
MonadDefs key uni fun ann m =>
key -> m ()
PIR.recordAlias (Name -> LexName
LexName (Name -> LexName) -> Name -> LexName
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
forall a. NamedThing a => a -> Name
GHC.getName TyCon
tc)
defineBuiltinTerms :: CompilingDefault uni fun m ann => m ()
defineBuiltinTerms :: forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
m ()
defineBuiltinTerms = do
PIRTerm DefaultUni DefaultFun
func <- m (PIRTerm DefaultUni DefaultFun)
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
m (PIRTerm uni fun)
delayedErrorFunc
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annAlwaysInline 'Builtins.error PIRTerm DefaultUni DefaultFun
func
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.unitval (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$ Ann -> () -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline ()
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.true (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$ Ann -> Bool -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline Bool
True
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.false (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$ Ann -> Bool -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline Bool
False
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.emptyByteString (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$ Ann -> ByteString -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline ByteString
BS.empty
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.emptyString (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$ Ann -> Text -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline (Text
"" :: Text)
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.bls12_381_G1_compressed_generator (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$
Ann -> ByteString -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline ByteString
BLS12_381.G1.compressed_generator
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.bls12_381_G1_compressed_zero (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$
Ann -> ByteString -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline ByteString
BLS12_381.G1.compressed_zero
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.bls12_381_G2_compressed_generator (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$
Ann -> ByteString -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline ByteString
BLS12_381.G2.compressed_generator
Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.bls12_381_G2_compressed_zero (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$
Ann -> ByteString -> PIRTerm DefaultUni DefaultFun
forall a (uni :: * -> *) fun (term :: * -> *) tyname name ann.
(TermLike term tyname name uni fun, HasTermLevel uni a) =>
ann -> a -> term ann
PIR.mkConstant Ann
annMayInline ByteString
BLS12_381.G2.compressed_zero
[DefaultFun] -> (DefaultFun -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [DefaultFun]
forall a. (Enum a, Bounded a) => [a]
enumerate ((DefaultFun -> m ()) -> m ()) -> (DefaultFun -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \DefaultFun
fun ->
let defineBuiltinInl :: Name -> m ()
defineBuiltinInl Name
impl = Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline Name
impl (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$ DefaultFun -> PIRTerm DefaultUni DefaultFun
forall fun tyname name (uni :: * -> *).
fun -> Term tyname name uni fun Ann
mkBuiltin DefaultFun
fun
in case DefaultFun
fun of
DefaultFun
PLC.IfThenElse -> Name -> m ()
defineBuiltinInl 'Builtins.ifThenElse
DefaultFun
PLC.ChooseUnit -> Name -> m ()
defineBuiltinInl 'Builtins.chooseUnit
DefaultFun
PLC.AppendByteString -> Name -> m ()
defineBuiltinInl 'Builtins.appendByteString
DefaultFun
PLC.ConsByteString -> Name -> m ()
defineBuiltinInl 'Builtins.consByteString
DefaultFun
PLC.SliceByteString -> Name -> m ()
defineBuiltinInl 'Builtins.sliceByteString
DefaultFun
PLC.LengthOfByteString -> Name -> m ()
defineBuiltinInl 'Builtins.lengthOfByteString
DefaultFun
PLC.IndexByteString -> Name -> m ()
defineBuiltinInl 'Builtins.indexByteString
DefaultFun
PLC.Sha2_256 -> Name -> m ()
defineBuiltinInl 'Builtins.sha2_256
DefaultFun
PLC.Sha3_256 -> Name -> m ()
defineBuiltinInl 'Builtins.sha3_256
DefaultFun
PLC.Blake2b_224 -> Name -> m ()
defineBuiltinInl 'Builtins.blake2b_224
DefaultFun
PLC.Blake2b_256 -> Name -> m ()
defineBuiltinInl 'Builtins.blake2b_256
DefaultFun
PLC.Keccak_256 -> Name -> m ()
defineBuiltinInl 'Builtins.keccak_256
DefaultFun
PLC.Ripemd_160 -> Name -> m ()
defineBuiltinInl 'Builtins.ripemd_160
DefaultFun
PLC.EqualsByteString -> Name -> m ()
defineBuiltinInl 'Builtins.equalsByteString
DefaultFun
PLC.LessThanByteString -> Name -> m ()
defineBuiltinInl 'Builtins.lessThanByteString
DefaultFun
PLC.LessThanEqualsByteString -> Name -> m ()
defineBuiltinInl 'Builtins.lessThanEqualsByteString
DefaultFun
PLC.DecodeUtf8 -> Name -> m ()
defineBuiltinInl 'Builtins.decodeUtf8
DefaultFun
PLC.AppendString -> Name -> m ()
defineBuiltinInl 'Builtins.appendString
DefaultFun
PLC.EqualsString -> Name -> m ()
defineBuiltinInl 'Builtins.equalsString
DefaultFun
PLC.EncodeUtf8 -> Name -> m ()
defineBuiltinInl 'Builtins.encodeUtf8
DefaultFun
PLC.VerifyEd25519Signature -> Name -> m ()
defineBuiltinInl 'Builtins.verifyEd25519Signature
DefaultFun
PLC.VerifyEcdsaSecp256k1Signature -> Name -> m ()
defineBuiltinInl 'Builtins.verifyEcdsaSecp256k1Signature
DefaultFun
PLC.VerifySchnorrSecp256k1Signature -> Name -> m ()
defineBuiltinInl 'Builtins.verifySchnorrSecp256k1Signature
DefaultFun
PLC.AddInteger -> Name -> m ()
defineBuiltinInl 'Builtins.addInteger
DefaultFun
PLC.SubtractInteger -> Name -> m ()
defineBuiltinInl 'Builtins.subtractInteger
DefaultFun
PLC.MultiplyInteger -> Name -> m ()
defineBuiltinInl 'Builtins.multiplyInteger
DefaultFun
PLC.DivideInteger -> Name -> m ()
defineBuiltinInl 'Builtins.divideInteger
DefaultFun
PLC.ModInteger -> Name -> m ()
defineBuiltinInl 'Builtins.modInteger
DefaultFun
PLC.QuotientInteger -> Name -> m ()
defineBuiltinInl 'Builtins.quotientInteger
DefaultFun
PLC.RemainderInteger -> Name -> m ()
defineBuiltinInl 'Builtins.remainderInteger
DefaultFun
PLC.LessThanInteger -> Name -> m ()
defineBuiltinInl 'Builtins.lessThanInteger
DefaultFun
PLC.LessThanEqualsInteger -> Name -> m ()
defineBuiltinInl 'Builtins.lessThanEqualsInteger
DefaultFun
PLC.EqualsInteger -> Name -> m ()
defineBuiltinInl 'Builtins.equalsInteger
DefaultFun
PLC.Trace -> Name -> m ()
defineBuiltinInl 'Builtins.trace
DefaultFun
PLC.FstPair -> Name -> m ()
defineBuiltinInl 'Builtins.fst
DefaultFun
PLC.SndPair -> Name -> m ()
defineBuiltinInl 'Builtins.snd
DefaultFun
PLC.MkPairData -> Name -> m ()
defineBuiltinInl 'Builtins.mkPairData
DefaultFun
PLC.NullList -> Name -> m ()
defineBuiltinInl 'Builtins.null
DefaultFun
PLC.HeadList -> Name -> m ()
defineBuiltinInl 'Builtins.head
DefaultFun
PLC.TailList -> Name -> m ()
defineBuiltinInl 'Builtins.tail
DefaultFun
PLC.ChooseList -> Name -> m ()
defineBuiltinInl 'Builtins.chooseList
DefaultFun
PLC.CaseList -> Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.caseList' (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$
(() -> Ann)
-> Term TyName Name DefaultUni DefaultFun ()
-> PIRTerm DefaultUni DefaultFun
forall a b.
(a -> b)
-> Term TyName Name DefaultUni DefaultFun a
-> Term TyName Name DefaultUni DefaultFun b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
annMayInline) (Term TyName Name DefaultUni DefaultFun ()
-> PIRTerm DefaultUni DefaultFun)
-> (Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ())
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> PIRTerm DefaultUni DefaultFun
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term TyName Name DefaultUni DefaultFun ())
-> PIRTerm DefaultUni DefaultFun)
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> PIRTerm DefaultUni DefaultFun
forall a b. (a -> b) -> a -> b
$ do
TyName
a <- Text -> QuoteT Identity TyName
forall (m :: * -> *). MonadQuote m => Text -> m TyName
freshTyName Text
"a"
TyName
r <- Text -> QuoteT Identity TyName
forall (m :: * -> *). MonadQuote m => Text -> m TyName
freshTyName Text
"r"
TyName
dead <- Text -> QuoteT Identity TyName
forall (m :: * -> *). MonadQuote m => Text -> m TyName
freshTyName Text
"dead"
Name
xs <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"xs"
Name
z <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"z"
Name
f <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"f"
let listA :: Type TyName DefaultUni ()
listA = ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyApp () (forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
PLC.mkTyBuiltin @_ @[] ()) (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
a
funAtXs :: DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
funAtXs DefaultFun
headOrTail =
()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply ()
(()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
PIR.tyInst () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
PIR.builtin () DefaultFun
headOrTail) (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
a)
(() -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
xs)
Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
a (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
r (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs () Name
z (() -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs () Name
f
(()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyFun () (() -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
a) (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyFun () Type TyName DefaultUni ()
listA (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs () Name
xs Type TyName DefaultUni ()
listA
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
PIR.tyInst ()
(Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
PIR.mkIterAppNoAnn
(Term TyName Name DefaultUni DefaultFun ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
PIR.mkIterInstNoAnn
(() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
PIR.builtin () DefaultFun
PLC.ChooseList)
[ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
a
, ()
-> TyName
-> Kind ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
PLC.TyForall () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ()) (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r
])
[ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
xs
, ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ()) (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
z
, ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ()) (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
PIR.mkIterAppNoAnn
(() -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
f)
[DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
funAtXs DefaultFun
PLC.HeadList, DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
funAtXs DefaultFun
PLC.TailList]
])
(Type TyName DefaultUni ()
-> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> Type TyName DefaultUni ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r
DefaultFun
PLC.MkNilData -> Name -> m ()
defineBuiltinInl 'Builtins.mkNilData
DefaultFun
PLC.MkNilPairData -> Name -> m ()
defineBuiltinInl 'Builtins.mkNilPairData
DefaultFun
PLC.MkCons -> Name -> m ()
defineBuiltinInl 'Builtins.mkCons
DefaultFun
PLC.ChooseData -> Name -> m ()
defineBuiltinInl 'Builtins.chooseData
DefaultFun
PLC.EqualsData -> Name -> m ()
defineBuiltinInl 'Builtins.equalsData
DefaultFun
PLC.ConstrData -> Name -> m ()
defineBuiltinInl 'Builtins.mkConstr
DefaultFun
PLC.MapData -> Name -> m ()
defineBuiltinInl 'Builtins.mkMap
DefaultFun
PLC.ListData -> Name -> m ()
defineBuiltinInl 'Builtins.mkList
DefaultFun
PLC.IData -> Name -> m ()
defineBuiltinInl 'Builtins.mkI
DefaultFun
PLC.BData -> Name -> m ()
defineBuiltinInl 'Builtins.mkB
DefaultFun
PLC.UnConstrData -> Name -> m ()
defineBuiltinInl 'Builtins.unsafeDataAsConstr
DefaultFun
PLC.UnMapData -> Name -> m ()
defineBuiltinInl 'Builtins.unsafeDataAsMap
DefaultFun
PLC.UnListData -> Name -> m ()
defineBuiltinInl 'Builtins.unsafeDataAsList
DefaultFun
PLC.UnBData -> Name -> m ()
defineBuiltinInl 'Builtins.unsafeDataAsB
DefaultFun
PLC.UnIData -> Name -> m ()
defineBuiltinInl 'Builtins.unsafeDataAsI
DefaultFun
PLC.SerialiseData -> Name -> m ()
defineBuiltinInl 'Builtins.serialiseData
DefaultFun
PLC.CaseData -> Ann -> Name -> PIRTerm DefaultUni DefaultFun -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
Ann -> Name -> PIRTerm uni fun -> m ()
defineBuiltinTerm Ann
annMayInline 'Builtins.caseData' (PIRTerm DefaultUni DefaultFun -> m ())
-> PIRTerm DefaultUni DefaultFun -> m ()
forall a b. (a -> b) -> a -> b
$
(() -> Ann)
-> Term TyName Name DefaultUni DefaultFun ()
-> PIRTerm DefaultUni DefaultFun
forall a b.
(a -> b)
-> Term TyName Name DefaultUni DefaultFun a
-> Term TyName Name DefaultUni DefaultFun b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
annMayInline) (Term TyName Name DefaultUni DefaultFun ()
-> PIRTerm DefaultUni DefaultFun)
-> (Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ())
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> PIRTerm DefaultUni DefaultFun
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quote (Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
forall a. Quote a -> a
runQuote (Quote (Term TyName Name DefaultUni DefaultFun ())
-> PIRTerm DefaultUni DefaultFun)
-> Quote (Term TyName Name DefaultUni DefaultFun ())
-> PIRTerm DefaultUni DefaultFun
forall a b. (a -> b) -> a -> b
$ do
TyName
r <- Text -> QuoteT Identity TyName
forall (m :: * -> *). MonadQuote m => Text -> m TyName
freshTyName Text
"r"
TyName
dead <- Text -> QuoteT Identity TyName
forall (m :: * -> *). MonadQuote m => Text -> m TyName
freshTyName Text
"dead"
Name
fConstr <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"fConstr"
Name
fMap <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"fMap"
Name
fList <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"fList"
Name
fI <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"fI"
Name
fB <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"fB"
Name
d <- Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"d"
let integer :: Type tyname DefaultUni ()
integer = forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
PLC.mkTyBuiltin @_ @Integer ()
listData :: Type tyname DefaultUni ()
listData = forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
PLC.mkTyBuiltin @_ @[PLC.Data] ()
listPairData :: Type tyname DefaultUni ()
listPairData = forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
PLC.mkTyBuiltin @_ @[(PLC.Data, PLC.Data)] ()
bytestring :: Type tyname DefaultUni ()
bytestring = forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
PLC.mkTyBuiltin @_ @BS.ByteString ()
Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a. a -> QuoteT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
(Term TyName Name DefaultUni DefaultFun ()
-> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
r (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs ()
Name
fConstr
(()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyFun () Type TyName DefaultUni ()
forall {tyname}. Type tyname DefaultUni ()
integer (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyFun () Type TyName DefaultUni ()
forall {tyname}. Type tyname DefaultUni ()
listData (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs () Name
fMap (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyFun () Type TyName DefaultUni ()
forall {tyname}. Type tyname DefaultUni ()
listPairData (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs () Name
fList (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyFun () Type TyName DefaultUni ()
forall {tyname}. Type tyname DefaultUni ()
listData (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs () Name
fI (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyFun () Type TyName DefaultUni ()
forall {tyname}. Type tyname DefaultUni ()
integer (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs () Name
fB (()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
PLC.TyFun () Type TyName DefaultUni ()
forall {tyname}. Type tyname DefaultUni ()
bytestring (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Name
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> Type tyname uni ann -> term ann -> term ann
PIR.lamAbs () Name
d (forall a (x :: a) (uni :: * -> *) ann tyname.
HasTypeLevel uni x =>
ann -> Type tyname uni ann
PLC.mkTyBuiltin @_ @PLC.Data ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
PIR.tyInst ()
(Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
PIR.mkIterAppNoAnn
( ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Type TyName DefaultUni ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> Type tyname uni ann -> term ann
PIR.tyInst () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
PIR.builtin () DefaultFun
PLC.ChooseData)
(Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> TyName
-> Kind ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
PLC.TyForall () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r)
[ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
d
, ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ Term TyName Name DefaultUni DefaultFun ()
-> [Term TyName Name DefaultUni DefaultFun ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
PIR.mkIterAppNoAnn
(Term TyName Name DefaultUni DefaultFun ()
-> [Type TyName DefaultUni ()]
-> Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *) tyname name (uni :: * -> *) fun.
TermLike term tyname name uni fun =>
term () -> [Type tyname uni ()] -> term ()
PIR.mkIterInstNoAnn
Term TyName Name DefaultUni DefaultFun ()
forall (term :: * -> *).
TermLike term TyName Name DefaultUni DefaultFun =>
term ()
PLC.uncurry
[Type TyName DefaultUni ()
forall {tyname}. Type tyname DefaultUni ()
integer, Type TyName DefaultUni ()
forall {tyname}. Type tyname DefaultUni ()
listData, () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r])
[ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
fConstr
, ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
PIR.builtin () DefaultFun
PLC.UnConstrData) (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$
() -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
d
]
, ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
fMap)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
PIR.builtin () DefaultFun
PLC.UnMapData)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
d
, ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
fList)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
PIR.builtin () DefaultFun
PLC.UnListData)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
d
, ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
fI)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
PIR.builtin () DefaultFun
PLC.UnIData)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
d
, ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> TyName
-> Kind ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> tyname -> Kind ann -> term ann -> term ann
PIR.tyAbs () TyName
dead (() -> Kind ()
forall ann. ann -> Kind ann
PLC.Type ())
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
fB)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> (Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
-> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> term ann -> term ann
PIR.apply () (() -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> DefaultFun -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> fun -> term ann
PIR.builtin () DefaultFun
PLC.UnBData)
(Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ())
-> Term TyName Name DefaultUni DefaultFun ()
-> Term TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall ann.
ann -> Name -> Term TyName Name DefaultUni DefaultFun ann
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> name -> term ann
PIR.var () Name
d
])
(Type TyName DefaultUni ()
-> Quote (Term TyName Name DefaultUni DefaultFun ()))
-> Type TyName DefaultUni ()
-> Quote (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PLC.TyVar () TyName
r
DefaultFun
PLC.Bls12_381_G1_equal -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G1_equals
DefaultFun
PLC.Bls12_381_G1_add -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G1_add
DefaultFun
PLC.Bls12_381_G1_neg -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G1_neg
DefaultFun
PLC.Bls12_381_G1_scalarMul -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G1_scalarMul
DefaultFun
PLC.Bls12_381_G1_compress -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G1_compress
DefaultFun
PLC.Bls12_381_G1_uncompress -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G1_uncompress
DefaultFun
PLC.Bls12_381_G1_hashToGroup -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G1_hashToGroup
DefaultFun
PLC.Bls12_381_G2_equal -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G2_equals
DefaultFun
PLC.Bls12_381_G2_add -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G2_add
DefaultFun
PLC.Bls12_381_G2_scalarMul -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G2_scalarMul
DefaultFun
PLC.Bls12_381_G2_neg -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G2_neg
DefaultFun
PLC.Bls12_381_G2_compress -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G2_compress
DefaultFun
PLC.Bls12_381_G2_uncompress -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G2_uncompress
DefaultFun
PLC.Bls12_381_G2_hashToGroup -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_G2_hashToGroup
DefaultFun
PLC.Bls12_381_millerLoop -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_millerLoop
DefaultFun
PLC.Bls12_381_mulMlResult -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_mulMlResult
DefaultFun
PLC.Bls12_381_finalVerify -> Name -> m ()
defineBuiltinInl 'Builtins.bls12_381_finalVerify
DefaultFun
PLC.IntegerToByteString -> Name -> m ()
defineBuiltinInl 'Builtins.integerToByteString
DefaultFun
PLC.ByteStringToInteger -> Name -> m ()
defineBuiltinInl 'Builtins.byteStringToInteger
DefaultFun
PLC.AndByteString -> Name -> m ()
defineBuiltinInl 'Builtins.andByteString
DefaultFun
PLC.OrByteString -> Name -> m ()
defineBuiltinInl 'Builtins.orByteString
DefaultFun
PLC.XorByteString -> Name -> m ()
defineBuiltinInl 'Builtins.xorByteString
DefaultFun
PLC.ComplementByteString -> Name -> m ()
defineBuiltinInl 'Builtins.complementByteString
DefaultFun
PLC.ReadBit -> Name -> m ()
defineBuiltinInl 'Builtins.readBit
DefaultFun
PLC.WriteBits -> Name -> m ()
defineBuiltinInl 'Builtins.writeBits
DefaultFun
PLC.ReplicateByte -> Name -> m ()
defineBuiltinInl 'Builtins.replicateByte
DefaultFun
PLC.ShiftByteString -> Name -> m ()
defineBuiltinInl 'Builtins.shiftByteString
DefaultFun
PLC.RotateByteString -> Name -> m ()
defineBuiltinInl 'Builtins.rotateByteString
DefaultFun
PLC.CountSetBits -> Name -> m ()
defineBuiltinInl 'Builtins.countSetBits
DefaultFun
PLC.FindFirstSetBit -> Name -> m ()
defineBuiltinInl 'Builtins.findFirstSetBit
DefaultFun
PLC.ExpModInteger -> Name -> m ()
defineBuiltinInl 'Builtins.expModInteger
defineBuiltinTypes
:: CompilingDefault uni fun m ann
=> m ()
defineBuiltinTypes :: forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
m ()
defineBuiltinTypes = do
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinByteString (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy ByteString -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy ByteString -> Type TyName DefaultUni ())
-> Proxy ByteString -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BS.ByteString
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Integer (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy Integer -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy Integer -> Type TyName DefaultUni ())
-> Proxy Integer -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Integer
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinBool (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy Bool -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy Bool -> Type TyName DefaultUni ())
-> Proxy Bool -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Bool
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinUnit (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy () -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy () -> Type TyName DefaultUni ())
-> Proxy () -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @()
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinString (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy Text -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy Text -> Type TyName DefaultUni ())
-> Proxy Text -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinData (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy Data -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy Data -> Type TyName DefaultUni ())
-> Proxy Data -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @PLC.Data
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinPair (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> SomeTypeIn DefaultUni -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> SomeTypeIn uni -> Type tyname uni ann
PLC.TyBuiltin () (DefaultUni (Esc (,)) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
PLC.SomeTypeIn DefaultUni (Esc (,))
PLC.DefaultUniProtoPair)
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinList (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> SomeTypeIn DefaultUni -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> SomeTypeIn uni -> Type tyname uni ann
PLC.TyBuiltin () (DefaultUni (Esc []) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
PLC.SomeTypeIn DefaultUni (Esc [])
PLC.DefaultUniProtoList)
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinBLS12_381_G1_Element (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy Element -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy Element -> Type TyName DefaultUni ())
-> Proxy Element -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BLS12_381.G1.Element
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinBLS12_381_G2_Element (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy Element -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy Element -> Type TyName DefaultUni ())
-> Proxy Element -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BLS12_381.G2.Element
Name -> PIRType DefaultUni -> m ()
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> PIRType uni -> m ()
defineBuiltinType ''Builtins.BuiltinBLS12_381_MlResult (PIRType DefaultUni -> m ())
-> (Type TyName DefaultUni () -> PIRType DefaultUni)
-> Type TyName DefaultUni ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type TyName DefaultUni () -> Ann -> PIRType DefaultUni
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (Type TyName DefaultUni () -> m ())
-> Type TyName DefaultUni () -> m ()
forall a b. (a -> b) -> a -> b
$ Proxy MlResult -> Type TyName DefaultUni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy MlResult -> Type TyName DefaultUni ())
-> Proxy MlResult -> Type TyName DefaultUni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BLS12_381.Pairing.MlResult
lookupBuiltinTerm :: Compiling uni fun m ann => TH.Name -> m (PIRTerm uni fun)
lookupBuiltinTerm :: forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> m (PIRTerm uni fun)
lookupBuiltinTerm Name
name = do
Name
ghcName <- Name -> m Name
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> m Name
lookupGhcName Name
name
Maybe (PIRTerm uni fun)
maybeTerm <- Ann -> LexName -> m (Maybe (PIRTerm uni fun))
forall key (uni :: * -> *) fun ann (m :: * -> *).
MonadDefs key uni fun ann m =>
ann -> key -> m (Maybe (Term TyName Name uni fun ann))
PIR.lookupTerm Ann
annMayInline (Name -> LexName
LexName Name
ghcName)
case Maybe (PIRTerm uni fun)
maybeTerm of
Just PIRTerm uni fun
t -> PIRTerm uni fun -> m (PIRTerm uni fun)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PIRTerm uni fun
t
Maybe (PIRTerm uni fun)
Nothing -> (Text -> Error uni fun ann) -> SDoc -> m (PIRTerm uni fun)
forall (uni :: * -> *) fun ann (m :: * -> *) a.
(MonadError (CompileError uni fun ann) m,
MonadReader (CompileContext uni fun) m) =>
(Text -> Error uni fun ann) -> SDoc -> m a
throwSd Text -> Error uni fun ann
forall (uni :: * -> *) fun a. Text -> Error uni fun a
CompilationError (SDoc -> m (PIRTerm uni fun)) -> SDoc -> m (PIRTerm uni fun)
forall a b. (a -> b) -> a -> b
$ SDoc
"Missing builtin definition:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
GHC.<+> (String -> SDoc
forall doc. IsLine doc => String -> doc
GHC.text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
name)
lookupBuiltinType :: Compiling uni fun m ann => TH.Name -> m (PIRType uni)
lookupBuiltinType :: forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> m (PIRType uni)
lookupBuiltinType Name
name = do
Name
ghcName <- Name -> m Name
forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
Name -> m Name
lookupGhcName Name
name
Maybe (PIRType uni)
maybeType <- Ann -> LexName -> m (Maybe (PIRType uni))
forall key (uni :: * -> *) fun ann (m :: * -> *).
MonadDefs key uni fun ann m =>
ann -> key -> m (Maybe (Type TyName uni ann))
PIR.lookupType Ann
annMayInline (Name -> LexName
LexName Name
ghcName)
case Maybe (PIRType uni)
maybeType of
Just PIRType uni
t -> PIRType uni -> m (PIRType uni)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PIRType uni
t
Maybe (PIRType uni)
Nothing -> (Text -> Error uni fun ann) -> SDoc -> m (PIRType uni)
forall (uni :: * -> *) fun ann (m :: * -> *) a.
(MonadError (CompileError uni fun ann) m,
MonadReader (CompileContext uni fun) m) =>
(Text -> Error uni fun ann) -> SDoc -> m a
throwSd Text -> Error uni fun ann
forall (uni :: * -> *) fun a. Text -> Error uni fun a
CompilationError (SDoc -> m (PIRType uni)) -> SDoc -> m (PIRType uni)
forall a b. (a -> b) -> a -> b
$ SDoc
"Missing builtin definition:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
GHC.<+> (String -> SDoc
forall doc. IsLine doc => String -> doc
GHC.text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
name)
errorFunc :: Compiling uni fun m ann => m (PIRTerm uni fun)
errorFunc :: forall (uni :: * -> *) fun (m :: * -> *) ann.
Compiling uni fun m ann =>
m (PIRTerm uni fun)
errorFunc = do
TyName
n <- Text -> m TyName
forall (m :: * -> *). MonadQuote m => Text -> m TyName
safeFreshTyName Text
"e"
PIRTerm uni fun -> m (PIRTerm uni fun)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PIRTerm uni fun -> m (PIRTerm uni fun))
-> PIRTerm uni fun -> m (PIRTerm uni fun)
forall a b. (a -> b) -> a -> b
$ Ann -> TyName -> Kind Ann -> PIRTerm uni fun -> PIRTerm uni fun
forall tyname name (uni :: * -> *) fun a.
a
-> tyname
-> Kind a
-> Term tyname name uni fun a
-> Term tyname name uni fun a
PIR.TyAbs Ann
annMayInline TyName
n (Ann -> Kind Ann
forall ann. ann -> Kind ann
PIR.Type Ann
annMayInline) (Ann -> Type TyName uni Ann -> PIRTerm uni fun
forall tyname name (uni :: * -> *) fun a.
a -> Type tyname uni a -> Term tyname name uni fun a
PIR.Error Ann
annMayInline (Ann -> TyName -> Type TyName uni Ann
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PIR.TyVar Ann
annMayInline TyName
n))
delayedErrorFunc :: CompilingDefault uni fun m ann => m (PIRTerm uni fun)
delayedErrorFunc :: forall (uni :: * -> *) fun (m :: * -> *) ann.
CompilingDefault uni fun m ann =>
m (PIRTerm uni fun)
delayedErrorFunc = do
TyName
n <- Text -> m TyName
forall (m :: * -> *). MonadQuote m => Text -> m TyName
safeFreshTyName Text
"a"
Name
t <- QuoteT Identity Name -> m Name
forall a. Quote a -> m a
forall (m :: * -> *) a. MonadQuote m => Quote a -> m a
liftQuote (Text -> QuoteT Identity Name
forall (m :: * -> *). MonadQuote m => Text -> m Name
freshName Text
"thunk")
let ty :: Type TyName uni ()
ty = Proxy () -> Type TyName uni ()
forall a tyname (uni :: * -> *) (x :: a) (proxy :: a -> *).
KnownTypeAst tyname uni x =>
proxy x -> Type tyname uni ()
PLC.toTypeAst (Proxy () -> Type TyName uni ()) -> Proxy () -> Type TyName uni ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @()
PIRTerm uni fun -> m (PIRTerm uni fun)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PIRTerm uni fun -> m (PIRTerm uni fun))
-> PIRTerm uni fun -> m (PIRTerm uni fun)
forall a b. (a -> b) -> a -> b
$ Ann -> TyName -> Kind Ann -> PIRTerm uni fun -> PIRTerm uni fun
forall tyname name (uni :: * -> *) fun a.
a
-> tyname
-> Kind a
-> Term tyname name uni fun a
-> Term tyname name uni fun a
PIR.TyAbs Ann
annMayInline TyName
n (Ann -> Kind Ann
forall ann. ann -> Kind ann
PIR.Type Ann
annMayInline) (PIRTerm uni fun -> PIRTerm uni fun)
-> PIRTerm uni fun -> PIRTerm uni fun
forall a b. (a -> b) -> a -> b
$
Ann
-> Name
-> Type TyName uni Ann
-> PIRTerm uni fun
-> PIRTerm uni fun
forall tyname name (uni :: * -> *) fun a.
a
-> name
-> Type tyname uni a
-> Term tyname name uni fun a
-> Term tyname name uni fun a
PIR.LamAbs Ann
annMayInline Name
t (Type TyName uni ()
ty Type TyName uni () -> Ann -> Type TyName uni Ann
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Ann
annMayInline) (PIRTerm uni fun -> PIRTerm uni fun)
-> PIRTerm uni fun -> PIRTerm uni fun
forall a b. (a -> b) -> a -> b
$ Ann -> Type TyName uni Ann -> PIRTerm uni fun
forall tyname name (uni :: * -> *) fun a.
a -> Type tyname uni a -> Term tyname name uni fun a
PIR.Error Ann
annMayInline (Ann -> TyName -> Type TyName uni Ann
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
PIR.TyVar Ann
annMayInline TyName
n)