Builtin Pattern Matching

cardano-constitution/test/Cardano/Constitution/Validator/Data/TestsCommon.hs

@@ -60,19 +60,25 @@ Doing (ioProperty . isRight . tryApplyEval) is probably redundant here, since QC
 allVldtrsPassed vs ctx = conjoin $ fmap (B.fromOpaque . (`applyOnData` ctx)) vs
 
 unsafeRunCekRes
-  :: t ~ Term NamedDeBruijn DefaultUni DefaultFun ()
+  :: t ~ Term NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
   => t -> t
 unsafeRunCekRes = unsafeFromRight . runCekRes
 
 runCekRes
-  :: t ~ Term NamedDeBruijn DefaultUni DefaultFun ()
-  => t -> Either (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) t
+  :: t ~ Term NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
+  => t
+  -> Either
+       (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern)
+       t
 runCekRes t =
   UPLC.cekResultToEither . UPLC._cekReportResult $
     UPLC.runCekDeBruijn defaultCekParametersForTesting restrictingEnormous noEmitter t
 
 liftCode110 :: Lift DefaultUni a => a -> CompiledCode a
 liftCode110 = liftCode plcVersion110
 
-liftCode110Norm :: Lift DefaultUni a => a -> Term NamedDeBruijn DefaultUni DefaultFun ()
+liftCode110Norm
+  :: Lift DefaultUni a
+  => a
+  -> Term NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 liftCode110Norm = unsafeRunCekRes . _progTerm . getPlcNoAnn . liftCode110

cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs

@@ -60,19 +60,25 @@ Doing (ioProperty . isRight . tryApplyEval) is probably redundant here, since QC
 allVldtrsPassed vs ctx = conjoin $ fmap (B.fromOpaque . (`applyOnData` ctx)) vs
 
 unsafeRunCekRes
-  :: t ~ Term NamedDeBruijn DefaultUni DefaultFun ()
+  :: t ~ Term NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
   => t -> t
 unsafeRunCekRes = unsafeFromRight . runCekRes
 
 runCekRes
-  :: t ~ Term NamedDeBruijn DefaultUni DefaultFun ()
-  => t -> Either (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun) t
+  :: t ~ Term NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
+  => t
+  -> Either
+       (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern)
+       t
 runCekRes t =
   UPLC.cekResultToEither . UPLC._cekReportResult $
     UPLC.runCekDeBruijn defaultCekParametersForTesting restrictingEnormous noEmitter t
 
 liftCode110 :: Lift DefaultUni a => a -> CompiledCode a
 liftCode110 = liftCode plcVersion110
 
-liftCode110Norm :: Lift DefaultUni a => a -> Term NamedDeBruijn DefaultUni DefaultFun ()
+liftCode110Norm
+  :: Lift DefaultUni a
+  => a
+  -> Term NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 liftCode110Norm = unsafeRunCekRes . _progTerm . getPlcNoAnn . liftCode110

plutus-benchmark/agda-common/PlutusBenchmark/Agda/Common.hs

@@ -5,7 +5,7 @@ module PlutusBenchmark.Agda.Common
 where
 
 import PlutusCore qualified as PLC
-import PlutusCore.Default (DefaultFun, DefaultUni)
+import PlutusCore.Default (DefaultBuiltinPattern, DefaultFun, DefaultUni)
 import UntypedPlutusCore qualified as UPLC
 
 import MAlonzo.Code.Evaluator.Term (runUAgda)
@@ -14,8 +14,8 @@ import Criterion.Main (Benchmarkable, nf)
 
 -- This code is in its own file so that we only build the metatheory when we really need it.
 
-type Term = UPLC.Term PLC.NamedDeBruijn DefaultUni DefaultFun ()
-type Program = UPLC.Program PLC.NamedDeBruijn DefaultUni DefaultFun ()
+type Term = UPLC.Term PLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
+type Program = UPLC.Program PLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 
 ---------------- Run a term or program using the plutus-metatheory CEK evaluator ----------------
 

plutus-benchmark/bls12-381-costs/src/PlutusBenchmark/BLS12_381/Scripts.hs

@@ -43,7 +43,7 @@ module PlutusBenchmark.BLS12_381.Scripts
 where
 
 import Plinth.Plugin ()
-import PlutusCore (DefaultFun, DefaultUni)
+import PlutusCore (DefaultBuiltinPattern, DefaultFun, DefaultUni)
 import PlutusLedgerApi.V1.Bytes qualified as P (bytes, fromHex)
 import PlutusTx qualified as Tx
 import PlutusTx.List qualified as List
@@ -102,7 +102,9 @@ hashAndAddG1 l =
     go (q : qs) !acc = go qs $ Tx.bls12_381_G1_add (Tx.bls12_381_G1_hashToGroup q emptyByteString) acc
 {-# INLINEABLE hashAndAddG1 #-}
 
-mkHashAndAddG1Script :: [ByteString] -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkHashAndAddG1Script
+  :: [ByteString]
+  -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkHashAndAddG1Script l =
   let points = List.map toBuiltin l
    in Tx.getPlcNoAnn $ $$(Tx.compile [||hashAndAddG1||]) `Tx.unsafeApplyCode` Tx.liftCodeDef points
@@ -116,7 +118,9 @@ hashAndAddG2 l =
     go (q : qs) !acc = go qs $ Tx.bls12_381_G2_add (Tx.bls12_381_G2_hashToGroup q emptyByteString) acc
 {-# INLINEABLE hashAndAddG2 #-}
 
-mkHashAndAddG2Script :: [ByteString] -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkHashAndAddG2Script
+  :: [ByteString]
+  -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkHashAndAddG2Script l =
   let points = List.map toBuiltin l
    in Tx.getPlcNoAnn $ $$(Tx.compile [||hashAndAddG2||]) `Tx.unsafeApplyCode` Tx.liftCodeDef points
@@ -131,7 +135,8 @@ uncompressAndAddG1 l =
 {-# INLINEABLE uncompressAndAddG1 #-}
 
 mkUncompressAndAddG1Script
-  :: [ByteString] -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+  :: [ByteString]
+  -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkUncompressAndAddG1Script l =
   let ramdomPoint bs = Tx.bls12_381_G1_hashToGroup bs emptyByteString
       points = List.map (Tx.bls12_381_G1_compress . ramdomPoint . toBuiltin) l
@@ -147,7 +152,8 @@ uncompressAndAddG2 l =
 {-# INLINEABLE uncompressAndAddG2 #-}
 
 mkUncompressAndAddG2Script
-  :: [ByteString] -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+  :: [ByteString]
+  -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkUncompressAndAddG2Script l =
   let ramdomPoint bs = Tx.bls12_381_G2_hashToGroup bs emptyByteString
       points = List.map (Tx.bls12_381_G2_compress . ramdomPoint . toBuiltin) l
@@ -174,7 +180,7 @@ mkPairingScript
   -> BuiltinBLS12_381_G2_Element
   -> BuiltinBLS12_381_G1_Element
   -> BuiltinBLS12_381_G2_Element
-  -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+  -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkPairingScript p1 q1 p2 q2 =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||runPairingFunctions||])
@@ -313,7 +319,8 @@ groth16Verify
 {-| Make a UPLC script applying groth16Verify to the inputs.  Passing the
  newtype inputs increases the size and CPU cost slightly, so we unwrap them
  first.  This should return `True`. -}
-mkGroth16VerifyScript :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkGroth16VerifyScript
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkGroth16VerifyScript =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||groth16Verify||])
@@ -374,7 +381,8 @@ verifyBlsSimpleScript privKey message =
 checkVerifyBlsSimpleScript :: Bool
 checkVerifyBlsSimpleScript = verifyBlsSimpleScript simpleVerifyPrivKey simpleVerifyMessage
 
-mkVerifyBlsSimplePolicy :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkVerifyBlsSimplePolicy
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkVerifyBlsSimplePolicy =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||verifyBlsSimpleScript||])
@@ -498,7 +506,8 @@ checkVrfBlsScript =
       pk = Tx.bls12_381_G2_compress $ Tx.bls12_381_G2_scalarMul vrfPrivKey g2generator
    in vrfBlsScript vrfMessage pk (generateVrfProof vrfPrivKey vrfMessage)
 
-mkVrfBlsPolicy :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkVrfBlsPolicy
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkVrfBlsPolicy =
   let g2generator = Tx.bls12_381_G2_uncompress Tx.bls12_381_G2_compressed_generator
    in Tx.getPlcNoAnn
@@ -557,7 +566,8 @@ checkG1VerifyScript :: Bool
 checkG1VerifyScript =
   g1VerifyScript g1VerifyMessage g1VerifyPubKey g1VerifySignature blsSigBls12381G2XmdSha256SswuRoNul
 
-mkG1VerifyPolicy :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkG1VerifyPolicy
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkG1VerifyPolicy =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||g1VerifyScript||])
@@ -616,7 +626,8 @@ checkG2VerifyScript :: Bool
 checkG2VerifyScript =
   g2VerifyScript g2VerifyMessage g2VerifyPubKey g2VerifySignature blsSigBls12381G2XmdSha256SswuRoNul
 
-mkG2VerifyPolicy :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkG2VerifyPolicy
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkG2VerifyPolicy =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||g2VerifyScript||])
@@ -702,7 +713,8 @@ checkAggregateSingleKeyG1Script =
     aggregateSingleKeyG1Signature
     blsSigBls12381G2XmdSha256SswuRoNul
 
-mkAggregateSingleKeyG1Policy :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkAggregateSingleKeyG1Policy
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkAggregateSingleKeyG1Policy =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||aggregateSingleKeyG1Script||])
@@ -872,7 +884,8 @@ checkAggregateMultiKeyG2Script =
     byteString16Null
     blsSigBls12381G2XmdSha256SswuRoNul
 
-mkAggregateMultiKeyG2Policy :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkAggregateMultiKeyG2Policy
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkAggregateMultiKeyG2Policy =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||aggregateMultiKeyG2Script||])
@@ -952,7 +965,8 @@ checkSchnorrG1VerifyScript =
     schnorrG1VerifySignature
     byteString16Null
 
-mkSchnorrG1VerifyPolicy :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkSchnorrG1VerifyPolicy
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkSchnorrG1VerifyPolicy =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||schnorrG1VerifyScript||])
@@ -1034,7 +1048,8 @@ checkSchnorrG2VerifyScript =
     schnorrG2VerifySignature
     byteString16Null
 
-mkSchnorrG2VerifyPolicy :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+mkSchnorrG2VerifyPolicy
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkSchnorrG2VerifyPolicy =
   Tx.getPlcNoAnn
     $ $$(Tx.compile [||schnorrG2VerifyScript||])

plutus-benchmark/casing/src/PlutusBenchmark/Casing.hs

@@ -14,8 +14,8 @@ import PlutusCore.MkPlc
 import UntypedPlutusCore qualified as UPLC
 
 debruijnTermUnsafe
-  :: UPLC.Term UPLC.Name uni fun ann
-  -> UPLC.Term UPLC.NamedDeBruijn uni fun ann
+  :: UPLC.Term UPLC.Name uni fun pat ann
+  -> UPLC.Term UPLC.NamedDeBruijn uni fun pat ann
 debruijnTermUnsafe =
   fromRight (Prelude.error "debruijnTermUnsafe")
     . runExcept @UPLC.FreeVariableError

plutus-benchmark/cek-calibration/Main.hs

@@ -31,7 +31,7 @@ import Control.Monad.Except
 import Criterion.Main
 import Criterion.Types qualified as C
 
-type PlainTerm = UPLC.Term Name DefaultUni DefaultFun ()
+type PlainTerm = UPLC.Term Name DefaultUni DefaultFun DefaultBuiltinPattern ()
 
 rev :: [()] -> [()]
 rev l0 = rev' l0 []
@@ -62,10 +62,14 @@ go :: Integer -> [()]
 go n = zipl (mkList n) (rev $ mkList n)
 {-# INLINEABLE go #-}
 
-mkListProg :: Integer -> UPLC.Program NamedDeBruijn DefaultUni DefaultFun ()
+mkListProg
+  :: Integer
+  -> UPLC.Program NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkListProg n = Tx.getPlcNoAnn $ $$(Tx.compile [||go||]) `Tx.unsafeApplyCode` Tx.liftCodeDef n
 
-mkListTerm :: Integer -> UPLC.Term NamedDeBruijn DefaultUni DefaultFun ()
+mkListTerm
+  :: Integer
+  -> UPLC.Term NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
 mkListTerm n =
   let (UPLC.Program _ _ code) = mkListProg n
    in code
@@ -76,7 +80,9 @@ mkListBM ctx n = bench (Haskell.show n) $ benchTermCek ctx (mkListTerm n)
 mkListBMs :: EvaluationContext -> [Integer] -> Benchmark
 mkListBMs ctx ns = bgroup "List" [mkListBM ctx n | n <- ns]
 
-writePlc :: UPLC.Program NamedDeBruijn DefaultUni DefaultFun () -> Haskell.IO ()
+writePlc
+  :: UPLC.Program NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
+  -> Haskell.IO ()
 writePlc p =
   case runExcept @UPLC.FreeVariableError
     $ runQuoteT

plutus-benchmark/certifier/src/Certifier/Common.hs

@@ -35,10 +35,10 @@ loadFrom name = do
   pure . runQuote $ mkFfiOptimizerTrace . snd <$> simplify term
 
 simplify
-  :: Term Name DefaultUni DefaultFun ()
+  :: Term Name DefaultUni DefaultFun DefaultBuiltinPattern ()
   -> Quote
-       ( Term Name DefaultUni DefaultFun ()
-       , OptimizerTrace Name DefaultUni DefaultFun ()
+       ( Term Name DefaultUni DefaultFun DefaultBuiltinPattern ()
+       , OptimizerTrace Name DefaultUni DefaultFun DefaultBuiltinPattern ()
        )
 simplify =
   runOptimizerT

plutus-benchmark/common/PlutusBenchmark/Common.hs

@@ -85,7 +85,9 @@ getConfig limit = do
       }
 
 -- | Evaluate a script and return the CPU and memory costs (according to the cost model)
-getCostsCek :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun () -> (Integer, Integer)
+getCostsCek
+  :: UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
+  -> (Integer, Integer)
 getCostsCek (UPLC.Program _ _ prog) =
   case Cek.runCekDeBruijn PLC.defaultCekParametersForTesting Cek.tallying Cek.noEmitter prog of
     Cek.CekReport _res (Cek.TallyingSt _ budget) _logs ->
@@ -107,7 +109,8 @@ mkEvalCtx ll semvar =
       let errOrCtx =
             LedgerApi.mkDynEvaluationContext
               ll
-              (\_ -> PLC.CaserBuiltin PLC.caseBuiltin)
+              (\_ -> PLC.availableCaserBuiltin)
+              (PLC.unavailableMatcherBuiltin . LedgerApi.getMajorProtocolVersion)
               [semvar]
               (const semvar)
               p
@@ -124,10 +127,26 @@ mkMostRecentEvalCtx = mkEvalCtx maxBound maxBound
 -- | Evaluate a term as it would be evaluated using the on-chain evaluator.
 evaluateCekLikeInProd
   :: LedgerApi.EvaluationContext
-  -> UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()
+  -> UPLC.Term
+       PLC.NamedDeBruijn
+       PLC.DefaultUni
+       PLC.DefaultFun
+       PLC.DefaultBuiltinPattern
+       ()
   -> Either
-       (UPLC.CekEvaluationException UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun)
-       (UPLC.Term UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun ())
+       ( UPLC.CekEvaluationException
+           UPLC.NamedDeBruijn
+           UPLC.DefaultUni
+           UPLC.DefaultFun
+           UPLC.DefaultBuiltinPattern
+       )
+       ( UPLC.Term
+           UPLC.NamedDeBruijn
+           UPLC.DefaultUni
+           UPLC.DefaultFun
+           PLC.DefaultBuiltinPattern
+           ()
+       )
 evaluateCekLikeInProd evalCtx term =
   let
     -- The validation benchmarks were all created from PlutusV1 scripts
@@ -140,7 +159,12 @@ evaluateCekLikeInProd evalCtx term =
 Useful for benchmarking. -}
 evaluateCekForBench
   :: LedgerApi.EvaluationContext
-  -> UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()
+  -> UPLC.Term
+       PLC.NamedDeBruijn
+       PLC.DefaultUni
+       PLC.DefaultFun
+       PLC.DefaultBuiltinPattern
+       ()
   -> ()
 evaluateCekForBench evalCtx = either (error . show) (\_ -> ()) . evaluateCekLikeInProd evalCtx
 
@@ -187,7 +211,7 @@ protocol parameters. -}
 printSizeStatistics
   :: Handle
   -> TestSize
-  -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun ()
+  -> UPLC.Program UPLC.NamedDeBruijn DefaultUni DefaultFun DefaultBuiltinPattern ()
   -> IO ()
 printSizeStatistics h n script = do
   let serialised = Flat.flat (UPLC.UnrestrictedProgram $ toAnonDeBruijnProg script)

plutus-benchmark/coop/exe/Main.hs

@@ -51,6 +51,7 @@ createIfNotExists name term = do
                      UPLC.NamedDeBruijn
                      UPLC.DefaultUni
                      UPLC.DefaultFun
+                     UPLC.DefaultBuiltinPattern
                      SrcSpans
                  )
                 bs

plutus-benchmark/data/src/PlutusBenchmark/Data.hs

@@ -15,8 +15,13 @@ import PlutusCore.MkPlc
 import UntypedPlutusCore qualified as UPLC
 
 debruijnTermUnsafe
-  :: UPLC.Term UPLC.Name UPLC.DefaultUni UPLC.DefaultFun ann
-  -> UPLC.Term UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun ann
+  :: UPLC.Term UPLC.Name UPLC.DefaultUni UPLC.DefaultFun PLC.DefaultBuiltinPattern ann
+  -> UPLC.Term
+       UPLC.NamedDeBruijn
+       UPLC.DefaultUni
+       UPLC.DefaultFun
+       PLC.DefaultBuiltinPattern
+       ann
 debruijnTermUnsafe =
   fromRight (Prelude.error "debruijnTermUnsafe")
     . runExcept @UPLC.FreeVariableError