diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 000000000..af4fe8b58 --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +flake.lock linguist-generated=true diff --git a/.gitignore b/.gitignore index 6bd616d62..98e8047a0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ /result* -/dist-newstyle +/dist-* .direnv -bench.csv \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md index 0f1e1e9d0..5fedddf5a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,37 @@ # Revision history for plutarch -# Unreleased +# 1.2 (WIP changelog) + +- Changed fields of `PTxInfo` whose only representation is data to not be wrapped by `PAsData`. + + Module: `Plutarch.Api.V1.Contexts`; `Plutarch.Api.V2.Contexts` + +- Added `plistData` builtin function wrapper. + + Module: `Plutarch.Builtin` + +- Added `PEq` superclass constraint to `POrd` + + Included by [#326](https://github.com/Plutonomicon/plutarch/pull/326) + +- Added module `Plutarch.Show` with the `PShow` type class, as well as functions `pshow` and `ptraceShowId`. + + Started by [#352](https://github.com/Plutonomicon/plutarch/pull/352) + +- Add `puncons` and `ptryUncons` functions for deconstructing list. + + Started by: [#333](https://github.com/Plutonomicon/plutarch/pull/333) + +- Add generic deriving for `PEq` + + Started by [#335](https://github.com/Plutonomicon/plutarch/pull/335) +- `Plutarch.Prelude` and `Plutarch.List` now export pfind, pelemAt, preverse and pcheckSroted. + + Started by: [#306](https://github.com/Plutonomicon/plutarch/pull/306) + +- Added module `Plutarch.FFI` for interoperability with PlutusTx. + +- Added `DerivePConstantViaBuiltin`, deprecating `DerivePConstantViaNewtype`. - `TermCont`: Parametrize by result type; add `MonadFail` instance; etc. @@ -41,7 +72,7 @@ - Added APIs for constructing, compiling, serialising & hashing Plutarch scripts. Type synonyms for Plutarch-typed scripts `PValidator`,`PMintingPolicy` & `PStakeValidator`. - + `mkValidator`, `mkStakeValidator` & `mkMintingPolicy` functions, for creating Plutus API compatible scripts. `validatorHash`, `mintingPolicySymbol` & `stakeValidatorHash` to obtain script hashes. @@ -71,6 +102,81 @@ Added by: [#235](https://github.com/Plutonomicon/plutarch/pull/270) +- Add `Plutarch.Test` for testing Plutarch code with goldens for UPLC printing and Plutus benchmarks. + +- Add Conversion types `PTryFrom`, `PMaybeFrom` and `PFrom` + + Module: `Plutarch.TryFrom` + + Added by: [#326](https://github.com/Plutonomicon/plutarch/pull/326) + +- `plutarch-extra`: Add a new directory scaffold "`plutarch-extra`" which will be home to everything too specific to not be in the + main Plutarch repo. Also refactored the test library. + + Directory: `plutarch-extra` + + Added by: [#329](https://github.com/Plutonomicon/plutarch/pull/329) + +- `plutarch-extra` export merged Prelude + + Module: `Plutarch.PPrelude` + + Added by: [#356](https://github.com/Plutonomicon/plutarch/pull/356) + +- Add `PConstant` instance for `Maybe`, with corresponding `PLift` instance for `PMaybeData`. + + Added by: [#371](https://github.com/Plutonomicon/plutarch/pull/371) + +- Add `POrd` and `PEq` derivation for data encoded types via `PIsDataReprInstances`. + + Added by: [#371](https://github.com/Plutonomicon/plutarch/pull/371) + +- Make `PRational` construction machinery fail when the denominator is 0. + + Fixed by: [#299](https://github.com/Plutonomicon/plutarch/pull/299) + +- Rename `PConstant` (the typeclass) to `PConstantDecl`. `PConstant` is now a type alias with extra constraints for better type checking. + + Add `PLiftData` and `PConstantData` type aliases. + + Added by: [#354](https://github.com/Plutonomicon/plutarch/pull/354) + +- Remove `hrecField` export. Use `getField` instead. + + Removed by: [#415](https://github.com/Plutonomicon/plutarch/pull/415) + +- Rename the `"data"` field of `PTxInfo` to `"datums"`. + + Renamed by: [#415](https://github.com/Plutonomicon/plutarch/pull/415) + +- Add `Num` instance for `PPOSIXTime` and export its constructor. + + Added by: [#415](https://github.com/Plutonomicon/plutarch/pull/415) + +- `PlutusType` is now a superclass of `PIsDataRepr`, strengthening the existing `PMatch` superclass constraint. + + Added by: [#415](https://github.com/Plutonomicon/plutarch/pull/415) + +- Add `PlutusType` instance for `PDataSum`. `PDataSum` can now be hand-constructed. + + Added by: [#345](https://github.com/Plutonomicon/plutarch/pull/345) + +- Add `HRecOf`, `PMemberFields`, and `PMemberField` utility types. + + Module: `Plutarch.DataRepr`. + + Added by: [#466](https://github.com/Plutonomicon/plutarch/pull/466) + +- Move `Plutarch.ListUtils` to `Plutarch.Extra.List`. + + Added by: [#466](https://github.com/Plutonomicon/plutarch/pull/466) + +- Add various `TermCont` utilities: `ptraceC`, `pletFieldsC`, `ptryFromC`, `pguardC`, and `pguardC'`. + + Module: `Plutarch.Extra.TermCont`. + + Added by: [#466](https://github.com/Plutonomicon/plutarch/pull/466) + # 1.1.0 - General repository changes. diff --git a/Plutarch.hs b/Plutarch.hs index 1e8987687..0147efcfe 100644 --- a/Plutarch.hs +++ b/Plutarch.hs @@ -1,40 +1,70 @@ module Plutarch ( - (:-->), - ClosedTerm, - compile, - Dig, - hashTerm, - papp, - pdelay, - PDelayed, - perror, - pforce, - phoistAcyclic, - plam', - plet, - Term, - S, - PType, - PlutusType (..), - printTerm, - printScript, - (#$), - (#), - pinl, - PCon (..), - PMatch (..), - pto, - pfix, - POpaque (..), - popaque, - plam, - DerivePNewtype (DerivePNewtype), + (PI.:-->), + PI.ClosedTerm, + PI.compile, + PI.Dig, + PI.hashTerm, + PI.papp, + PI.pdelay, + PI.PDelayed, + PI.perror, + PI.pforce, + PI.phoistAcyclic, + PI.plet, + PI.pthrow, + PI.Term, + PI.S, + PI.PType, + PP.PlutusType, + PP.PInner, + PP.pcon, + PP.pmatch, + PP.PCon, + PP.PMatch, + PPR.prettyTerm, + PPR.prettyScript, + PO.printTerm, + PO.printScript, + (PL.#$), + (PL.#), + PL.pinl, + PO.pto, + PO.pfix, + PO.POpaque (PO.POpaque), + PO.popaque, + PL.plam, PT.TermCont (TermCont), PT.hashOpenTerm, PT.runTermCont, PT.unTermCont, + PI.Config (Config, tracingMode), + PI.TracingMode (NoTracing, DoTracing, DetTracing), + PI.pgetConfig, + PQ.PForall (PForall), + PQ.PSome (PSome), + PS.PScottEncoded (PScottEncoded), + PS.PlutusTypeScott, + PN.PlutusTypeNewtype, + PP.DerivePlutusType, + PP.DPTStrat, + PP.PCovariant, + PP.PCovariant', + PP.PContravariant, + PP.PContravariant', + PP.PVariant, + PP.PVariant', ) where -import Plutarch.Internal.Other +import qualified Plutarch.Internal as PI +import qualified Plutarch.Internal.Newtype as PN +import qualified Plutarch.Internal.Other as PO +import qualified Plutarch.Internal.PLam as PL +import qualified Plutarch.Internal.PlutusType as PP +import qualified Plutarch.Internal.Quantification as PQ +import qualified Plutarch.Internal.ScottEncoding as PS +import Plutarch.Num () +import qualified Plutarch.Pretty as PPR import qualified Plutarch.TermCont as PT + +-- import orphan instances import Prelude () diff --git a/Plutarch/Api/Internal/Hashing.hs b/Plutarch/Api/Internal/Hashing.hs new file mode 100644 index 000000000..d23b7168c --- /dev/null +++ b/Plutarch/Api/Internal/Hashing.hs @@ -0,0 +1,44 @@ +module Plutarch.Api.Internal.Hashing ( + hashScriptWithPrefix, + hashData, + hashLedgerBytes, +) where + +import Codec.Serialise (serialise) +import Crypto.Hash (hashWith) +import Crypto.Hash.Algorithms ( + Blake2b_224 (Blake2b_224), + Blake2b_256 (Blake2b_256), + HashAlgorithm, + ) +import Data.ByteArray (convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as Lazy + +import qualified PlutusLedgerApi.V1 as Plutus +import qualified PlutusLedgerApi.V1.Scripts as Plutus +import qualified PlutusTx.Builtins as PlutusTx + +_plutusHashWith :: HashAlgorithm alg => alg -> ByteString -> PlutusTx.BuiltinByteString +_plutusHashWith alg = PlutusTx.toBuiltin . convert @_ @ByteString . hashWith alg + +hashBlake2b_224 :: ByteString -> PlutusTx.BuiltinByteString +hashBlake2b_224 = _plutusHashWith Blake2b_224 + +hashBlake2b_256 :: ByteString -> PlutusTx.BuiltinByteString +hashBlake2b_256 = _plutusHashWith Blake2b_256 + +-- | Hash a Script with the given version prefix +hashScriptWithPrefix :: ByteString -> Plutus.Script -> Plutus.ScriptHash +hashScriptWithPrefix prefix scr = + Plutus.ScriptHash + . hashBlake2b_224 + $ prefix <> Lazy.toStrict (serialise scr) + +-- | Hash Plutus 'Data'. +hashData :: Plutus.Data -> PlutusTx.BuiltinByteString +hashData = hashBlake2b_256 . Lazy.toStrict . serialise + +-- | Hash 'LedgerBytes'. +hashLedgerBytes :: Plutus.LedgerBytes -> PlutusTx.BuiltinByteString +hashLedgerBytes = hashBlake2b_224 . Plutus.fromBuiltin . Plutus.getLedgerBytes diff --git a/Plutarch/Api/Internal/Scripts.hs b/Plutarch/Api/Internal/Scripts.hs deleted file mode 100644 index 5f7d45c4c..000000000 --- a/Plutarch/Api/Internal/Scripts.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Plutarch.Api.Internal.Scripts ( - hashScriptWithPrefix, -) where - -import Codec.Serialise (serialise) -import Crypto.Hash (hashWith) -import Crypto.Hash.Algorithms ( - Blake2b_224 (Blake2b_224), - ) -import Data.ByteArray (convert) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Lazy as Lazy - -import qualified Plutus.V1.Ledger.Scripts as Plutus -import qualified PlutusTx.Builtins as PlutusTx - --- | Hash a Script with the given version prefix -hashScriptWithPrefix :: ByteString -> Plutus.Script -> Plutus.ScriptHash -hashScriptWithPrefix prefix scr = - Plutus.ScriptHash $ - PlutusTx.toBuiltin $ - convert @_ @ByteString $ - hashWith Blake2b_224 $ - prefix <> (Lazy.toStrict $ serialise scr) diff --git a/Plutarch/Api/V1.hs b/Plutarch/Api/V1.hs index d6328108b..32a21c8a6 100644 --- a/Plutarch/Api/V1.hs +++ b/Plutarch/Api/V1.hs @@ -17,6 +17,9 @@ module Plutarch.Api.V1 ( mintingPolicySymbol, stakeValidatorHash, scriptHash, + datumHash, + redeemerHash, + dataHash, mkValidator, mkStakeValidator, mkMintingPolicy, @@ -28,11 +31,12 @@ module Plutarch.Api.V1 ( Value.PValue (PValue), Value.PCurrencySymbol (PCurrencySymbol), Value.PTokenName (PTokenName), + Value.KeyGuarantees (Unsorted, Sorted), + Value.AmountGuarantees (NoGuarantees, NonZero, Positive), -- ** Crypto Crypto.PPubKeyHash (PPubKeyHash), - Crypto.PPubKey (PPubKey), - Crypto.PSignature (PSignature), + Crypto.pubKeyHash, -- ** DCert DCert.PDCert ( @@ -95,14 +99,18 @@ import qualified Plutarch.Api.V1.Value as Value import Data.Coerce (coerce) -import qualified Plutus.V1.Ledger.Api as Plutus -import qualified Plutus.V1.Ledger.Scripts as Plutus +-- note about V2: This should there are no changes in Scripts or V1 itself that affect this module +import qualified PlutusLedgerApi.V1 as Plutus +import qualified PlutusLedgerApi.V1.Scripts as Plutus -import Plutarch (ClosedTerm, POpaque, compile) -import Plutarch.Api.Internal.Scripts (hashScriptWithPrefix) +import Plutarch (Config, compile) +import Plutarch.Api.Internal.Hashing (hashData, hashScriptWithPrefix) import Plutarch.Api.V1.Contexts (PScriptContext) import Plutarch.Prelude +import qualified Data.Text as T +import GHC.Stack (HasCallStack) + -- On-chain Script Types -- | a Validator Term @@ -115,16 +123,16 @@ type PMintingPolicy = PData :--> PScriptContext :--> POpaque type PStakeValidator = PData :--> PScriptContext :--> POpaque -- | Compile a Validator -mkValidator :: ClosedTerm PValidator -> Plutus.Validator -mkValidator s = Plutus.Validator $ compile s +mkValidator :: HasCallStack => Config -> ClosedTerm PValidator -> Plutus.Validator +mkValidator config s = Plutus.Validator $ either (error . T.unpack) id $ compile config s -- | Compile a MintingPolicy -mkMintingPolicy :: ClosedTerm PMintingPolicy -> Plutus.MintingPolicy -mkMintingPolicy s = Plutus.MintingPolicy $ compile s +mkMintingPolicy :: HasCallStack => Config -> ClosedTerm PMintingPolicy -> Plutus.MintingPolicy +mkMintingPolicy config s = Plutus.MintingPolicy $ either (error . T.unpack) id $ compile config s -- | Compile a StakeValidator -mkStakeValidator :: ClosedTerm PStakeValidator -> Plutus.StakeValidator -mkStakeValidator s = Plutus.StakeValidator $ compile s +mkStakeValidator :: HasCallStack => Config -> ClosedTerm PStakeValidator -> Plutus.StakeValidator +mkStakeValidator config s = Plutus.StakeValidator $ either (error . T.unpack) id $ compile config s -- | Hash a Script, with the correct prefix for Plutus V1 scriptHash :: Plutus.Script -> Plutus.ScriptHash @@ -141,3 +149,15 @@ mintingPolicySymbol = coerce scriptHash -- | Hash a StakeValidator, with the correct prefix for Plutus V1 stakeValidatorHash :: Plutus.StakeValidator -> Plutus.StakeValidatorHash stakeValidatorHash = coerce scriptHash + +-- | Hash a Datum. +datumHash :: Plutus.Datum -> Plutus.DatumHash +datumHash = coerce . dataHash + +-- | Hash a Redeemer. +redeemerHash :: Plutus.Redeemer -> Plutus.RedeemerHash +redeemerHash = coerce . dataHash + +-- | Hash the data encoded representation of given argument. +dataHash :: Plutus.ToData a => a -> Plutus.BuiltinByteString +dataHash = hashData . Plutus.toData diff --git a/Plutarch/Api/V1/Address.hs b/Plutarch/Api/V1/Address.hs index 888270717..83327cdaf 100644 --- a/Plutarch/Api/V1/Address.hs +++ b/Plutarch/Api/V1/Address.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -7,10 +8,7 @@ module Plutarch.Api.V1.Address ( PAddress (PAddress), ) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) - -import qualified Plutus.V1.Ledger.Api as Plutus +import qualified PlutusLedgerApi.V1 as Plutus import Plutarch.Api.V1.Crypto (PPubKeyHash) import Plutarch.Api.V1.Maybe (PMaybeData) @@ -18,9 +16,9 @@ import Plutarch.Api.V1.Scripts (PValidatorHash) import Plutarch.DataRepr ( DerivePConstantViaData (DerivePConstantViaData), PDataFields, - PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Lift ( + PConstantDecl, PLifted, PUnsafeLiftDecl, ) @@ -29,15 +27,13 @@ import Plutarch.Prelude data PCredential (s :: S) = PPubKeyCredential (Term s (PDataRecord '["_0" ':= PPubKeyHash])) | PScriptCredential (Term s (PDataRecord '["_0" ':= PValidatorHash])) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) - via (PIsDataReprInstances PCredential) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd, PTryFrom PData) +instance DerivePlutusType PCredential where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PCredential where type PLifted PCredential = Plutus.Credential -deriving via (DerivePConstantViaData Plutus.Credential PCredential) instance (PConstant Plutus.Credential) +deriving via (DerivePConstantViaData Plutus.Credential PCredential) instance PConstantDecl Plutus.Credential +instance PTryFrom PData (PAsData PCredential) data PStakingCredential (s :: S) = PStakingHash (Term s (PDataRecord '["_0" ':= PCredential])) @@ -51,15 +47,13 @@ data PStakingCredential (s :: S) ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) - via PIsDataReprInstances PStakingCredential + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd, PTryFrom PData) +instance DerivePlutusType PStakingCredential where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PStakingCredential where type PLifted PStakingCredential = Plutus.StakingCredential -deriving via (DerivePConstantViaData Plutus.StakingCredential PStakingCredential) instance (PConstant Plutus.StakingCredential) +deriving via (DerivePConstantViaData Plutus.StakingCredential PStakingCredential) instance PConstantDecl Plutus.StakingCredential +instance PTryFrom PData (PAsData PStakingCredential) newtype PAddress (s :: S) = PAddress @@ -67,16 +61,14 @@ newtype PAddress (s :: S) s ( PDataRecord '[ "credential" ':= PCredential - , "stakingCredential" ':= (PMaybeData PStakingCredential) + , "stakingCredential" ':= PMaybeData PStakingCredential ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via PIsDataReprInstances PAddress + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq, PPartialOrd, POrd, PTryFrom PData) +instance DerivePlutusType PAddress where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PAddress where type PLifted PAddress = Plutus.Address -deriving via (DerivePConstantViaData Plutus.Address PAddress) instance (PConstant Plutus.Address) +deriving via (DerivePConstantViaData Plutus.Address PAddress) instance PConstantDecl Plutus.Address +instance PTryFrom PData (PAsData PAddress) diff --git a/Plutarch/Api/V1/AssocMap.hs b/Plutarch/Api/V1/AssocMap.hs index eeb3ff3ee..29010c9aa 100644 --- a/Plutarch/Api/V1/AssocMap.hs +++ b/Plutarch/Api/V1/AssocMap.hs @@ -1,15 +1,65 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Api.V1.AssocMap ( PMap (PMap), + KeyGuarantees (Unsorted, Sorted), + + -- * Creation + pempty, + psingleton, + psingletonData, + pinsert, + pinsertData, + pdelete, + pfromAscList, + passertSorted, + pforgetSorted, + + -- * Lookups + plookup, + plookupData, + pfindWithDefault, + pfoldAt, + pnull, + + -- * Folds + pall, + pany, + + -- * Filters and traversals + pfilter, + pmap, + pmapData, + pmapMaybe, + pmapMaybeData, + + -- * Combining + pdifference, + punionWith, + punionWithData, + + -- * Partial order operations + pcheckBinRel, ) where -import qualified Plutus.V1.Ledger.Api as Plutus +import qualified PlutusLedgerApi.V1 as Plutus import qualified PlutusTx.AssocMap as PlutusMap +import qualified PlutusTx.Monoid as PlutusTx +import qualified PlutusTx.Semigroup as PlutusTx -import Plutarch.Builtin (PBuiltinMap) +import Plutarch.Builtin ( + pasMap, + pdataImpl, + pforgetData, + pfromDataImpl, + ppairDataBuiltin, + ) +import Plutarch.Internal (punsafeBuiltin) +import Plutarch.Internal.Witness (witness) import Plutarch.Lift ( + PConstantDecl, PConstantRepr, PConstanted, PLifted, @@ -17,42 +67,487 @@ import Plutarch.Lift ( pconstantFromRepr, pconstantToRepr, ) -import Plutarch.Prelude +import qualified Plutarch.List as List +import Plutarch.Prelude hiding (pall, pany, pfilter, pmap, pnull, psingleton) +import qualified Plutarch.Prelude as PPrelude +import Plutarch.Show (PShow) +import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom')) +import Plutarch.Unsafe (punsafeCoerce, punsafeDowncast) +import qualified PlutusCore as PLC + +import Prelude hiding (all, any, filter, lookup, null) + +import Data.Proxy (Proxy (Proxy)) +import Data.Traversable (for) -newtype PMap (k :: PType) (v :: PType) (s :: S) = PMap (Term s (PBuiltinMap k v)) - deriving (PlutusType, PIsData) via (DerivePNewtype (PMap k v) (PBuiltinMap k v)) +data KeyGuarantees = Sorted | Unsorted + +type PBuiltinListOfPairs k v = PBuiltinList (PBuiltinPair (PAsData k) (PAsData v)) + +newtype Flip f a b = Flip (f b a) deriving stock (Generic) + +type role PMap nominal nominal nominal nominal +newtype PMap (keysort :: KeyGuarantees) (k :: PType) (v :: PType) (s :: S) = PMap (Term s (PBuiltinList (PBuiltinPair (PAsData k) (PAsData v)))) + deriving stock (Generic) + deriving anyclass (PlutusType, PShow) +instance DerivePlutusType (PMap keysort k v) where type DPTStrat _ = PlutusTypeNewtype + +instance PIsData (PMap keysort k v) where + pfromDataImpl x = punsafeCoerce $ pasMap # pforgetData x + pdataImpl x = punsafeBuiltin PLC.MapData # x + +instance PEq (PMap 'Sorted k v) where + x #== y = peqViaData # x # y + where + peqViaData :: Term s (PMap 'Sorted k v :--> PMap 'Sorted k v :--> PBool) + peqViaData = phoistAcyclic $ plam $ \m0 m1 -> pdata m0 #== pdata m1 instance - ( Plutus.ToData (PLifted v) - , Plutus.ToData (PLifted k) - , Plutus.FromData (PLifted v) - , Plutus.FromData (PLifted k) - , PLift k - , PLift v + ( PLiftData k + , PLiftData v + , Ord (PLifted k) ) => - PUnsafeLiftDecl (PMap k v) + PUnsafeLiftDecl (PMap 'Unsorted k v) where - type PLifted (PMap k v) = PlutusMap.Map (PLifted k) (PLifted v) + type PLifted (PMap 'Unsorted k v) = PlutusMap.Map (PLifted k) (PLifted v) instance - ( PLifted (PConstanted k) ~ k - , Plutus.ToData v - , Plutus.FromData v - , Plutus.ToData k - , Plutus.FromData k - , PConstant k - , PLifted (PConstanted v) ~ v - , Plutus.FromData v - , Plutus.ToData v - , PConstant v + ( PConstantData k + , PConstantData v + , Ord k ) => - PConstant (PlutusMap.Map k v) + PConstantDecl (PlutusMap.Map k v) where type PConstantRepr (PlutusMap.Map k v) = [(Plutus.Data, Plutus.Data)] - type PConstanted (PlutusMap.Map k v) = PMap (PConstanted k) (PConstanted v) + type PConstanted (PlutusMap.Map k v) = PMap 'Unsorted (PConstanted k) (PConstanted v) pconstantToRepr m = (\(x, y) -> (Plutus.toData x, Plutus.toData y)) <$> PlutusMap.toList m pconstantFromRepr m = fmap PlutusMap.fromList $ - flip traverse m $ \(x, y) -> do + for m $ \(x, y) -> do x' <- Plutus.fromData x y' <- Plutus.fromData y Just (x', y') + +instance + ( PTryFrom PData (PAsData k) + , PTryFrom PData (PAsData v) + ) => + PTryFrom PData (PAsData (PMap 'Unsorted k v)) + where + type PTryFromExcess PData (PAsData (PMap 'Unsorted k v)) = Flip Term (PMap 'Unsorted k v) + ptryFrom' opq = runTermCont $ do + opq' <- tcont . plet $ pasMap # opq + unwrapped <- tcont . plet $ List.pmap # ptryFromPair # opq' + pure (punsafeCoerce opq, pcon . PMap $ unwrapped) + where + ptryFromPair :: Term s (PBuiltinPair PData PData :--> PBuiltinPair (PAsData k) (PAsData v)) + ptryFromPair = plam $ \p -> + ppairDataBuiltin # ptryFrom (pfstBuiltin # p) fst + # ptryFrom (psndBuiltin # p) fst + +instance + ( POrd k + , PIsData k + , PIsData v + , PTryFrom PData (PAsData k) + , PTryFrom PData (PAsData v) + ) => + PTryFrom PData (PAsData (PMap 'Sorted k v)) + where + type PTryFromExcess PData (PAsData (PMap 'Sorted k v)) = Flip Term (PMap 'Sorted k v) + ptryFrom' opq = runTermCont $ do + (opq', _) <- tcont $ ptryFrom @(PAsData (PMap 'Unsorted k v)) opq + unwrapped <- tcont $ plet . papp passertSorted . pfromData $ opq' + pure (punsafeCoerce opq, unwrapped) + +-- | Tests whether the map is empty. +pnull :: Term s (PMap any k v :--> PBool) +pnull = plam (\map -> List.pnull # pto map) + +-- | Look up the given key in a 'PMap'. +plookup :: (PIsData k, PIsData v) => Term s (k :--> PMap any k v :--> PMaybe v) +plookup = phoistAcyclic $ + plam $ \key -> + plookupDataWith + # phoistAcyclic (plam $ \pair -> pcon $ PJust $ pfromData $ psndBuiltin # pair) + # pdata key + +-- | Look up the given key data in a 'PMap'. +plookupData :: Term s (PAsData k :--> PMap any k v :--> PMaybe (PAsData v)) +plookupData = plookupDataWith # phoistAcyclic (plam $ \pair -> pcon $ PJust $ psndBuiltin # pair) + +-- | Look up the given key data in a 'PMap', applying the given function to the found key-value pair. +plookupDataWith :: + Term + s + ( (PBuiltinPair (PAsData k) (PAsData v) :--> PMaybe x) + :--> PAsData k + :--> PMap any k v + :--> PMaybe x + ) +plookupDataWith = phoistAcyclic $ + plam $ \unwrap key map -> + precList + ( \self x xs -> + pif + (pfstBuiltin # x #== key) + (unwrap # x) + (self # xs) + ) + (const $ pcon PNothing) + # pto map + +-- | Look up the given key in a 'PMap', returning the default value if the key is absent. +pfindWithDefault :: (PIsData k, PIsData v) => Term s (v :--> k :--> PMap any k v :--> v) +pfindWithDefault = phoistAcyclic $ plam $ \def key -> foldAtData # pdata key # def # plam pfromData + +{- | Look up the given key in a 'PMap'; return the default if the key is + absent or apply the argument function to the value data if present. +-} +pfoldAt :: PIsData k => Term s (k :--> r :--> (PAsData v :--> r) :--> PMap any k v :--> r) +pfoldAt = phoistAcyclic $ + plam $ \key -> foldAtData # pdata key + +{- | Look up the given key data in a 'PMap'; return the default if the key is + absent or apply the argument function to the value data if present. +-} +foldAtData :: Term s (PAsData k :--> r :--> (PAsData v :--> r) :--> PMap any k v :--> r) +foldAtData = phoistAcyclic $ + plam $ \key def apply map -> + precList + ( \self x xs -> + pif + (pfstBuiltin # x #== key) + (apply #$ psndBuiltin # x) + (self # xs) + ) + (const def) + # pto map + +-- | Insert a new key/value pair into the map, overiding the previous if any. +pinsert :: (POrd k, PIsData k, PIsData v) => Term s (k :--> v :--> PMap 'Sorted k v :--> PMap 'Sorted k v) +pinsert = phoistAcyclic $ + plam $ \key val -> + rebuildAtKey # plam (pcons # (ppairDataBuiltin # pdata key # pdata val) #) # key + +-- | Insert a new data-encoded key/value pair into the map, overiding the previous if any. +pinsertData :: + (POrd k, PIsData k) => + Term s (PAsData k :--> PAsData v :--> PMap 'Sorted k v :--> PMap 'Sorted k v) +pinsertData = phoistAcyclic $ + plam $ \key val -> + rebuildAtKey # plam (pcons # (ppairDataBuiltin # key # val) #) # pfromData key + +-- | Delete a key from the map. +pdelete :: (POrd k, PIsData k) => Term s (k :--> PMap 'Sorted k v :--> PMap 'Sorted k v) +pdelete = rebuildAtKey # plam id + +-- | Rebuild the map at the given key. +rebuildAtKey :: + (POrd k, PIsData k) => + Term + s + ( ( PBuiltinList (PBuiltinPair (PAsData k) (PAsData v)) + :--> PBuiltinList (PBuiltinPair (PAsData k) (PAsData v)) + ) + :--> k + :--> PMap g k v + :--> PMap g k v + ) +rebuildAtKey = phoistAcyclic $ + plam $ \handler key map -> + punsafeDowncast $ + precList + ( \self x xs -> + plet (pfromData $ pfstBuiltin # x) $ \k -> + plam $ \prefix -> + pif + (k #< key) + (self # xs #$ plam $ \suffix -> prefix #$ pcons # x # suffix) + ( pif + (k #== key) + (prefix #$ handler # xs) + (prefix #$ handler #$ pcons # x # xs) + ) + ) + (const $ plam (#$ handler # pnil)) + # pto map + # plam id + +-- | Construct an empty 'PMap'. +pempty :: Term s (PMap 'Sorted k v) +pempty = punsafeDowncast pnil + +-- | Construct a singleton 'PMap' with the given key and value. +psingleton :: (PIsData k, PIsData v) => Term s (k :--> v :--> PMap 'Sorted k v) +psingleton = phoistAcyclic $ plam $ \key value -> psingletonData # pdata key # pdata value + +-- | Construct a singleton 'PMap' with the given data-encoded key and value. +psingletonData :: Term s (PAsData k :--> PAsData v :--> PMap 'Sorted k v) +psingletonData = phoistAcyclic $ + plam $ \key value -> punsafeDowncast (pcons # (ppairDataBuiltin # key # value) # pnil) + +-- | Construct a 'PMap' from a list of key-value pairs, sorted by ascending key data. +pfromAscList :: (POrd k, PIsData k, PIsData v) => Term s (PBuiltinListOfPairs k v :--> PMap 'Sorted k v) +pfromAscList = plam $ (passertSorted #) . pcon . PMap + +-- | Assert the map is properly sorted. +passertSorted :: forall k v any s. (POrd k, PIsData k, PIsData v) => Term s (PMap any k v :--> PMap 'Sorted k v) +passertSorted = + let _ = witness (Proxy :: Proxy (PIsData v)) + in phoistAcyclic $ + plam $ \map -> + precList + ( \self x xs -> + plet (pfromData $ pfstBuiltin # x) $ \k -> + plam $ \badKey -> + pif + (badKey # k) + (ptraceError "unsorted map") + (self # xs # plam (#< k)) + ) + -- this is actually the empty map so we can + -- safely assum that it is sorted + (const . plam . const $ punsafeCoerce map) + # pto map + # plam (const $ pcon PFalse) + +-- | Forget the knowledge that keys were sorted. +pforgetSorted :: Term s (PMap 'Sorted k v) -> Term s (PMap g k v) +pforgetSorted v = punsafeDowncast (pto v) + +instance + (POrd k, PIsData k, PIsData v, Semigroup (Term s v)) => + Semigroup (Term s (PMap 'Sorted k v)) + where + a <> b = punionWith # plam (<>) # a # b + +instance + (POrd k, PIsData k, PIsData v, Semigroup (Term s v)) => + Monoid (Term s (PMap 'Sorted k v)) + where + mempty = pempty + +instance + (POrd k, PIsData k, PIsData v, PlutusTx.Semigroup (Term s v)) => + PlutusTx.Semigroup (Term s (PMap 'Sorted k v)) + where + a <> b = punionWith # plam (PlutusTx.<>) # a # b + +instance + (POrd k, PIsData k, PIsData v, PlutusTx.Semigroup (Term s v)) => + PlutusTx.Monoid (Term s (PMap 'Sorted k v)) + where + mempty = pempty + +instance + (POrd k, PIsData k, PIsData v, PlutusTx.Group (Term s v)) => + PlutusTx.Group (Term s (PMap 'Sorted k v)) + where + inv a = pmap # plam PlutusTx.inv # a + +{- | Combine two 'PMap's applying the given function to any two values that + share the same key. +-} +punionWith :: + (POrd k, PIsData k, PIsData v) => + Term s ((v :--> v :--> v) :--> PMap 'Sorted k v :--> PMap 'Sorted k v :--> PMap 'Sorted k v) +punionWith = phoistAcyclic $ + plam $ + \combine -> punionWithData #$ plam $ + \x y -> pdata (combine # pfromData x # pfromData y) + +data MapUnionCarrier k v s = MapUnionCarrier + { merge :: Term s (PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v) + , mergeInsert :: Term s (PBuiltinPair (PAsData k) (PAsData v) :--> PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v :--> PBuiltinListOfPairs k v) + } + deriving stock (Generic) + deriving anyclass (PlutusType) +instance DerivePlutusType (MapUnionCarrier k v) where type DPTStrat _ = PlutusTypeScott + +mapUnionCarrier :: (POrd k, PIsData k) => Term s ((PAsData v :--> PAsData v :--> PAsData v) :--> MapUnionCarrier k v :--> MapUnionCarrier k v) +mapUnionCarrier = phoistAcyclic $ plam \combine self -> + let mergeInsert = pmatch self \(MapUnionCarrier {mergeInsert}) -> mergeInsert + merge = pmatch self \(MapUnionCarrier {merge}) -> merge + in pcon $ + MapUnionCarrier + { merge = plam $ \xs ys -> pmatch xs $ \case + PNil -> ys + PCons x xs' -> mergeInsert # x # xs' # ys + , mergeInsert = plam $ \x xs ys -> + pmatch ys $ \case + PNil -> pcons # x # xs + PCons y1 ys' -> + plet y1 $ \y -> + plet (pfstBuiltin # x) $ \xk -> + plet (pfstBuiltin # y) $ \yk -> + pif + (xk #== yk) + ( pcons + # (ppairDataBuiltin # xk #$ combine # (psndBuiltin # x) # (psndBuiltin # y)) + #$ merge + # xs + # ys' + ) + ( pif + (pfromData xk #< pfromData yk) + ( pcons + # x + # (mergeInsert # y # ys' # xs) + ) + ( pcons + # y + # (mergeInsert # x # xs # ys') + ) + ) + } + +mapUnion :: forall k v s. (POrd k, PIsData k) => Term s ((PAsData v :--> PAsData v :--> PAsData v) :--> MapUnionCarrier k v) +mapUnion = phoistAcyclic $ plam \combine -> punsafeCoerce pfix # (mapUnionCarrier # combine :: Term _ (MapUnionCarrier k v :--> MapUnionCarrier k v)) + +{- | Combine two 'PMap's applying the given function to any two data-encoded + values that share the same key. +-} +punionWithData :: + (POrd k, PIsData k) => + Term + s + ( (PAsData v :--> PAsData v :--> PAsData v) + :--> PMap 'Sorted k v + :--> PMap 'Sorted k v + :--> PMap 'Sorted k v + ) +punionWithData = phoistAcyclic $ + plam $ \combine x y -> + pcon $ PMap $ (pmatch (mapUnion # combine) \(MapUnionCarrier {merge}) -> merge) # pto x # pto y + +-- | Difference of two maps. Return elements of the first map not existing in the second map. +pdifference :: PIsData k => Term s (PMap g k a :--> PMap any k b :--> PMap g k a) +pdifference = phoistAcyclic $ + plam $ \left right -> + pcon . PMap $ + precList + ( \self x xs -> + plet (self # xs) $ \xs' -> + pfoldAt + # pfromData (pfstBuiltin # x) + # (pcons # x # xs') + # plam (const xs') + # right + ) + (const pnil) + # pto left + +-- | Tests if all values in the map satisfy the given predicate. +pall :: PIsData v => Term s ((v :--> PBool) :--> PMap any k v :--> PBool) +pall = phoistAcyclic $ + plam $ \pred map -> + List.pall # plam (\pair -> pred #$ pfromData $ psndBuiltin # pair) # pto map + +-- | Tests if anu value in the map satisfies the given predicate. +pany :: PIsData v => Term s ((v :--> PBool) :--> PMap any k v :--> PBool) +pany = phoistAcyclic $ + plam $ \pred map -> + List.pany # plam (\pair -> pred #$ pfromData $ psndBuiltin # pair) # pto map + +-- | Filters the map so it contains only the values that satisfy the given predicate. +pfilter :: PIsData v => Term s ((v :--> PBool) :--> PMap g k v :--> PMap g k v) +pfilter = phoistAcyclic $ + plam $ \pred -> + pmapMaybe #$ plam $ \v -> pif (pred # v) (pcon $ PJust v) (pcon PNothing) + +-- | Maps and filters the map, much like 'Data.List.mapMaybe'. +pmapMaybe :: + (PIsData a, PIsData b) => + Term s ((a :--> PMaybe b) :--> PMap g k a :--> PMap g k b) +pmapMaybe = phoistAcyclic $ + plam $ \f -> pmapMaybeData #$ plam $ \v -> pmatch (f # pfromData v) $ \case + PNothing -> pcon PNothing + PJust v' -> pcon $ PJust (pdata v') + +pmapMaybeData :: + Term s ((PAsData a :--> PMaybe (PAsData b)) :--> PMap g k a :--> PMap g k b) +pmapMaybeData = phoistAcyclic $ + plam $ \f map -> + pcon . PMap $ + precList + ( \self x xs -> + plet (self # xs) $ \xs' -> + pmatch (f #$ psndBuiltin # x) $ \case + PNothing -> xs' + PJust v -> pcons # (ppairDataBuiltin # (pfstBuiltin # x) # v) # xs' + ) + (const pnil) + # pto map + +-- | Applies a function to every value in the map, much like 'Data.List.map'. +pmap :: + (PIsData a, PIsData b) => + Term s ((a :--> b) :--> PMap g k a :--> PMap g k b) +pmap = phoistAcyclic $ + plam $ \f -> pmapData #$ plam $ \v -> pdata (f # pfromData v) + +pmapData :: + Term s ((PAsData a :--> PAsData b) :--> PMap g k a :--> PMap g k b) +pmapData = phoistAcyclic $ + plam $ \f map -> + pcon . PMap $ + precList + ( \self x xs -> + pcons + # (ppairDataBuiltin # (pfstBuiltin # x) # (f #$ psndBuiltin # x)) + # (self # xs) + ) + (const pnil) + # pto map + +{- | Given a comparison function and a "zero" value, check whether a binary relation holds over +2 sorted 'PMap's. + +This is primarily intended to be used with 'PValue'. +-} +pcheckBinRel :: + forall k v s. + (POrd k, PIsData k, PIsData v) => + Term + s + ( (v :--> v :--> PBool) + :--> v + :--> PMap 'Sorted k v + :--> PMap 'Sorted k v + :--> PBool + ) +pcheckBinRel = phoistAcyclic $ + plam $ \f z m1 m2 -> + let inner = pfix #$ plam $ \self l1 l2 -> + pelimList + ( \x xs -> + plet (pfromData $ psndBuiltin # x) $ \v1 -> + pelimList + ( \y ys -> unTermCont $ do + v2 <- tcont . plet . pfromData $ psndBuiltin # y + k1 <- tcont . plet . pfromData $ pfstBuiltin # x + k2 <- tcont . plet . pfromData $ pfstBuiltin # y + pure $ + pif + (k1 #== k2) + ( f # v1 # v2 #&& self + # xs + # ys + ) + $ pif + (k1 #< k2) + (f # v1 # z #&& self # xs # l2) + $ f # z # v2 #&& self + # l1 + # ys + ) + ( f # v1 # z + #&& PPrelude.pall + # plam (\p -> f # pfromData (psndBuiltin # p) # z) + # xs + ) + l2 + ) + (PPrelude.pall # plam (\p -> f # z #$ pfromData $ psndBuiltin # p) # l2) + l1 + in inner # pto m1 # pto m2 diff --git a/Plutarch/Api/V1/Contexts.hs b/Plutarch/Api/V1/Contexts.hs index 7299b6ae3..8ceb15375 100644 --- a/Plutarch/Api/V1/Contexts.hs +++ b/Plutarch/Api/V1/Contexts.hs @@ -8,10 +8,7 @@ module Plutarch.Api.V1.Contexts ( PScriptPurpose (PMinting, PSpending, PRewarding, PCertifying), ) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) - -import qualified Plutus.V1.Ledger.Api as Plutus +import qualified PlutusLedgerApi.V1 as Plutus import Plutarch.Api.V1.Address ( PStakingCredential, @@ -22,46 +19,51 @@ import Plutarch.Api.V1.Scripts (PDatum, PDatumHash) import Plutarch.Api.V1.Time (PPOSIXTimeRange) import Plutarch.Api.V1.Tuple (PTuple) import Plutarch.Api.V1.Tx (PTxId, PTxInInfo, PTxOut, PTxOutRef) -import Plutarch.Api.V1.Value (PCurrencySymbol, PValue) +import Plutarch.Api.V1.Value ( + AmountGuarantees (NoGuarantees, Positive), + KeyGuarantees (Sorted), + PCurrencySymbol, + PValue, + ) import Plutarch.DataRepr ( DerivePConstantViaData (DerivePConstantViaData), PDataFields, - PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Lift ( + PConstantDecl, PLifted, PUnsafeLiftDecl, ) import Plutarch.Prelude +-- | A pending transaction. This is the view as seen by the validator script. newtype PTxInfo (s :: S) = PTxInfo ( Term s ( PDataRecord - '[ "inputs" ':= PBuiltinList (PAsData PTxInInfo) - , "outputs" ':= PBuiltinList (PAsData PTxOut) - , "fee" ':= PValue - , "mint" ':= PValue - , "dcert" ':= PBuiltinList (PAsData PDCert) - , "wdrl" ':= PBuiltinList (PAsData (PTuple PStakingCredential PInteger)) - , "validRange" ':= PPOSIXTimeRange - , "signatories" ':= PBuiltinList (PAsData PPubKeyHash) - , "data" ':= PBuiltinList (PAsData (PTuple PDatumHash PDatum)) - , "id" ':= PTxId + '[ "inputs" ':= PBuiltinList PTxInInfo -- Transaction inputs + , "outputs" ':= PBuiltinList PTxOut -- Transaction outputs + , "fee" ':= PValue 'Sorted 'Positive -- The fee paid by this transaction. + , "mint" ':= PValue 'Sorted 'NoGuarantees -- The value minted by the transaction. + , "dcert" ':= PBuiltinList PDCert -- Digests of the certificates included in this transaction. + , "wdrl" ':= PBuiltinList (PAsData (PTuple PStakingCredential PInteger)) -- Staking withdrawals + , "validRange" ':= PPOSIXTimeRange -- The valid range for the transaction. + , "signatories" ':= PBuiltinList (PAsData PPubKeyHash) -- Signatories attesting that they all signed the tx. + , "datums" ':= PBuiltinList (PAsData (PTuple PDatumHash PDatum)) + , "id" ':= PTxId -- The hash of the pending transaction. ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via PIsDataReprInstances PTxInfo + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq) + +instance DerivePlutusType PTxInfo where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PTxInfo where type PLifted PTxInfo = Plutus.TxInfo -deriving via (DerivePConstantViaData Plutus.TxInfo PTxInfo) instance (PConstant Plutus.TxInfo) +deriving via (DerivePConstantViaData Plutus.TxInfo PTxInfo) instance PConstantDecl Plutus.TxInfo +-- | Script context consists of the script purpose and the pending transaction info. newtype PScriptContext (s :: S) = PScriptContext ( Term @@ -72,29 +74,26 @@ newtype PScriptContext (s :: S) ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via PIsDataReprInstances PScriptContext + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq) + +instance DerivePlutusType PScriptContext where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PScriptContext where type PLifted PScriptContext = Plutus.ScriptContext -deriving via (DerivePConstantViaData Plutus.ScriptContext PScriptContext) instance (PConstant Plutus.ScriptContext) +deriving via (DerivePConstantViaData Plutus.ScriptContext PScriptContext) instance PConstantDecl Plutus.ScriptContext -- General types, used by V1 and V2 +-- | The purpose of the script that is currently running data PScriptPurpose (s :: S) = PMinting (Term s (PDataRecord '["_0" ':= PCurrencySymbol])) | PSpending (Term s (PDataRecord '["_0" ':= PTxOutRef])) | PRewarding (Term s (PDataRecord '["_0" ':= PStakingCredential])) | PCertifying (Term s (PDataRecord '["_0" ':= PDCert])) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) - via (PIsDataReprInstances PScriptPurpose) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq) + +instance DerivePlutusType PScriptPurpose where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PScriptPurpose where type PLifted PScriptPurpose = Plutus.ScriptPurpose -deriving via (DerivePConstantViaData Plutus.ScriptPurpose PScriptPurpose) instance (PConstant Plutus.ScriptPurpose) +deriving via (DerivePConstantViaData Plutus.ScriptPurpose PScriptPurpose) instance PConstantDecl Plutus.ScriptPurpose diff --git a/Plutarch/Api/V1/Crypto.hs b/Plutarch/Api/V1/Crypto.hs index 920843f99..1cc2acf46 100644 --- a/Plutarch/Api/V1/Crypto.hs +++ b/Plutarch/Api/V1/Crypto.hs @@ -1,46 +1,50 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Api.V1.Crypto ( PPubKeyHash (PPubKeyHash), - PPubKey (PPubKey), - PSignature (PSignature), + PubKey (PubKey, getPubKey), + pubKeyHash, ) where -import qualified Plutus.V1.Ledger.Api as Plutus -import qualified Plutus.V1.Ledger.Crypto as PlutusCrypto -import qualified PlutusTx.Builtins.Internal as PT +import qualified PlutusLedgerApi.V1 as Plutus +import Data.Coerce (coerce) +import Plutarch.Api.Internal.Hashing (hashLedgerBytes) import Plutarch.Lift ( - DerivePConstantViaNewtype (DerivePConstantViaNewtype), + DerivePConstantViaBuiltin (DerivePConstantViaBuiltin), + PConstantDecl, PLifted, PUnsafeLiftDecl, ) import Plutarch.Prelude +import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom')) +import Plutarch.Unsafe (punsafeCoerce) newtype PPubKeyHash (s :: S) = PPubKeyHash (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PPubKeyHash PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PPubKeyHash where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PPubKeyHash where type PLifted PPubKeyHash = Plutus.PubKeyHash deriving via - (DerivePConstantViaNewtype Plutus.PubKeyHash PPubKeyHash PByteString) + (DerivePConstantViaBuiltin Plutus.PubKeyHash PPubKeyHash PByteString) instance - (PConstant Plutus.PubKeyHash) + PConstantDecl Plutus.PubKeyHash -newtype PPubKey (s :: S) = PPubKey (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PPubKey PByteString) +instance PTryFrom PData (PAsData PPubKeyHash) where + type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash + ptryFrom' opq = runTermCont $ do + unwrapped <- tcont . plet $ ptryFrom @(PAsData PByteString) opq snd + tcont $ \f -> + pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "ptryFrom(PPubKeyHash): must be 28 bytes long") + pure (punsafeCoerce opq, pcon . PPubKeyHash $ unwrapped) -instance PUnsafeLiftDecl PPubKey where type PLifted PPubKey = PlutusCrypto.PubKey -deriving via - (DerivePConstantViaNewtype PlutusCrypto.PubKey PPubKey PByteString) - instance - (PConstant PlutusCrypto.PubKey) +newtype PubKey = PubKey {getPubKey :: Plutus.LedgerBytes} + deriving stock (Eq, Ord, Show) -newtype PSignature (s :: S) = PSignature (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PSignature PByteString) +newtype Flip f a b = Flip (f b a) deriving stock (Generic) -instance PUnsafeLiftDecl PSignature where type PLifted PSignature = PlutusCrypto.Signature -deriving via - (DerivePConstantViaNewtype PlutusCrypto.Signature PSignature PByteString) - instance - (PConstant PlutusCrypto.Signature) +pubKeyHash :: PubKey -> Plutus.PubKeyHash +pubKeyHash = coerce hashLedgerBytes diff --git a/Plutarch/Api/V1/DCert.hs b/Plutarch/Api/V1/DCert.hs index 42994748c..e293ca536 100644 --- a/Plutarch/Api/V1/DCert.hs +++ b/Plutarch/Api/V1/DCert.hs @@ -13,18 +13,14 @@ module Plutarch.Api.V1.DCert ( ), ) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) - -import qualified Plutus.V1.Ledger.Api as Plutus +import qualified PlutusLedgerApi.V1 as Plutus import Plutarch.Api.V1.Address (PStakingCredential) import Plutarch.Api.V1.Crypto (PPubKeyHash) import Plutarch.DataRepr ( DerivePConstantViaData (DerivePConstantViaData), - PIsDataReprInstances (PIsDataReprInstances), ) -import Plutarch.Lift (PLifted, PUnsafeLiftDecl) +import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) import Plutarch.Prelude data PDCert (s :: S) @@ -43,12 +39,9 @@ data PDCert (s :: S) | PDCertPoolRetire (Term s (PDataRecord '["_0" ':= PPubKeyHash, "_1" ':= PInteger])) | PDCertGenesis (Term s (PDataRecord '[])) | PDCertMir (Term s (PDataRecord '[])) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) - via (PIsDataReprInstances PDCert) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PDCert where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PDCert where type PLifted PDCert = Plutus.DCert -deriving via (DerivePConstantViaData Plutus.DCert PDCert) instance (PConstant Plutus.DCert) +deriving via (DerivePConstantViaData Plutus.DCert PDCert) instance PConstantDecl Plutus.DCert diff --git a/Plutarch/Api/V1/Interval.hs b/Plutarch/Api/V1/Interval.hs index d4e0b3950..2a80bb309 100644 --- a/Plutarch/Api/V1/Interval.hs +++ b/Plutarch/Api/V1/Interval.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Api.V1.Interval ( PInterval (PInterval), @@ -8,11 +9,18 @@ module Plutarch.Api.V1.Interval ( type PClosure, ) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) - -import Plutarch.DataRepr (PDataFields, PIsDataReprInstances (PIsDataReprInstances)) +import Plutarch.DataRepr ( + DerivePConstantViaData (DerivePConstantViaData), + PDataFields, + ) import Plutarch.Prelude +import qualified PlutusLedgerApi.V1.Interval as Plutus + +import Plutarch.Lift ( + PConstantDecl (PConstanted), + PLifted, + PUnsafeLiftDecl, + ) type PClosure = PBool @@ -26,12 +34,20 @@ newtype PInterval a (s :: S) ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via PIsDataReprInstances (PInterval a) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq, PPartialOrd, POrd) +instance DerivePlutusType (PInterval a) where type DPTStrat _ = PlutusTypeData + +instance + (PLiftData a) => + PUnsafeLiftDecl (PInterval a) + where + type PLifted (PInterval a) = (Plutus.Interval (PLifted a)) +deriving via + (DerivePConstantViaData (Plutus.Interval a) (PInterval (PConstanted a))) + instance + (PConstantData a) => + PConstantDecl (Plutus.Interval a) newtype PLowerBound a (s :: S) = PLowerBound @@ -43,12 +59,20 @@ newtype PLowerBound a (s :: S) ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via (PIsDataReprInstances (PLowerBound a)) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq, PPartialOrd, POrd) +instance DerivePlutusType (PLowerBound a) where type DPTStrat _ = PlutusTypeData + +instance + (PLiftData a) => + PUnsafeLiftDecl (PLowerBound a) + where + type PLifted (PLowerBound a) = (Plutus.LowerBound (PLifted a)) +deriving via + (DerivePConstantViaData (Plutus.LowerBound a) (PLowerBound (PConstanted a))) + instance + (PConstantData a) => + PConstantDecl (Plutus.LowerBound a) newtype PUpperBound a (s :: S) = PUpperBound @@ -60,20 +84,25 @@ newtype PUpperBound a (s :: S) ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via (PIsDataReprInstances (PUpperBound a)) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq, PPartialOrd, POrd) +instance DerivePlutusType (PUpperBound a) where type DPTStrat _ = PlutusTypeData data PExtended a (s :: S) = PNegInf (Term s (PDataRecord '[])) | PFinite (Term s (PDataRecord '["_0" ':= a])) | PPosInf (Term s (PDataRecord '[])) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) - via (PIsDataReprInstances (PExtended a)) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType (PExtended a) where type DPTStrat _ = PlutusTypeData + +instance + (PLiftData a) => + PUnsafeLiftDecl (PUpperBound a) + where + type PLifted (PUpperBound a) = (Plutus.UpperBound (PLifted a)) +deriving via + (DerivePConstantViaData (Plutus.UpperBound a) (PUpperBound (PConstanted a))) + instance + (PConstantData a) => + PConstantDecl (Plutus.UpperBound a) diff --git a/Plutarch/Api/V1/Maybe.hs b/Plutarch/Api/V1/Maybe.hs index b8494911d..de22de7a2 100644 --- a/Plutarch/Api/V1/Maybe.hs +++ b/Plutarch/Api/V1/Maybe.hs @@ -1,22 +1,80 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Api.V1.Maybe ( PMaybeData (PDJust, PDNothing), ) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) - -import Plutarch.DataRepr (PIsDataReprInstances (PIsDataReprInstances)) +import Plutarch.Builtin (pasConstr, pforgetData) +import Plutarch.DataRepr.Internal ( + DerivePConstantViaData (DerivePConstantViaData), + ) +import Plutarch.Lift ( + PConstantDecl (PConstanted), + PUnsafeLiftDecl (..), + ) import Plutarch.Prelude +import Plutarch.Unsafe (punsafeCoerce) -- | Data encoded Maybe type. Used in various ledger api types. data PMaybeData a (s :: S) = PDJust (Term s (PDataRecord '["_0" ':= a])) | PDNothing (Term s (PDataRecord '[])) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) - via PIsDataReprInstances (PMaybeData a) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq) + +instance DerivePlutusType (PMaybeData a) where type DPTStrat _ = PlutusTypeData +instance PTryFrom PData a => PTryFrom PData (PMaybeData a) +instance PTryFrom PData a => PTryFrom PData (PAsData (PMaybeData a)) + +instance PLiftData a => PUnsafeLiftDecl (PMaybeData a) where + type PLifted (PMaybeData a) = Maybe (PLifted a) + +deriving via + (DerivePConstantViaData (Maybe a) (PMaybeData (PConstanted a))) + instance + PConstantData a => PConstantDecl (Maybe a) + +-- Have to manually write this instance because the constructor id ordering is screwed for 'Maybe'.... +instance (PIsData a, POrd a) => PPartialOrd (PMaybeData a) where + x #< y = _pmaybeLT False (#<) # x # y + x #<= y = _pmaybeLT True (#<=) # x # y + +instance (PIsData a, POrd a) => POrd (PMaybeData a) + +_pmaybeLT :: + Bool -> + ( forall s rec. + rec ~ '["_0" ':= a] => + Term s (PDataRecord rec) -> + Term s (PDataRecord rec) -> + Term s PBool + ) -> + Term s (PMaybeData a :--> PMaybeData a :--> PBool) +_pmaybeLT whenBothNothing ltF = phoistAcyclic $ + plam $ \x y -> unTermCont $ do + a <- tcont . plet $ pasConstr #$ pforgetData $ pdata x + b <- tcont . plet $ pasConstr #$ pforgetData $ pdata y + + cid1 <- tcont . plet $ pfstBuiltin # a + cid2 <- tcont . plet $ pfstBuiltin # b + + pure $ + pif + (cid1 #< cid2) + (pconstant False) + $ pif + (cid1 #== cid2) + {- Some hand optimization here: usually, the fields would be 'plet'ed here if using 'POrd' derivation + machinery. However, in this case - there's no need for the fields for the 'Nothing' case. + + Would be nice if this could be done on the auto derivation case.... + -} + ( pif + (cid1 #== 0) + (ltF (punsafeCoerce $ psndBuiltin # a) (punsafeCoerce $ psndBuiltin # b)) + -- Both are 'Nothing'. Let caller choose answer. + $ pconstant whenBothNothing + ) + $ pconstant True diff --git a/Plutarch/Api/V1/Scripts.hs b/Plutarch/Api/V1/Scripts.hs index 2e02827f6..b332ec649 100644 --- a/Plutarch/Api/V1/Scripts.hs +++ b/Plutarch/Api/V1/Scripts.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -9,59 +10,107 @@ module Plutarch.Api.V1.Scripts ( PRedeemerHash (PRedeemerHash), PStakeValidatorHash (PStakeValidatorHash), PValidatorHash (PValidatorHash), + PScriptHash (PScriptHash), ) where -import qualified Plutus.V1.Ledger.Api as Plutus -import qualified PlutusTx.Builtins.Internal as PT +import qualified PlutusLedgerApi.V1 as Plutus +import qualified PlutusLedgerApi.V1.Scripts as Plutus import Plutarch.Lift ( - DerivePConstantViaNewtype (DerivePConstantViaNewtype), + DerivePConstantViaBuiltin (DerivePConstantViaBuiltin), + PConstantDecl, PLifted, PUnsafeLiftDecl, ) import Plutarch.Prelude +import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom')) +import Plutarch.Unsafe (punsafeCoerce) newtype PDatum (s :: S) = PDatum (Term s PData) - deriving (PlutusType, PIsData, PEq) via (DerivePNewtype PDatum PData) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq) +instance DerivePlutusType PDatum where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PDatum where type PLifted PDatum = Plutus.Datum -deriving via (DerivePConstantViaNewtype Plutus.Datum PDatum PData) instance (PConstant Plutus.Datum) +deriving via (DerivePConstantViaBuiltin Plutus.Datum PDatum PData) instance PConstantDecl Plutus.Datum newtype PRedeemer (s :: S) = PRedeemer (Term s PData) - deriving (PlutusType, PIsData, PEq) via (DerivePNewtype PRedeemer PData) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq) +instance DerivePlutusType PRedeemer where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PRedeemer where type PLifted PRedeemer = Plutus.Redeemer -deriving via (DerivePConstantViaNewtype Plutus.Redeemer PRedeemer PData) instance (PConstant Plutus.Redeemer) +deriving via (DerivePConstantViaBuiltin Plutus.Redeemer PRedeemer PData) instance PConstantDecl Plutus.Redeemer newtype PDatumHash (s :: S) = PDatumHash (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PDatumHash PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PDatumHash where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PDatumHash where type PLifted PDatumHash = Plutus.DatumHash -deriving via (DerivePConstantViaNewtype Plutus.DatumHash PDatumHash PByteString) instance (PConstant Plutus.DatumHash) +deriving via (DerivePConstantViaBuiltin Plutus.DatumHash PDatumHash PByteString) instance PConstantDecl Plutus.DatumHash newtype PStakeValidatorHash (s :: S) = PStakeValidatorHash (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PStakeValidatorHash PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PStakeValidatorHash where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PStakeValidatorHash where type PLifted PStakeValidatorHash = Plutus.StakeValidatorHash deriving via - (DerivePConstantViaNewtype Plutus.StakeValidatorHash PStakeValidatorHash PByteString) + (DerivePConstantViaBuiltin Plutus.StakeValidatorHash PStakeValidatorHash PByteString) instance - (PConstant Plutus.StakeValidatorHash) + PConstantDecl Plutus.StakeValidatorHash newtype PRedeemerHash (s :: S) = PRedeemerHash (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PRedeemerHash PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PRedeemerHash where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PRedeemerHash where type PLifted PRedeemerHash = Plutus.RedeemerHash deriving via - (DerivePConstantViaNewtype Plutus.RedeemerHash PRedeemerHash PByteString) + (DerivePConstantViaBuiltin Plutus.RedeemerHash PRedeemerHash PByteString) instance - (PConstant Plutus.RedeemerHash) + PConstantDecl Plutus.RedeemerHash newtype PValidatorHash (s :: S) = PValidatorHash (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PValidatorHash PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PValidatorHash where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PValidatorHash where type PLifted PValidatorHash = Plutus.ValidatorHash deriving via - (DerivePConstantViaNewtype Plutus.ValidatorHash PValidatorHash PByteString) + (DerivePConstantViaBuiltin Plutus.ValidatorHash PValidatorHash PByteString) instance - (PConstant Plutus.ValidatorHash) + PConstantDecl Plutus.ValidatorHash + +instance PTryFrom PData (PAsData PValidatorHash) where + type PTryFromExcess PData (PAsData PValidatorHash) = Flip Term PValidatorHash + ptryFrom' opq = runTermCont $ do + unwrapped <- tcont . plet $ ptryFrom @(PAsData PByteString) opq snd + tcont $ \f -> + pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "ptryFrom(PValidatorHash): must be 28 bytes long") + pure (punsafeCoerce opq, pcon . PValidatorHash $ unwrapped) + +newtype PMintingPolicyHash (s :: S) = PMintingPolicyHash (Term s PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PMintingPolicyHash where type DPTStrat _ = PlutusTypeNewtype + +instance PUnsafeLiftDecl PMintingPolicyHash where type PLifted PMintingPolicyHash = Plutus.MintingPolicyHash +deriving via + (DerivePConstantViaBuiltin Plutus.MintingPolicyHash PMintingPolicyHash PByteString) + instance + PConstantDecl Plutus.MintingPolicyHash + +newtype PScriptHash (s :: S) = PScriptHash (Term s PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PScriptHash where type DPTStrat _ = PlutusTypeNewtype + +instance PUnsafeLiftDecl PScriptHash where type PLifted PScriptHash = Plutus.ScriptHash +deriving via + (DerivePConstantViaBuiltin Plutus.ScriptHash PScriptHash PByteString) + instance + PConstantDecl Plutus.ScriptHash + +newtype Flip f a b = Flip (f b a) deriving stock (Generic) diff --git a/Plutarch/Api/V1/Time.hs b/Plutarch/Api/V1/Time.hs index 44f022666..fd169ba1b 100644 --- a/Plutarch/Api/V1/Time.hs +++ b/Plutarch/Api/V1/Time.hs @@ -1,29 +1,46 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Api.V1.Time ( - PPOSIXTime, + PPOSIXTime (PPOSIXTime), PPOSIXTimeRange, ) where -import qualified Plutus.V1.Ledger.Api as Plutus +import Plutarch.Num (PNum) +import qualified PlutusLedgerApi.V1 as Plutus import Plutarch.Api.V1.Interval (PInterval) import Plutarch.Lift ( DerivePConstantViaNewtype (DerivePConstantViaNewtype), + PConstantDecl, PLifted, PUnsafeLiftDecl, ) import Plutarch.Prelude +import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom')) +import Plutarch.Unsafe (punsafeCoerce) newtype PPOSIXTime (s :: S) = PPOSIXTime (Term s PInteger) - deriving (PlutusType, PIsData, PEq, POrd, PIntegral) via (DerivePNewtype PPOSIXTime PInteger) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd, PIntegral, PNum) +instance DerivePlutusType PPOSIXTime where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PPOSIXTime where type PLifted PPOSIXTime = Plutus.POSIXTime deriving via (DerivePConstantViaNewtype Plutus.POSIXTime PPOSIXTime PInteger) instance - (PConstant Plutus.POSIXTime) + PConstantDecl Plutus.POSIXTime type PPOSIXTimeRange = PInterval PPOSIXTime + +newtype Flip f a b = Flip (f b a) deriving stock (Generic) + +instance PTryFrom PData (PAsData PPOSIXTime) where + type PTryFromExcess PData (PAsData PPOSIXTime) = Flip Term PPOSIXTime + ptryFrom' opq = runTermCont $ do + (wrapped :: Term _ (PAsData PInteger), unwrapped :: Term _ PInteger) <- + tcont $ ptryFrom @(PAsData PInteger) opq + tcont $ \f -> pif (0 #<= unwrapped) (f ()) (ptraceError "ptryFrom(POSIXTime): must be positive") + pure (punsafeCoerce wrapped, pcon $ PPOSIXTime unwrapped) diff --git a/Plutarch/Api/V1/Tx.hs b/Plutarch/Api/V1/Tx.hs index dcd9a52fd..370ba7ca2 100644 --- a/Plutarch/Api/V1/Tx.hs +++ b/Plutarch/Api/V1/Tx.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -8,38 +9,62 @@ module Plutarch.Api.V1.Tx ( PTxInInfo (PTxInInfo), ) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) - -import qualified Plutus.V1.Ledger.Api as Plutus +import qualified PlutusLedgerApi.V1 as Plutus +import Data.Bifunctor (first) import Plutarch.Api.V1.Address (PAddress) import Plutarch.Api.V1.Maybe (PMaybeData) import Plutarch.Api.V1.Scripts (PDatumHash) -import Plutarch.Api.V1.Value (PValue) +import Plutarch.Api.V1.Value ( + AmountGuarantees (Positive), + KeyGuarantees (Sorted), + PValue, + ) +import Plutarch.Builtin (pasConstr) import Plutarch.DataRepr ( DerivePConstantViaData (DerivePConstantViaData), PDataFields, - PIsDataReprInstances (PIsDataReprInstances), ) import Plutarch.Lift ( + PConstantDecl, PLifted, PUnsafeLiftDecl, ) import Plutarch.Prelude +import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom')) +import Plutarch.Unsafe (punsafeCoerce) + +newtype Flip f a b = Flip (f b a) deriving stock (Generic) newtype PTxId (s :: S) = PTxId (Term s (PDataRecord '["_0" ':= PByteString])) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via PIsDataReprInstances PTxId + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq, PPartialOrd, POrd) +instance DerivePlutusType PTxId where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PTxId where type PLifted PTxId = Plutus.TxId -deriving via (DerivePConstantViaData Plutus.TxId PTxId) instance (PConstant Plutus.TxId) +deriving via (DerivePConstantViaData Plutus.TxId PTxId) instance PConstantDecl Plutus.TxId + +instance PTryFrom PData PTxId where + type PTryFromExcess PData PTxId = Flip Term PByteString + ptryFrom' opq cont = ptryFrom @(PAsData PTxId) opq (cont . first punsafeCoerce) +instance PTryFrom PData (PAsData PTxId) where + type PTryFromExcess PData (PAsData PTxId) = Flip Term PByteString + ptryFrom' opq = runTermCont $ do + opq' <- tcont . plet $ pasConstr # opq + tcont $ \f -> + pif (pfstBuiltin # opq' #== 0) (f ()) $ ptraceError "ptryFrom(TxId): invalid constructor id" + flds <- tcont . plet $ psndBuiltin # opq' + let dataBs = phead # flds + tcont $ \f -> + pif (pnil #== ptail # flds) (f ()) $ ptraceError "ptryFrom(TxId): constructor fields len > 1" + unwrapped <- tcont . plet $ ptryFrom @(PAsData PByteString) dataBs snd + tcont $ \f -> + pif (plengthBS # unwrapped #== 28) (f ()) $ ptraceError "ptryFrom(TxId): must be 28 bytes long" + pure (punsafeCoerce opq, unwrapped) + +-- | Reference to a transaction output with a index referencing which of the outputs is being referred to. newtype PTxOutRef (s :: S) = PTxOutRef ( Term @@ -50,16 +75,16 @@ newtype PTxOutRef (s :: S) ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via PIsDataReprInstances PTxOutRef + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq, PPartialOrd, POrd, PTryFrom PData) + +instance DerivePlutusType PTxOutRef where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PTxOutRef where type PLifted PTxOutRef = Plutus.TxOutRef -deriving via (DerivePConstantViaData Plutus.TxOutRef PTxOutRef) instance (PConstant Plutus.TxOutRef) +deriving via (DerivePConstantViaData Plutus.TxOutRef PTxOutRef) instance PConstantDecl Plutus.TxOutRef +instance PTryFrom PData (PAsData PTxOutRef) +-- | A input of the pending transaction. newtype PTxInInfo (s :: S) = PTxInInfo ( Term @@ -70,33 +95,30 @@ newtype PTxInInfo (s :: S) ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via PIsDataReprInstances PTxInInfo + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq) + +instance DerivePlutusType PTxInInfo where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PTxInInfo where type PLifted PTxInInfo = Plutus.TxInInfo -deriving via (DerivePConstantViaData Plutus.TxInInfo PTxInInfo) instance (PConstant Plutus.TxInInfo) +deriving via (DerivePConstantViaData Plutus.TxInInfo PTxInInfo) instance PConstantDecl Plutus.TxInInfo +-- | A transaction output. This consists of a target address, value and maybe a datum hash newtype PTxOut (s :: S) = PTxOut ( Term s ( PDataRecord '[ "address" ':= PAddress - , "value" ':= PValue + , "value" ':= PValue 'Sorted 'Positive -- negative values may appear in a future Cardano version , "datumHash" ':= PMaybeData PDatumHash ] ) ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via (PIsDataReprInstances PTxOut) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq) + +instance DerivePlutusType PTxOut where type DPTStrat _ = PlutusTypeData instance PUnsafeLiftDecl PTxOut where type PLifted PTxOut = Plutus.TxOut -deriving via (DerivePConstantViaData Plutus.TxOut PTxOut) instance (PConstant Plutus.TxOut) +deriving via (DerivePConstantViaData Plutus.TxOut PTxOut) instance PConstantDecl Plutus.TxOut diff --git a/Plutarch/Api/V1/Value.hs b/Plutarch/Api/V1/Value.hs index 0b1655448..4cb776729 100644 --- a/Plutarch/Api/V1/Value.hs +++ b/Plutarch/Api/V1/Value.hs @@ -1,48 +1,486 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +{- | Value-related functionality. In order to keep the interface efficient and + safe at the same time, there is a type-level distinction between 'PValue's + that are guaranteed to be properly normalized and those that provide no + such guarantee. + + Also for efficiency reasons, the Ada-specific functions assume that there + can be only one token name for the Ada currency symbol, and they don't check + whether it matches 'Plutus.adaToken'. +-} module Plutarch.Api.V1.Value ( PValue (PValue), PCurrencySymbol (PCurrencySymbol), PTokenName (PTokenName), + KeyGuarantees (Unsorted, Sorted), + AmountGuarantees (NoGuarantees, NonZero, Positive), + + -- * Conversions and assertions + passertSorted, + passertPositive, + pforgetPositive, + pforgetSorted, + pnormalize, + + -- * Creation + psingleton, + psingletonData, + pconstantSingleton, + pconstantPositiveSingleton, + + -- * Combining values + punionWith, + punionWithData, + + -- * Partial ordering operations + pcheckBinRel, + + -- * Lookups + pvalueOf, + plovelaceValueOf, + + -- * Ada-specific + padaSymbol, + padaSymbolData, + padaToken, + padaTokenData, + pisAdaOnlyValue, + padaOnlyValue, + pnoAdaValue, ) where -import qualified Plutus.V1.Ledger.Api as Plutus -import qualified PlutusTx.Builtins.Internal as PT +import qualified PlutusLedgerApi.V1 as Plutus -import Plutarch.Api.V1.AssocMap (PMap) +import Plutarch.Api.V1.AssocMap (KeyGuarantees (Sorted, Unsorted), PMap (..)) +import qualified Plutarch.Api.V1.AssocMap as AssocMap +import Plutarch.Bool (pand', pif') import Plutarch.Lift ( + DerivePConstantViaBuiltin (DerivePConstantViaBuiltin), DerivePConstantViaNewtype (DerivePConstantViaNewtype), + PConstantDecl, PLifted, PUnsafeLiftDecl, ) -import Plutarch.Prelude +import qualified Plutarch.List as List +import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom')) +import Plutarch.Unsafe (punsafeCoerce, punsafeDowncast) +import qualified PlutusTx.Monoid as PlutusTx +import qualified PlutusTx.Semigroup as PlutusTx + +import Plutarch.Prelude hiding (psingleton) + +newtype Flip f a b = Flip (f b a) deriving stock (Generic) newtype PTokenName (s :: S) = PTokenName (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PTokenName PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PTokenName where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PTokenName where type PLifted PTokenName = Plutus.TokenName deriving via - (DerivePConstantViaNewtype Plutus.TokenName PTokenName PByteString) + (DerivePConstantViaBuiltin Plutus.TokenName PTokenName PByteString) instance - (PConstant Plutus.TokenName) + PConstantDecl Plutus.TokenName + +instance PTryFrom PData (PAsData PTokenName) where + type PTryFromExcess PData (PAsData PTokenName) = Flip Term PTokenName + ptryFrom' opq = runTermCont $ do + unwrapped <- tcont . plet $ ptryFrom @(PAsData PByteString) opq snd + tcont $ \f -> + pif (plengthBS # unwrapped #<= 32) (f ()) (ptraceError "ptryFrom(TokenName): must be at most 32 Bytes long") + pure (punsafeCoerce opq, pcon . PTokenName $ unwrapped) newtype PCurrencySymbol (s :: S) = PCurrencySymbol (Term s PByteString) - deriving (PlutusType, PIsData, PEq, POrd) via (DerivePNewtype PCurrencySymbol PByteString) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PCurrencySymbol where type DPTStrat _ = PlutusTypeNewtype + +instance PTryFrom PData (PAsData PCurrencySymbol) where + type PTryFromExcess PData (PAsData PCurrencySymbol) = Flip Term PCurrencySymbol + ptryFrom' opq = runTermCont $ do + unwrapped <- tcont . plet $ ptryFrom @(PAsData PByteString) opq snd + len <- tcont . plet $ plengthBS # unwrapped + tcont $ \f -> + pif (len #== 0 #|| len #== 28) (f ()) (ptraceError "ptryFrom(CurrencySymbol): must be 28 bytes long or empty") + pure (punsafeCoerce opq, pcon . PCurrencySymbol $ unwrapped) instance PUnsafeLiftDecl PCurrencySymbol where type PLifted PCurrencySymbol = Plutus.CurrencySymbol deriving via - (DerivePConstantViaNewtype Plutus.CurrencySymbol PCurrencySymbol PByteString) + (DerivePConstantViaBuiltin Plutus.CurrencySymbol PCurrencySymbol PByteString) instance - (PConstant Plutus.CurrencySymbol) + PConstantDecl Plutus.CurrencySymbol + +data AmountGuarantees = NoGuarantees | NonZero | Positive -newtype PValue (s :: S) = PValue (Term s (PMap PCurrencySymbol (PMap PTokenName PInteger))) - deriving - (PlutusType, PIsData) - via (DerivePNewtype PValue (PMap PCurrencySymbol (PMap PTokenName PInteger))) +type role PValue nominal nominal nominal +newtype PValue (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S) + = PValue (Term s (PMap keys PCurrencySymbol (PMap keys PTokenName PInteger))) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData) +instance DerivePlutusType (PValue keys amounts) where type DPTStrat _ = PlutusTypeNewtype -instance PUnsafeLiftDecl PValue where type PLifted PValue = Plutus.Value +instance PUnsafeLiftDecl (PValue 'Unsorted 'NonZero) where + type PLifted (PValue 'Unsorted 'NonZero) = Plutus.Value deriving via - (DerivePConstantViaNewtype Plutus.Value PValue (PMap PCurrencySymbol (PMap PTokenName PInteger))) + ( DerivePConstantViaNewtype + Plutus.Value + (PValue 'Unsorted 'NonZero) + (PMap 'Unsorted PCurrencySymbol (PMap 'Unsorted PTokenName PInteger)) + ) instance - (PConstant Plutus.Value) + PConstantDecl Plutus.Value + +instance PEq (PValue 'Sorted 'Positive) where + a #== b = pto a #== pto b + +instance PEq (PValue 'Sorted 'NonZero) where + a #== b = pto a #== pto b + +{- | Partial ordering implementation for sorted 'PValue' with 'Positive' amounts. + +Use 'pcheckBinRel' if 'AmountGuarantees' is 'NoGuarantees'. +-} +instance PPartialOrd (PValue 'Sorted 'Positive) where + a #< b = a' #< pforgetPositive b + where + a' = pforgetPositive a :: Term _ (PValue 'Sorted 'NonZero) + a #<= b = a' #<= pforgetPositive b + where + a' = pforgetPositive a :: Term _ (PValue 'Sorted 'NonZero) + +{- | Partial ordering implementation for sorted 'PValue' with 'NonZero' amounts. + +Use 'pcheckBinRel' if 'AmountGuarantees' is 'NoGuarantees'. +-} +instance PPartialOrd (PValue 'Sorted 'NonZero) where + a #< b = f # a # b + where + f = phoistAcyclic $ pcheckBinRel #$ phoistAcyclic $ plam (#<) + a #<= b = f # a # b + where + f = phoistAcyclic $ pcheckBinRel #$ phoistAcyclic $ plam (#<=) + +instance PEq (PValue 'Sorted 'NoGuarantees) where + a #== b = AssocMap.pall # (AssocMap.pall # plam (#== 0)) # pto (punionWith # plam (-) # a # b) + +instance Semigroup (Term s (PValue 'Sorted 'Positive)) where + a <> b = punsafeDowncast (pto $ punionWith # plam (+) # a # b) + +instance PlutusTx.Semigroup (Term s (PValue 'Sorted 'Positive)) where + a <> b = punsafeDowncast (pto $ punionWith # plam (+) # a # b) + +instance Semigroup (Term s (PValue 'Sorted 'NonZero)) where + a <> b = pnormalize #$ punionWith # plam (+) # a # b + +instance PlutusTx.Semigroup (Term s (PValue 'Sorted 'NonZero)) where + a <> b = pnormalize #$ punionWith # plam (+) # a # b + +instance Semigroup (Term s (PValue 'Sorted 'NoGuarantees)) where + a <> b = punionWith # plam (+) # a # b + +instance PlutusTx.Semigroup (Term s (PValue 'Sorted 'NoGuarantees)) where + a <> b = punionWith # plam (+) # a # b + +instance + Semigroup (Term s (PValue 'Sorted normalization)) => + Monoid (Term s (PValue 'Sorted normalization)) + where + mempty = pcon (PValue AssocMap.pempty) + +instance + PlutusTx.Semigroup (Term s (PValue 'Sorted normalization)) => + PlutusTx.Monoid (Term s (PValue 'Sorted normalization)) + where + mempty = pcon (PValue AssocMap.pempty) + +instance + PlutusTx.Semigroup (Term s (PValue 'Sorted 'NoGuarantees)) => + PlutusTx.Group (Term s (PValue 'Sorted 'NoGuarantees)) + where + inv a = pmapAmounts # plam negate # a + +instance + PlutusTx.Semigroup (Term s (PValue 'Sorted 'NonZero)) => + PlutusTx.Group (Term s (PValue 'Sorted 'NonZero)) + where + inv a = punsafeCoerce $ PlutusTx.inv (punsafeCoerce a :: Term s (PValue 'Sorted 'NoGuarantees)) + +instance PTryFrom PData (PAsData (PValue 'Unsorted 'NoGuarantees)) +instance PTryFrom PData (PAsData (PValue 'Sorted 'NoGuarantees)) + +instance PTryFrom PData (PAsData (PValue 'Sorted 'Positive)) where + type PTryFromExcess PData (PAsData (PValue 'Sorted 'Positive)) = Flip Term (PValue 'Sorted 'Positive) + ptryFrom' opq = runTermCont $ do + (opq', _) <- tcont $ ptryFrom @(PAsData (PValue 'Sorted 'NoGuarantees)) opq + unwrapped <- tcont . plet . papp passertPositive . pfromData $ opq' + pure (punsafeCoerce opq, unwrapped) + +instance PTryFrom PData (PAsData (PValue 'Unsorted 'Positive)) where + type PTryFromExcess PData (PAsData (PValue 'Unsorted 'Positive)) = Flip Term (PValue 'Unsorted 'Positive) + ptryFrom' opq = runTermCont $ do + (opq', _) <- tcont $ ptryFrom @(PAsData (PValue 'Unsorted 'NoGuarantees)) opq + unwrapped <- tcont . plet . papp passertPositive . pfromData $ opq' + pure (punsafeCoerce opq, unwrapped) + +instance PTryFrom PData (PAsData (PValue 'Sorted 'NonZero)) where + type PTryFromExcess PData (PAsData (PValue 'Sorted 'NonZero)) = Flip Term (PValue 'Sorted 'NonZero) + ptryFrom' opq = runTermCont $ do + (opq', _) <- tcont $ ptryFrom @(PAsData (PValue 'Sorted 'NoGuarantees)) opq + unwrapped <- tcont . plet . papp passertNonZero . pfromData $ opq' + pure (punsafeCoerce opq, unwrapped) + +instance PTryFrom PData (PAsData (PValue 'Unsorted 'NonZero)) where + type PTryFromExcess PData (PAsData (PValue 'Unsorted 'NonZero)) = Flip Term (PValue 'Unsorted 'NonZero) + ptryFrom' opq = runTermCont $ do + (opq', _) <- tcont $ ptryFrom @(PAsData (PValue 'Unsorted 'NoGuarantees)) opq + unwrapped <- tcont . plet . papp passertNonZero . pfromData $ opq' + pure (punsafeCoerce opq, unwrapped) + +-- | Construct a constant singleton 'PValue' containing only the given quantity of the given currency. +pconstantSingleton :: + ClosedTerm PCurrencySymbol -> + ClosedTerm PTokenName -> + ClosedTerm PInteger -> + ClosedTerm (PValue 'Sorted 'NonZero) +pconstantSingleton symbol token amount + | plift amount == 0 = mempty + | otherwise = punsafeDowncast (AssocMap.psingleton # symbol #$ AssocMap.psingleton # token # amount) + +-- | Construct a constant singleton 'PValue' containing only the given positive quantity of the given currency. +pconstantPositiveSingleton :: + ClosedTerm PCurrencySymbol -> + ClosedTerm PTokenName -> + ClosedTerm PInteger -> + ClosedTerm (PValue 'Sorted 'Positive) +pconstantPositiveSingleton symbol token amount + | plift amount == 0 = mempty + | plift amount < 0 = error "Negative amount" + | otherwise = punsafeDowncast (AssocMap.psingleton # symbol #$ AssocMap.psingleton # token # amount) + +-- | Construct a singleton 'PValue' containing only the given quantity of the given currency. +psingleton :: + Term + s + (PCurrencySymbol :--> PTokenName :--> PInteger :--> PValue 'Sorted 'NonZero) +psingleton = phoistAcyclic $ + plam $ \symbol token amount -> + pif + (amount #== 0) + mempty + (punsafeDowncast $ AssocMap.psingleton # symbol #$ AssocMap.psingleton # token # amount) + +{- | Construct a singleton 'PValue' containing only the given quantity of the + given currency, taking data-encoded parameters. +-} +psingletonData :: + Term + s + ( PAsData PCurrencySymbol :--> PAsData PTokenName :--> PAsData PInteger + :--> PValue 'Sorted 'NonZero + ) +psingletonData = phoistAcyclic $ + plam $ \symbol token amount -> + pif + (amount #== zeroData) + mempty + ( punsafeDowncast + ( AssocMap.psingletonData # symbol + #$ pdata + $ AssocMap.psingletonData # token # amount + ) + ) + +-- | Get the quantity of the given currency in the 'PValue'. +pvalueOf :: Term s (PValue anyKey anyAmount :--> PCurrencySymbol :--> PTokenName :--> PInteger) +pvalueOf = phoistAcyclic $ + plam $ \value symbol token -> + AssocMap.pfoldAt + # symbol + # 0 + # plam (\map -> AssocMap.pfoldAt # token # 0 # plam pfromData # pfromData map) + # pto value + +-- | The 'PCurrencySymbol' of the Ada currency. +padaSymbol :: Term s PCurrencySymbol +padaSymbol = pconstant Plutus.adaSymbol + +-- | Data-encoded 'PCurrencySymbol' of the Ada currency. +padaSymbolData :: Term s (PAsData PCurrencySymbol) +padaSymbolData = pdata padaSymbol + +-- | The 'PTokenName' of the Ada currency. +padaToken :: Term s PTokenName +padaToken = pconstant Plutus.adaToken + +-- | Data-encoded 'PTokenName' of the Ada currency. +padaTokenData :: Term s (PAsData PTokenName) +padaTokenData = pdata padaToken + +-- | Test if the value contains nothing but Ada +pisAdaOnlyValue :: Term s (PValue 'Sorted 'Positive :--> PBool) +pisAdaOnlyValue = phoistAcyclic $ + plam $ \value -> + pmatch (pto $ pto value) $ \case + PNil -> pcon PTrue + PCons x xs -> pand' # (pnull # xs) # (pfstBuiltin # x #== padaSymbolData) + +-- | Value without any non-Ada +padaOnlyValue :: Term s (PValue 'Sorted v :--> PValue 'Sorted v) +padaOnlyValue = phoistAcyclic $ + plam $ \value -> + pmatch (pto $ pto value) $ \case + PNil -> value + PCons x _ -> + pif' # (pfstBuiltin # x #== padaSymbolData) + # pcon (PValue $ pcon $ AssocMap.PMap $ List.psingleton # x) + # pcon (PValue AssocMap.pempty) + +-- | Value without any Ada +pnoAdaValue :: Term s (PValue 'Sorted v :--> PValue 'Sorted v) +pnoAdaValue = phoistAcyclic $ + plam $ \value -> + pmatch (pto $ pto value) $ \case + PNil -> value + PCons x xs -> pif' # (pfstBuiltin # x #== padaSymbolData) # pcon (PValue $ pcon $ AssocMap.PMap xs) # value + +-- | The amount of Lovelace in value +plovelaceValueOf :: Term s (PValue 'Sorted v :--> PInteger) +plovelaceValueOf = phoistAcyclic $ + plam $ \value -> + pmatch (pto $ pto value) $ \case + PNil -> 0 + PCons x _ -> + pif' # (pfstBuiltin # x #== padaSymbolData) + # pfromData (psndBuiltin #$ phead #$ pto $ pfromData $ psndBuiltin # x) + # 0 + +{- | Combine two 'PValue's applying the given function to any pair of + quantities with the same asset class. Note that the result is _not_ + 'normalize'd and may contain zero quantities. +-} +punionWith :: + Term + s + ( (PInteger :--> PInteger :--> PInteger) :--> PValue 'Sorted any0 :--> PValue 'Sorted any1 + :--> PValue 'Sorted 'NoGuarantees + ) +punionWith = phoistAcyclic $ + plam $ \combine x y -> + pcon . PValue $ + AssocMap.punionWith + # plam (\x y -> AssocMap.punionWith # combine # x # y) + # pto x + # pto y + +{- | Combine two 'PValue's applying the given function to any pair of + data-encoded quantities with the same asset class. Note that the result is + _not_ 'normalize'd and may contain zero quantities. +-} +punionWithData :: + Term + s + ( (PAsData PInteger :--> PAsData PInteger :--> PAsData PInteger) + :--> PValue 'Sorted any0 + :--> PValue 'Sorted any1 + :--> PValue 'Sorted 'NoGuarantees + ) +punionWithData = phoistAcyclic $ + plam $ \combine x y -> + pcon . PValue $ + AssocMap.punionWith + # plam (\x y -> AssocMap.punionWithData # combine # x # y) + # pto x + # pto y + +-- | Normalize the argument to contain no zero quantity nor empty token map. +pnormalize :: Term s (PValue 'Sorted any :--> PValue 'Sorted 'NonZero) +pnormalize = phoistAcyclic $ + plam $ \value -> + pcon . PValue $ + AssocMap.pmapMaybe # plam normalizeTokenMap # pto value + where + normalizeTokenMap tokenMap = + plet (AssocMap.pmapMaybeData # plam nonZero # tokenMap) $ \normalMap -> + pif + (AssocMap.pnull # normalMap) + (pcon PNothing) + (pcon $ PJust normalMap) + nonZero intData = + pif (intData #== zeroData) (pcon PNothing) (pcon $ PJust intData) + +-- | Assert the value is properly sorted and normalized. +passertSorted :: Term s (PValue anyKey anyAmount :--> PValue 'Sorted 'NonZero) +passertSorted = phoistAcyclic $ + plam $ \value -> + pif + ( AssocMap.pany + # plam + ( \submap -> + AssocMap.pnull # (AssocMap.passertSorted # submap) + #|| AssocMap.pany # plam (#== 0) # submap + ) + # pto value + ) + (ptraceError "Abnormal Value") + . pcon + . PValue + $ AssocMap.passertSorted #$ punsafeCoerce $ pto value + +-- | Assert all amounts in the value are positive. +passertPositive :: forall kg ag s. Term s (PValue kg ag :--> PValue kg 'Positive) +passertPositive = phoistAcyclic $ + plam $ \value -> + pif + ( AssocMap.pall + # plam (\submap -> AssocMap.pall # plam (0 #<) # submap) + # pto value + ) + (punsafeDowncast $ pto value) + (ptraceError "Negative amount in Value") + +passertNonZero :: forall kg ag. ClosedTerm (PValue kg ag :--> PValue kg 'NonZero) +passertNonZero = plam $ \val -> + pif (outer #$ pto . pto $ val) (punsafeCoerce val) (ptraceError "Zero amount in Value") + where + outer :: ClosedTerm (PBuiltinList (PBuiltinPair (PAsData PCurrencySymbol) (PAsData (PMap k PTokenName PInteger))) :--> PBool) + outer = pfix #$ plam $ \self m -> + pmatch m $ \case + PCons x xs -> inner # (pto . pfromData $ psndBuiltin # x) #&& self # xs + PNil -> pcon PTrue + inner :: ClosedTerm (PBuiltinList (PBuiltinPair (PAsData PTokenName) (PAsData PInteger)) :--> PBool) + inner = pfix #$ plam $ \self m -> + pmatch m $ \case + PCons x xs -> pnot # (psndBuiltin # x #== pconstantData 0) #&& self # xs + PNil -> pcon PTrue + +-- | Forget the knowledge of value's positivity. +pforgetPositive :: Term s (PValue k 'Positive) -> Term s (PValue k a) +pforgetPositive = punsafeCoerce + +-- | Forget the knowledge of all value's guarantees. +pforgetSorted :: Term s (PValue 'Sorted a) -> Term s (PValue k a) +pforgetSorted = punsafeCoerce + +zeroData :: ClosedTerm (PAsData PInteger) +zeroData = pdata 0 + +-- | Applies a function to every amount in the map. +pmapAmounts :: Term s ((PInteger :--> PInteger) :--> PValue k a :--> PValue k 'NoGuarantees) +pmapAmounts = phoistAcyclic $ + plam $ \f v -> pcon $ PValue $ AssocMap.pmap # plam (AssocMap.pmap # f #) # pto v + +{- | Given an amount comparison function, check whether a binary relation holds over +2 sorted 'PValue's. +-} +pcheckBinRel :: Term s ((PInteger :--> PInteger :--> PBool) :--> PValue 'Sorted any0 :--> PValue 'Sorted any1 :--> PBool) +pcheckBinRel = phoistAcyclic $ + plam $ \f -> + subReduction2 $ + AssocMap.pcheckBinRel # (AssocMap.pcheckBinRel # f # 0) # AssocMap.pempty + where + subReduction2 :: Term s (PInner a :--> PInner b :--> c) -> Term s (a :--> b :--> c) + subReduction2 = punsafeCoerce diff --git a/Plutarch/Api/V2.hs b/Plutarch/Api/V2.hs new file mode 100644 index 000000000..eb349b7e1 --- /dev/null +++ b/Plutarch/Api/V2.hs @@ -0,0 +1,103 @@ +module Plutarch.Api.V2 ( + -- ** Contexts + Contexts.PScriptContext (PScriptContext), + Contexts.PTxInfo (PTxInfo), + Contexts.PScriptPurpose (PMinting, PSpending, PRewarding, PCertifying), + + -- ** Tx + Tx.PTxOutRef (PTxOutRef), + Tx.PTxOut (PTxOut), + Tx.PTxId (PTxId), + Tx.PTxInInfo (PTxInInfo), + Tx.POutputDatum (PNoOutputDatum, POutputDatumHash, POutputDatum), + + -- *** reexports for unchanged V1 ledger types + V1.PMaybeData (PDNothing, PDJust), + V1.PTuple, + V1.PDatum (PDatum), + V1.PDatumHash (PDatumHash), + V1.PAddress (PAddress), + V1.KeyGuarantees (Sorted, Unsorted), + V1.AmountGuarantees (NoGuarantees, Positive), + V1.PScriptHash (PScriptHash), + V1.PPubKeyHash (PPubKeyHash), + V1.PStakingCredential (PStakingHash, PStakingPtr), + type V1.PPOSIXTimeRange, + + -- ** Script Utils + validatorHash, + mintingPolicySymbol, + stakeValidatorHash, + scriptHash, + datumHash, + redeemerHash, + dataHash, + mkValidator, + mkStakeValidator, + mkMintingPolicy, + type PValidator, + type PMintingPolicy, + type PStakeValidator, +) where + +import Data.Coerce (coerce) +import qualified Data.Text as T +import GHC.Stack (HasCallStack) + +import qualified PlutusLedgerApi.V1.Scripts as Plutus + +import Plutarch (Config, compile) +import Plutarch.Prelude + +import qualified Plutarch.Api.V2.Contexts as Contexts +import qualified Plutarch.Api.V2.Tx as Tx + +import Plutarch.Api.Internal.Hashing (hashScriptWithPrefix) +import Plutarch.Api.V1 (dataHash, datumHash, redeemerHash) +import qualified Plutarch.Api.V1.Address as V1 +import qualified Plutarch.Api.V1.Crypto as V1 +import qualified Plutarch.Api.V1.Maybe as V1 +import qualified Plutarch.Api.V1.Scripts as V1 +import qualified Plutarch.Api.V1.Time as V1 +import qualified Plutarch.Api.V1.Tuple as V1 +import qualified Plutarch.Api.V1.Value as V1 +import qualified PlutusLedgerApi.V1.Value as Plutus + +-- On-chain Script Types + +-- | a Validator Term +type PValidator = PData :--> PData :--> Contexts.PScriptContext :--> POpaque + +-- | a MintingPolicy Term +type PMintingPolicy = PData :--> Contexts.PScriptContext :--> POpaque + +-- | a StakeValidator Term +type PStakeValidator = PData :--> Contexts.PScriptContext :--> POpaque + +-- | Compile a Validator +mkValidator :: HasCallStack => Config -> ClosedTerm PValidator -> Plutus.Validator +mkValidator config s = Plutus.Validator $ either (error . T.unpack) id $ compile config s + +-- | Compile a MintingPolicy +mkMintingPolicy :: HasCallStack => Config -> ClosedTerm PMintingPolicy -> Plutus.MintingPolicy +mkMintingPolicy config s = Plutus.MintingPolicy $ either (error . T.unpack) id $ compile config s + +-- | Compile a StakeValidator +mkStakeValidator :: HasCallStack => Config -> ClosedTerm PStakeValidator -> Plutus.StakeValidator +mkStakeValidator config s = Plutus.StakeValidator $ either (error . T.unpack) id $ compile config s + +-- | Hash a Script, with the correct prefix for Plutus V2 +scriptHash :: Plutus.Script -> Plutus.ScriptHash +scriptHash = hashScriptWithPrefix "\x02" + +-- | Hash a Validator, with the correct prefix for Plutus V2 +validatorHash :: Plutus.Validator -> Plutus.ValidatorHash +validatorHash = coerce scriptHash + +-- | Hash a MintingPolicy, with the correct prefix for Plutus V2 +mintingPolicySymbol :: Plutus.MintingPolicy -> Plutus.CurrencySymbol +mintingPolicySymbol = coerce scriptHash + +-- | Hash a StakeValidator, with the correct prefix for Plutus V2 +stakeValidatorHash :: Plutus.StakeValidator -> Plutus.StakeValidatorHash +stakeValidatorHash = coerce scriptHash diff --git a/Plutarch/Api/V2/Contexts.hs b/Plutarch/Api/V2/Contexts.hs new file mode 100644 index 000000000..44db1320d --- /dev/null +++ b/Plutarch/Api/V2/Contexts.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Plutarch.Api.V2.Contexts ( + PScriptContext (PScriptContext), + PTxInfo (PTxInfo), + V1.PScriptPurpose (PMinting, PSpending, PRewarding, PCertifying), +) where + +import qualified Plutarch.Api.V1 as V1 +import Plutarch.Api.V2.Tx (PTxId, PTxInInfo, PTxOut) +import qualified PlutusLedgerApi.V2 as Plutus + +import Plutarch.DataRepr ( + DerivePConstantViaData (DerivePConstantViaData), + PDataFields, + ) + +import Plutarch.Lift ( + PConstantDecl, + PLifted, + PUnsafeLiftDecl, + ) +import Plutarch.Prelude + +-- FIXME: add PDataFields to Prelude + +-- | Script context consists of the script purpose and the pending transaction info. +newtype PScriptContext (s :: S) + = PScriptContext + ( Term + s + ( PDataRecord + '[ "txInfo" ':= PTxInfo + , "purpose" ':= V1.PScriptPurpose + ] + ) + ) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq) + +instance DerivePlutusType PScriptContext where type DPTStrat _ = PlutusTypeData + +instance PUnsafeLiftDecl PScriptContext where type PLifted _ = Plutus.ScriptContext +deriving via (DerivePConstantViaData Plutus.ScriptContext PScriptContext) instance PConstantDecl Plutus.ScriptContext + +-- | A pending transaction. This is the view as seen by the validator script. +newtype PTxInfo (s :: S) + = PTxInfo + ( Term + s + ( PDataRecord + '[ "inputs" ':= PBuiltinList PTxInInfo -- Transaction inputs + , "referenceInputs" ':= PBuiltinList PTxInInfo + , "outputs" ':= PBuiltinList PTxOut -- Transaction outputs + , "fee" ':= V1.PValue 'V1.Sorted 'V1.Positive -- The fee paid by this transaction. + , "mint" ':= V1.PValue 'V1.Sorted 'V1.NoGuarantees -- The value minted by the transaction. + , "dcert" ':= PBuiltinList V1.PDCert -- Digests of the certificates included in this transaction. + , "wdrl" ':= V1.PMap 'V1.Unsorted V1.PStakingCredential PInteger -- Staking withdrawals + , "validRange" ':= V1.PPOSIXTimeRange -- The valid range for the transaction. + , "signatories" ':= PBuiltinList (PAsData V1.PPubKeyHash) -- Signatories attesting that they all signed the tx. + , "redeemers" ':= V1.PMap 'V1.Unsorted V1.PScriptPurpose V1.PRedeemer + , "datums" ':= V1.PMap 'V1.Unsorted V1.PDatumHash V1.PDatum + , "id" ':= PTxId -- The hash of the pending transaction. + ] + ) + ) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq) + +instance DerivePlutusType PTxInfo where type DPTStrat _ = PlutusTypeData + +instance PUnsafeLiftDecl PTxInfo where type PLifted _ = Plutus.TxInfo +deriving via (DerivePConstantViaData Plutus.TxInfo PTxInfo) instance PConstantDecl Plutus.TxInfo diff --git a/Plutarch/Api/V2/Tx.hs b/Plutarch/Api/V2/Tx.hs new file mode 100644 index 000000000..231106576 --- /dev/null +++ b/Plutarch/Api/V2/Tx.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Plutarch.Api.V2.Tx ( + V1.PTxOutRef (PTxOutRef), + PTxOut (PTxOut), + V1.PTxId (PTxId), + PTxInInfo (PTxInInfo), + POutputDatum (POutputDatumHash, PNoOutputDatum, POutputDatum), +) where + +import qualified Plutarch.Api.V1.Address as V1 +import qualified Plutarch.Api.V1.Maybe as V1 +import qualified Plutarch.Api.V1.Scripts as V1 +import qualified Plutarch.Api.V1.Tx as V1 +import qualified Plutarch.Api.V1.Value as V1 +import Plutarch.DataRepr ( + DerivePConstantViaData (DerivePConstantViaData), + PDataFields, + ) +import Plutarch.Lift ( + PConstantDecl, + PLifted, + PUnsafeLiftDecl, + ) +import Plutarch.Prelude +import qualified PlutusLedgerApi.V2 as Plutus + +-- | A transaction output. This consists of a target address, value and maybe a datum hash +newtype PTxOut (s :: S) + = PTxOut + ( Term + s + ( PDataRecord + '[ "address" ':= V1.PAddress + , -- negative values may appear in a future Cardano version + "value" ':= V1.PValue 'V1.Sorted 'V1.Positive + , "datum" ':= POutputDatum + , "referenceScript" ':= V1.PMaybeData V1.PScriptHash + ] + ) + ) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq) + +instance DerivePlutusType PTxOut where type DPTStrat _ = PlutusTypeData + +instance PUnsafeLiftDecl PTxOut where type PLifted PTxOut = Plutus.TxOut +deriving via (DerivePConstantViaData Plutus.TxOut PTxOut) instance PConstantDecl Plutus.TxOut + +-- | A input of the pending transaction. +newtype PTxInInfo (s :: S) + = PTxInInfo + ( Term + s + ( PDataRecord + '[ "outRef" ':= V1.PTxOutRef + , "resolved" ':= PTxOut + ] + ) + ) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PEq) + +instance DerivePlutusType PTxInInfo where type DPTStrat _ = PlutusTypeData + +instance PUnsafeLiftDecl PTxInInfo where type PLifted PTxInInfo = Plutus.TxInInfo +deriving via (DerivePConstantViaData Plutus.TxInInfo PTxInInfo) instance PConstantDecl Plutus.TxInInfo + +-- | The datum attached to an output: either nothing, a datum hash or an inline datum (CIP 32) +data POutputDatum (s :: S) + = PNoOutputDatum (Term s (PDataRecord '[])) + | POutputDatumHash (Term s (PDataRecord '["datumHash" ':= V1.PDatumHash])) + | POutputDatum (Term s (PDataRecord '["outputDatum" ':= V1.PDatum])) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq) + +instance DerivePlutusType POutputDatum where type DPTStrat _ = PlutusTypeData + +instance PUnsafeLiftDecl POutputDatum where type PLifted POutputDatum = Plutus.OutputDatum +deriving via (DerivePConstantViaData Plutus.OutputDatum POutputDatum) instance PConstantDecl Plutus.OutputDatum diff --git a/Plutarch/Bool.hs b/Plutarch/Bool.hs index e5a493ca9..7ca06bb79 100644 --- a/Plutarch/Bool.hs +++ b/Plutarch/Bool.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Bool ( PBool (..), PEq (..), - POrd (..), + PPartialOrd (..), + POrd, pif, pif', pnot, @@ -17,25 +17,37 @@ module Plutarch.Bool ( por', ) where -import Plutarch.Internal.Other ( - DerivePNewtype, +import Data.List.NonEmpty (nonEmpty) +import Generics.SOP ( + All, + All2, + HCollapse (hcollapse), + K (K), + NP, + Proxy (Proxy), + SOP (SOP), + ccompare_NS, + hcliftA2, + ) +import Plutarch.Internal ( PDelayed, - PlutusType (PInner, pcon', pmatch'), S, Term, - pcon, pdelay, pforce, phoistAcyclic, - plam, - pmatch, + plet, + (:-->), + ) +import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom) +import Plutarch.Internal.Other ( pto, - (#), - type (:-->), ) +import Plutarch.Internal.PLam (plam, (#), (#$)) +import Plutarch.Internal.PlutusType (PInner, PlutusType, pcon, pcon', pmatch, pmatch') import Plutarch.Lift ( DerivePConstantDirect (DerivePConstantDirect), - PConstant, + PConstantDecl, PLifted, PUnsafeLiftDecl, pconstant, @@ -45,34 +57,51 @@ import qualified PlutusCore as PLC -- | Plutus 'BuiltinBool' data PBool (s :: S) = PTrue | PFalse + deriving stock (Show) instance PUnsafeLiftDecl PBool where type PLifted PBool = Bool -deriving via (DerivePConstantDirect Bool PBool) instance (PConstant Bool) +deriving via (DerivePConstantDirect Bool PBool) instance PConstantDecl Bool instance PlutusType PBool where - type PInner PBool _ = PBool + type PInner PBool = PBool pcon' PTrue = pconstant True pcon' PFalse = pconstant False pmatch' b f = pforce $ pif' # b # pdelay (f PTrue) # pdelay (f PFalse) class PEq t where (#==) :: Term s t -> Term s t -> Term s PBool + default (#==) :: + (PGeneric t, PlutusType t, All2 PEq (PCode t)) => + Term s t -> + Term s t -> + Term s PBool + a #== b = gpeq # a # b infix 4 #== -class POrd t where +-- | Partial ordering relation. +class PEq t => PPartialOrd t where (#<=) :: Term s t -> Term s t -> Term s PBool + default (#<=) :: (POrd (PInner t)) => Term s t -> Term s t -> Term s PBool + x #<= y = pto x #<= pto y (#<) :: Term s t -> Term s t -> Term s PBool + default (#<) :: (POrd (PInner t)) => Term s t -> Term s t -> Term s PBool + x #< y = pto x #< pto y infix 4 #<= infix 4 #< -instance PEq b => PEq (DerivePNewtype a b) where - x #== y = pto x #== pto y +-- | Total ordering relation. +class PPartialOrd t => POrd t -instance POrd b => POrd (DerivePNewtype a b) where - x #<= y = pto x #<= pto y - x #< y = pto x #< pto y +instance PEq PBool where + x #== y' = plet y' $ \y -> pif' # x # y #$ pnot # y + +instance PPartialOrd PBool where + x #< y = pif' # x # pconstant False # y + x #<= y = pif' # x # y # pconstant True + +instance POrd PBool {- | Strict version of 'pif'. Emits slightly less code. @@ -88,7 +117,7 @@ pif b case_true case_false = pmatch b $ \case -- | Boolean negation for 'PBool' terms. pnot :: Term s (PBool :--> PBool) -pnot = phoistAcyclic $ plam $ \x -> pif x (pcon PFalse) $ pcon PTrue +pnot = phoistAcyclic $ plam $ \x -> pif' # x # pcon PFalse # pcon PTrue -- | Lazily evaluated boolean and for 'PBool' terms. infixr 3 #&& @@ -112,8 +141,42 @@ pand' = phoistAcyclic $ plam $ \x y -> pif' # x # y # (pcon PFalse) -- | Hoisted, Plutarch level, lazily evaluated boolean or function. por :: Term s (PBool :--> PDelayed PBool :--> PDelayed PBool) -por = phoistAcyclic $ plam $ \x y -> pif' # x # (phoistAcyclic $ pdelay $ pcon PTrue) # y +por = phoistAcyclic $ plam $ \x -> pif' # x # (phoistAcyclic $ pdelay $ pcon PTrue) -- | Hoisted, Plutarch level, strictly evaluated boolean or function. por' :: Term s (PBool :--> PBool :--> PBool) -por' = phoistAcyclic $ plam $ \x y -> pif' # x # (pcon PTrue) # y +por' = phoistAcyclic $ plam $ \x -> pif' # x # (pcon PTrue) + +-- | Like Haskell's `and` but for Plutarch terms +pands :: [Term s PBool] -> Term s PBool +pands ts' = + case nonEmpty ts' of + Nothing -> pcon PTrue + Just ts -> foldl1 (#&&) ts + +-- | Generic version of (#==) +gpeq :: + forall t s. + ( PGeneric t + , PlutusType t + , All2 PEq (PCode t) + ) => + Term s (t :--> t :--> PBool) +gpeq = + phoistAcyclic $ + plam $ \x y -> + pmatch x $ \x' -> + pmatch y $ \y' -> + gpeq' (gpfrom x') (gpfrom y') + +gpeq' :: All2 PEq xss => SOP (Term s) xss -> SOP (Term s) xss -> Term s PBool +gpeq' (SOP c1) (SOP c2) = + ccompare_NS (Proxy @(All PEq)) (pcon PFalse) eqProd (pcon PFalse) c1 c2 + +eqProd :: All PEq xs => NP (Term s) xs -> NP (Term s) xs -> Term s PBool +eqProd p1 p2 = + pands $ hcollapse $ hcliftA2 (Proxy :: Proxy PEq) eqTerm p1 p2 + where + eqTerm :: forall s a. PEq a => Term s a -> Term s a -> K (Term s PBool) a + eqTerm a b = + K $ a #== b diff --git a/Plutarch/Builtin.hs b/Plutarch/Builtin.hs index 59d07cfe8..b01ca4932 100644 --- a/Plutarch/Builtin.hs +++ b/Plutarch/Builtin.hs @@ -1,18 +1,16 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE QuantifiedConstraints #-} -{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Builtin ( - PData (..), + PData, pfstBuiltin, psndBuiltin, pasConstr, pasMap, pasList, pasInt, + plistData, pconstantData, pconstrBuiltin, pasByteStr, @@ -20,40 +18,55 @@ module Plutarch.Builtin ( PBuiltinList (..), pdataLiteral, PIsData (..), + pdata, + pfromData, PAsData, pforgetData, + prememberData, + prememberData', + pserialiseData, ppairDataBuiltin, - type PBuiltinMap, + pchooseListBuiltin, ) where -import Data.Coerce (Coercible) +import Data.Functor.Const (Const) +import Data.Proxy (Proxy (Proxy)) +import GHC.Generics (Generic) import Plutarch ( - DerivePNewtype, + DPTStrat, + DerivePlutusType, + PContravariant', + PCovariant, + PCovariant', PInner, PType, + PVariant, + PVariant', PlutusType, + PlutusTypeNewtype, S, Term, pcon, - pcon', pdelay, pforce, phoistAcyclic, plam, plet, pmatch, - pmatch', pto, (#), (#$), type (:-->), ) -import Plutarch.Bool (PBool (..), PEq, pif', (#==)) +import Plutarch.Bool (PBool (..), PEq, pif', (#&&), (#==)) import Plutarch.ByteString (PByteString) import Plutarch.Integer (PInteger) +import Plutarch.Internal.PlutusType (pcon', pmatch') +import Plutarch.Internal.Witness (witness) import Plutarch.Lift ( DerivePConstantDirect (DerivePConstantDirect), PConstant, + PConstantDecl, PConstantRepr, PConstanted, PLift, @@ -63,21 +76,47 @@ import Plutarch.Lift ( pconstantFromRepr, pconstantToRepr, ) -import Plutarch.List (PListLike (..), plistEquals) +import Plutarch.List ( + PListLike ( + PElemConstraint, + pcons, + pelimList, + phead, + pnil, + pnull, + ptail + ), + phead, + plistEquals, + pmap, + pshowList, + ptail, + ) +import Plutarch.Show (PShow (pshow'), pshow) +import Plutarch.TermCont (TermCont (runTermCont), tcont, unTermCont) +import Plutarch.TryFrom (PSubtype, PTryFrom, PTryFromExcess, ptryFrom, ptryFrom', pupcast, pupcastF) import Plutarch.Unit (PUnit) -import Plutarch.Unsafe (punsafeBuiltin, punsafeCoerce, punsafeFrom) +import Plutarch.Unsafe (punsafeBuiltin, punsafeCoerce, punsafeDowncast) import qualified PlutusCore as PLC import PlutusTx (Data (Constr), ToData) import qualified PlutusTx -- | Plutus 'BuiltinPair' -data PBuiltinPair (a :: PType) (b :: PType) (s :: S) +data PBuiltinPair (a :: PType) (b :: PType) (s :: S) = PBuiltinPair (Term s (PBuiltinPair a b)) + +instance PlutusType (PBuiltinPair a b) where + type PInner (PBuiltinPair a b) = PBuiltinPair a b + type PCovariant' (PBuiltinPair a b) = (PCovariant' a, PCovariant' b) + type PContravariant' (PBuiltinPair a b) = (PContravariant' a, PContravariant' b) + type PVariant' (PBuiltinPair a b) = (PVariant' a, PVariant' b) + pcon' (PBuiltinPair x) = x + pmatch' x f = f (PBuiltinPair x) instance (PLift a, PLift b) => PUnsafeLiftDecl (PBuiltinPair a b) where type PLifted (PBuiltinPair a b) = (PLifted a, PLifted b) -- FIXME: figure out good way of deriving this -instance (PConstant a, PConstant b) => PConstant (a, b) where +instance (PConstant a, PConstant b) => PConstantDecl (a, b) where type PConstantRepr (a, b) = (PConstantRepr a, PConstantRepr b) type PConstanted (a, b) = PBuiltinPair (PConstanted a) (PConstanted b) pconstantToRepr (x, y) = (pconstantToRepr x, pconstantToRepr y) @@ -104,6 +143,9 @@ data PBuiltinList (a :: PType) (s :: S) = PCons (Term s a) (Term s (PBuiltinList a)) | PNil +instance (PShow a, PLift a) => PShow (PBuiltinList a) where + pshow' _ x = pshowList @PBuiltinList @a # x + pheadBuiltin :: Term s (PBuiltinList a :--> a) pheadBuiltin = phoistAcyclic $ pforce $ punsafeBuiltin PLC.HeadList @@ -119,17 +161,20 @@ pnullBuiltin = phoistAcyclic $ pforce $ punsafeBuiltin PLC.NullList pconsBuiltin :: Term s (a :--> PBuiltinList a :--> PBuiltinList a) pconsBuiltin = phoistAcyclic $ pforce $ punsafeBuiltin PLC.MkCons -instance PConstant a => PConstant [a] where +instance PConstant a => PConstantDecl [a] where type PConstantRepr [a] = [PConstantRepr a] type PConstanted [a] = PBuiltinList (PConstanted a) pconstantToRepr x = pconstantToRepr <$> x - pconstantFromRepr x = traverse (pconstantFromRepr @a) x + pconstantFromRepr = traverse (pconstantFromRepr @a) instance PUnsafeLiftDecl a => PUnsafeLiftDecl (PBuiltinList a) where type PLifted (PBuiltinList a) = [PLifted a] instance PLift a => PlutusType (PBuiltinList a) where - type PInner (PBuiltinList a) _ = PBuiltinList a + type PInner (PBuiltinList a) = PBuiltinList a + type PCovariant' (PBuiltinList a) = PCovariant' a + type PContravariant' (PBuiltinList a) = PContravariant' a + type PVariant' (PBuiltinList a) = PVariant' a pcon' (PCons x xs) = pconsBuiltin # x # xs pcon' PNil = pconstant [] pmatch' xs' f = plet xs' $ \xs -> @@ -151,31 +196,38 @@ instance PListLike PBuiltinList where ptail = ptailBuiltin pnull = pnullBuiltin -instance (PLift a, PEq a) => PEq (PBuiltinList a) where - (#==) xs ys = plistEquals # xs # ys +type family F (a :: PType) :: Bool where + F PData = 'True + F (PAsData _) = 'True + F _ = 'False -data PData s - = PDataConstr (Term s (PBuiltinPair PInteger (PBuiltinList PData))) - | PDataMap (Term s (PBuiltinList (PBuiltinPair PData PData))) - | PDataList (Term s (PBuiltinList PData)) - | PDataInteger (Term s PInteger) - | PDataByteString (Term s PByteString) +class Fc (x :: Bool) (a :: PType) where + fc :: Proxy x -> Term s (PBuiltinList a) -> Term s (PBuiltinList a) -> Term s PBool -instance PUnsafeLiftDecl PData where type PLifted PData = Data -deriving via (DerivePConstantDirect Data PData) instance (PConstant Data) +instance (PLift a, PEq a) => Fc 'False a where + fc _ xs ys = plistEquals # xs # ys -instance PEq PData where - x #== y = punsafeBuiltin PLC.EqualsData # x # y +instance PIsData (PBuiltinList a) => Fc 'True a where + fc _ xs ys = pdata xs #== pdata ys -{- | - Map type used for Plutus `Data`'s Map constructor. +instance Fc (F a) a => PEq (PBuiltinList a) where + (#==) = fc (Proxy @(F a)) - Note that the Plutus API doesn't use this most of the time, - instead encoding as a List of Tuple constructors. +data PData (s :: S) = PData (Term s PData) - Not to be confused with `PlutusTx.AssocMap.Map` / `PMap` --} -type PBuiltinMap a b = (PBuiltinList (PBuiltinPair (PAsData a) (PAsData b))) +instance PlutusType PData where + type PInner PData = PData + type PCovariant' PData = () + type PContravariant' PData = () + type PVariant' PData = () + pcon' (PData t) = t + pmatch' t f = f (PData t) + +instance PUnsafeLiftDecl PData where type PLifted PData = Data +deriving via (DerivePConstantDirect Data PData) instance PConstantDecl Data + +instance PEq PData where + x #== y = punsafeBuiltin PLC.EqualsData # x # y pasConstr :: Term s (PData :--> PBuiltinPair PInteger (PBuiltinList PData)) pasConstr = punsafeBuiltin PLC.UnConstrData @@ -183,6 +235,9 @@ pasConstr = punsafeBuiltin PLC.UnConstrData pasMap :: Term s (PData :--> PBuiltinList (PBuiltinPair PData PData)) pasMap = punsafeBuiltin PLC.UnMapData +plistData :: Term s (PBuiltinList PData :--> PData) +plistData = punsafeBuiltin PLC.ListData + pasList :: Term s (PData :--> PBuiltinList PData) pasList = punsafeBuiltin PLC.UnListData @@ -192,16 +247,32 @@ pasInt = punsafeBuiltin PLC.UnIData pasByteStr :: Term s (PData :--> PByteString) pasByteStr = punsafeBuiltin PLC.UnBData +-- | Serialise any builtin data to its cbor represented by a builtin bytestring +pserialiseData :: Term s (PData :--> PByteString) +pserialiseData = punsafeBuiltin PLC.SerialiseData + {-# DEPRECATED pdataLiteral "Use `pconstant` instead." #-} pdataLiteral :: Data -> Term s PData pdataLiteral = pconstant -type role PAsData representational phantom -data PAsData (a :: PType) (s :: S) +data PAsData (a :: PType) (s :: S) = PAsData (Term s a) + +type family IfSameThenData (a :: PType) (b :: PType) :: PType where + IfSameThenData a a = PData + IfSameThenData _ b = PAsData b +instance PIsData a => PlutusType (PAsData a) where + type PInner (PAsData a) = IfSameThenData a (PInner a) + type PCovariant' (PAsData a) = PCovariant' a + type PContravariant' (PAsData a) = PContravariant' a + type PVariant' (PAsData a) = PVariant' a + pcon' (PAsData t) = punsafeCoerce $ pdata t + pmatch' t f = f (PAsData $ pfromData $ punsafeCoerce t) + +type role PAsDataLifted nominal data PAsDataLifted (a :: PType) -instance PConstant (PAsDataLifted a) where +instance PConstantDecl (PAsDataLifted a) where type PConstantRepr (PAsDataLifted a) = Data type PConstanted (PAsDataLifted a) = PAsData a pconstantToRepr = \case {} @@ -209,32 +280,64 @@ instance PConstant (PAsDataLifted a) where instance PUnsafeLiftDecl (PAsData a) where type PLifted (PAsData a) = PAsDataLifted a -pforgetData :: Term s (PAsData a) -> Term s PData +pforgetData :: forall s a. Term s (PAsData a) -> Term s PData pforgetData = punsafeCoerce +-- FIXME: remove, broken + +{- | Like 'pforgetData', except it works for complex types. + Equivalent to 'pupcastF'. +-} +pforgetData' :: forall a (p :: PType -> PType) s. PCovariant p => Proxy p -> Term s (p (PAsData a)) -> Term s (p PData) +pforgetData' _ = let _ = witness (Proxy @(PCovariant p)) in punsafeCoerce + +-- | Inverse of 'pforgetData''. +prememberData :: forall (p :: PType -> PType) s. PVariant p => Proxy p -> Term s (p PData) -> Term s (p (PAsData PData)) +prememberData Proxy = let _ = witness (Proxy @(PVariant p)) in punsafeCoerce + +-- | Like 'prememberData' but generalised. +prememberData' :: forall a (p :: PType -> PType) s. (PSubtype PData a, PVariant p) => Proxy p -> Term s (p a) -> Term s (p (PAsData a)) +prememberData' Proxy = let _ = witness (Proxy @(PSubtype PData a, PVariant p)) in punsafeCoerce + +{- | Laws: + - If @PSubtype PData a@, then @pdataImpl a@ must be `pupcast`. + - pdataImpl . pupcast . pfromDataImpl ≡ id + - pfromDataImpl . punsafeDowncast . pdataImpl ≡ id +-} class PIsData a where - pfromData :: Term s (PAsData a) -> Term s a - pdata :: Term s a -> Term s (PAsData a) + pfromDataImpl :: Term s (PAsData a) -> Term s a + default pfromDataImpl :: PIsData (PInner a) => Term s (PAsData a) -> Term s a + pfromDataImpl x = punsafeDowncast $ pfromDataImpl (punsafeCoerce x :: Term _ (PAsData (PInner a))) + + pdataImpl :: Term s a -> Term s PData + default pdataImpl :: PIsData (PInner a) => Term s a -> Term s PData + pdataImpl x = pdataImpl $ pto x + +pfromData :: PIsData a => Term s (PAsData a) -> Term s a +pfromData = pfromDataImpl +pdata :: PIsData a => Term s a -> Term s (PAsData a) +pdata = punsafeCoerce . pdataImpl instance PIsData PData where - pfromData = punsafeCoerce - pdata = punsafeCoerce + pfromDataImpl = pupcast + pdataImpl = id -instance PIsData a => PIsData (PBuiltinList (PAsData a)) where - pfromData x = punsafeCoerce $ pasList # pforgetData x - pdata x = punsafeBuiltin PLC.ListData # x +instance forall (a :: PType). PSubtype PData a => PIsData (PBuiltinList a) where + pfromDataImpl x = punsafeCoerce $ pasList # pforgetData x + pdataImpl x = plistData # pupcastF @PData @a (Proxy @PBuiltinList) x -instance PIsData (PBuiltinMap k v) where - pfromData x = punsafeCoerce $ pasMap # pforgetData x - pdata x = punsafeBuiltin PLC.MapData # x +newtype Helper2 f a s = Helper2 (Term s (PAsData (f a))) + deriving stock (Generic) + deriving anyclass (PlutusType) +instance DerivePlutusType (Helper2 f a) where type DPTStrat _ = PlutusTypeNewtype instance PIsData PInteger where - pfromData x = pasInt # pforgetData x - pdata x = punsafeBuiltin PLC.IData # x + pfromDataImpl x = pasInt # pforgetData x + pdataImpl x = punsafeBuiltin PLC.IData # x instance PIsData PByteString where - pfromData x = pasByteStr # pforgetData x - pdata x = punsafeBuiltin PLC.BData # x + pfromDataImpl x = pasByteStr # pforgetData x + pdataImpl x = punsafeBuiltin PLC.BData # x {- | Instance for PBool following the Plutus IsData repr @@ -242,16 +345,16 @@ instance PIsData PByteString where which is used in 'TxInfo' via 'Closure'. -} instance PIsData PBool where - pfromData x = - (phoistAcyclic $ plam toBool) # pforgetData x + pfromDataImpl x = + phoistAcyclic (plam toBool) # pforgetData x where toBool :: Term s PData -> Term s PBool toBool d = pfstBuiltin # (pasConstr # d) #== 1 - pdata x = - (phoistAcyclic $ plam toData) # x + pdataImpl x = + phoistAcyclic (plam toData) # x where - toData :: Term s PBool -> Term s (PAsData PBool) + toData :: Term s PBool -> Term s PData toData b = punsafeBuiltin PLC.ConstrData # (pif' # b # 1 # (0 :: Term s PInteger)) @@ -262,49 +365,152 @@ instance PIsData PBool where -- | NB: `PAsData (PBuiltinPair (PAsData a) (PAsData b))` and `PAsData (PTuple a b)` have the same representation. instance PIsData (PBuiltinPair (PAsData a) (PAsData b)) where - pfromData x = f # x + pfromDataImpl x = f # x where f = phoistAcyclic $ plam $ \pairDat -> plet (psndBuiltin #$ pasConstr # pforgetData pairDat) $ \pd -> ppairDataBuiltin # punsafeCoerce (phead # pd) #$ punsafeCoerce (phead #$ ptail # pd) - pdata x = punsafeCoerce target + pdataImpl x = pupcast target where target :: Term _ (PAsData (PBuiltinPair PInteger (PBuiltinList PData))) target = f # punsafeCoerce x f = phoistAcyclic $ plam $ \pair -> pconstrBuiltin # 0 #$ pcons # (pfstBuiltin # pair) #$ pcons # (psndBuiltin # pair) # pnil +newtype Helper3 f b a s = Helper3 (Term s (PAsData (f a b))) + deriving stock (Generic) + deriving anyclass (PlutusType) +instance DerivePlutusType (Helper3 f b a) where type DPTStrat _ = PlutusTypeNewtype + +newtype Helper4 f b a s = Helper4 (Term s (f a b)) + deriving stock (Generic) + deriving anyclass (PlutusType) +instance DerivePlutusType (Helper4 f b a) where type DPTStrat _ = PlutusTypeNewtype + +instance PIsData (PBuiltinPair PData PData) where + pfromDataImpl = f . pfromData . g + where + g :: Term s (PAsData (PBuiltinPair PData PData)) -> Term s (PAsData (PBuiltinPair (PAsData PData) (PAsData PData))) + g x = pto $ prememberData (Proxy @(Helper3 PBuiltinPair (PAsData PData))) $ pcon $ Helper3 $ pto $ prememberData (Proxy @(Helper2 (PBuiltinPair PData))) $ pcon $ Helper2 x + + f :: Term s (PBuiltinPair (PAsData PData) (PAsData PData)) -> Term s (PBuiltinPair PData PData) + f x = pto $ pforgetData' (Proxy @(Helper4 PBuiltinPair PData)) $ pcon $ Helper4 $ pforgetData' @PData (Proxy @(PBuiltinPair (PAsData PData))) x + pdataImpl = pupcast . f . pdata . g + where + g :: Term s (PBuiltinPair PData PData) -> Term s (PBuiltinPair (PAsData PData) (PAsData PData)) + g x = pto $ prememberData (Proxy @(Helper4 PBuiltinPair (PAsData PData))) $ pcon $ Helper4 $ prememberData (Proxy @(PBuiltinPair PData)) x + + f :: Term s (PAsData (PBuiltinPair (PAsData PData) (PAsData PData))) -> Term s (PAsData (PBuiltinPair PData PData)) + f x = pto $ pforgetData' @PData (Proxy @(Helper3 PBuiltinPair PData)) $ pcon $ Helper3 $ pto $ pforgetData' @PData (Proxy @(Helper2 (PBuiltinPair (PAsData PData)))) $ pcon $ Helper2 x + +instance (PShow a, PShow b) => PShow (PBuiltinPair a b) where + pshow' _ pair = "(" <> pshow (pfstBuiltin # pair) <> "," <> pshow (psndBuiltin # pair) <> ")" + +instance (PEq a, PEq b) => PEq (PBuiltinPair a b) where + p1 #== p2 = pfstBuiltin # p1 #== pfstBuiltin # p2 #&& psndBuiltin # p1 #== psndBuiltin # p2 + instance PIsData PUnit where - pfromData _ = pconstant () - pdata _ = punsafeCoerce $ pconstant (Constr 0 []) + pfromDataImpl _ = pconstant () + pdataImpl _ = pconstant (Constr 0 []) -- This instance is kind of useless. There's no safe way to use 'pdata'. instance PIsData (PBuiltinPair PInteger (PBuiltinList PData)) where - pfromData x = pasConstr # pforgetData x - pdata x' = plet x' $ \x -> pconstrBuiltin # (pfstBuiltin # x) #$ psndBuiltin # x + pfromDataImpl x = pasConstr # pupcast x + pdataImpl x' = pupcast $ plet x' $ \x -> pconstrBuiltin # (pfstBuiltin # x) #$ psndBuiltin # x instance PEq (PAsData a) where x #== y = punsafeBuiltin PLC.EqualsData # x # y -instance (forall (s :: S). Coercible (a s) (Term s b), PIsData b) => PIsData (DerivePNewtype a b) where - pfromData x = punsafeFrom target - where - target :: Term _ b - target = pfromData $ pinnerData x - pdata x = pouterData . pdata $ pto x - -pinnerData :: Term s (PAsData a) -> Term s (PAsData (PInner a b)) -pinnerData = punsafeCoerce - -pouterData :: Term s (PAsData (PInner a b)) -> Term s (PAsData a) -pouterData = punsafeCoerce +instance (PIsData a, PShow a) => PShow (PAsData a) where + pshow' w x = pshow' w (pfromData x) pconstrBuiltin :: Term s (PInteger :--> PBuiltinList PData :--> PAsData (PBuiltinPair PInteger (PBuiltinList PData))) -pconstrBuiltin = punsafeBuiltin $ PLC.ConstrData +pconstrBuiltin = punsafeBuiltin PLC.ConstrData {- | Create a Plutarch-level 'PAsData' constant, from a Haskell value. Example: > pconstantData @PInteger 42 -} pconstantData :: forall p h s. (ToData h, PLifted p ~ h, PConstanted h ~ p) => h -> Term s (PAsData p) -pconstantData x = punsafeCoerce $ pconstant $ PlutusTx.toData x +pconstantData x = let _ = witness (Proxy @(PLifted p ~ h, PConstanted h ~ p)) in punsafeCoerce $ pconstant $ PlutusTx.toData x + +newtype Flip f a b = Flip (f b a) deriving stock (Generic) + +instance PTryFrom PData (PAsData PInteger) where + type PTryFromExcess PData (PAsData PInteger) = Flip Term PInteger + ptryFrom' opq = runTermCont $ do + ver <- tcont $ plet (pasInt # opq) + pure (punsafeCoerce opq, ver) + +instance PTryFrom PData (PAsData PByteString) where + type PTryFromExcess PData (PAsData PByteString) = Flip Term PByteString + ptryFrom' opq = runTermCont $ do + ver <- tcont $ plet (pasByteStr # opq) + pure (punsafeCoerce opq, ver) + +{- | + This verifies a list to be indeed a list but doesn't recover the inner data + use this instance instead of the one for `PData (PAsData (PBuiltinList (PAsData a)))` + as this is O(1) instead of O(n) +-} + +-- TODO: add the excess inner type list +instance PTryFrom PData (PAsData (PBuiltinList PData)) where + type PTryFromExcess PData (PAsData (PBuiltinList PData)) = Flip Term (PBuiltinList PData) + ptryFrom' opq = runTermCont $ do + ver <- tcont $ plet (pasList # opq) + pure (punsafeCoerce opq, ver) + +{- | + Recover a `PBuiltinList (PAsData a)` +-} +instance + ( PTryFrom PData (PAsData a) + , PIsData a + ) => + PTryFrom PData (PAsData (PBuiltinList (PAsData a))) + where + type PTryFromExcess PData (PAsData (PBuiltinList (PAsData a))) = Flip Term (PBuiltinList (PAsData a)) + ptryFrom' opq = runTermCont $ do + let lst :: Term _ (PBuiltinList PData) + lst = pasList # opq + verify :: Term _ (PData :--> PAsData a) + verify = plam $ \e -> + unTermCont $ do + (wrapped, _) <- tcont $ ptryFrom @(PAsData a) $ e + pure wrapped + ver <- tcont $ plet $ pmap # verify # lst + pure (punsafeCoerce opq, ver) + +{- | + Recover a `PAsData (PBuiltinPair a b)` +-} +instance + ( PTryFrom PData a + , a ~ PAsData a' + , PIsData a' + , PTryFrom PData b + , b ~ PAsData b' + , PIsData b' + ) => + PTryFrom PData (PAsData (PBuiltinPair a b)) + where + type PTryFromExcess PData (PAsData (PBuiltinPair a b)) = Flip Term (PBuiltinPair a b) + ptryFrom' opq = runTermCont $ do + tup <- tcont $ plet (pfromData $ punsafeCoerce opq) + let fst' :: Term _ a + fst' = unTermCont $ fst <$> tcont (ptryFrom @a $ pforgetData $ pfstBuiltin # tup) + snd' :: Term _ b + snd' = unTermCont $ fst <$> tcont (ptryFrom @b $ pforgetData $ psndBuiltin # tup) + ver <- tcont $ plet $ ppairDataBuiltin # fst' # snd' + pure (punsafeCoerce opq, ver) + +----------------------- other utility functions ----------------------------------------- + +instance PTryFrom PData (PAsData PData) where + type PTryFromExcess PData (PAsData PData) = Const () + ptryFrom' opq = runTermCont $ pure (pdata opq, ()) + +instance PTryFrom PData PData where + type PTryFromExcess PData PData = Const () + ptryFrom' opq f = f (opq, ()) diff --git a/Plutarch/ByteString.hs b/Plutarch/ByteString.hs index 4b0f46d4d..4cc00d678 100644 --- a/Plutarch/ByteString.hs +++ b/Plutarch/ByteString.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -15,17 +16,18 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Char (toLower) import Data.Word (Word8) +import GHC.Generics (Generic) import GHC.Stack (HasCallStack) -import Plutarch.Bool (PEq, POrd, (#<), (#<=), (#==)) +import Plutarch.Bool (PEq, POrd, PPartialOrd, (#<), (#<=), (#==)) import Plutarch.Integer (PInteger) -import Plutarch.Internal.Other ( - Term, - (#), - type (:-->), - ) +import Plutarch.Internal (Term, (:-->)) +import Plutarch.Internal.Newtype (PlutusTypeNewtype) +import Plutarch.Internal.Other (POpaque) +import Plutarch.Internal.PLam ((#)) +import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType) import Plutarch.Lift ( DerivePConstantDirect (DerivePConstantDirect), - PConstant, + PConstantDecl, PLifted, PUnsafeLiftDecl, pconstant, @@ -34,18 +36,24 @@ import Plutarch.Unsafe (punsafeBuiltin) import qualified PlutusCore as PLC -- | Plutus 'BuiltinByteString' -data PByteString s +data PByteString s = PByteString (Term s POpaque) + deriving stock (Generic) + deriving anyclass (PlutusType) + +instance DerivePlutusType PByteString where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PByteString where type PLifted PByteString = ByteString -deriving via (DerivePConstantDirect ByteString PByteString) instance (PConstant ByteString) +deriving via (DerivePConstantDirect ByteString PByteString) instance PConstantDecl ByteString instance PEq PByteString where x #== y = punsafeBuiltin PLC.EqualsByteString # x # y -instance POrd PByteString where +instance PPartialOrd PByteString where x #<= y = punsafeBuiltin PLC.LessThanEqualsByteString # x # y x #< y = punsafeBuiltin PLC.LessThanByteString # x # y +instance POrd PByteString + instance Semigroup (Term s PByteString) where x <> y = punsafeBuiltin PLC.AppendByteString # x # y @@ -92,6 +100,7 @@ pindexBS = punsafeBuiltin PLC.IndexByteString hexDigitToWord8 :: HasCallStack => Char -> Word8 hexDigitToWord8 = f . toLower where + f :: Char -> Word8 f '0' = 0 f '1' = 1 f '2' = 2 diff --git a/Plutarch/Crypto.hs b/Plutarch/Crypto.hs index a1b44f2e4..f0b441e70 100644 --- a/Plutarch/Crypto.hs +++ b/Plutarch/Crypto.hs @@ -1,8 +1,14 @@ module Plutarch.Crypto ( + -- ** from V1 psha2_256, psha3_256, pblake2b_256, pverifySignature, + pverifyEd25519Signature, + + -- ** from V2 + pverifyEcdsaSecp256k1Signature, + pverifySchnorrSecp256k1Signature, ) where import Plutarch ( @@ -11,7 +17,6 @@ import Plutarch ( ) import Plutarch.Unsafe (punsafeBuiltin) --- import Plutarch.Api.V1 (PDatumHash, PPubKey (..), PPubKeyHash (..), PSignature (..)) import Plutarch.Bool (PBool) import Plutarch.ByteString (PByteString) import qualified PlutusCore as PLC @@ -30,4 +35,23 @@ pblake2b_256 = punsafeBuiltin PLC.Blake2b_256 -- | Verify the signature against the public key and message. pverifySignature :: Term s (PByteString :--> PByteString :--> PByteString :--> PBool) -pverifySignature = punsafeBuiltin PLC.VerifySignature +pverifySignature = pverifyEd25519Signature +{-# DEPRECATED pverifySignature "use one of the Ed25519, Schnorr- or ECDSA Secp256k1 signature verification functions" #-} + +{- | Verify an ED25519 signature + arguments are in this order: pubkey, message, signature +-} +pverifyEd25519Signature :: Term s (PByteString :--> PByteString :--> PByteString :--> PBool) +pverifyEd25519Signature = punsafeBuiltin PLC.VerifyEd25519Signature + +{- | Verify an ECDSA SECP256k1 signature + arguments are in this order: pubkey, message, signature +-} +pverifyEcdsaSecp256k1Signature :: Term s (PByteString :--> PByteString :--> PByteString :--> PBool) +pverifyEcdsaSecp256k1Signature = punsafeBuiltin PLC.VerifyEcdsaSecp256k1Signature + +{- | Verify a Schnorr SECP256k1 signature + arguments are in this order: pubkey, message, signature +-} +pverifySchnorrSecp256k1Signature :: Term s (PByteString :--> PByteString :--> PByteString :--> PBool) +pverifySchnorrSecp256k1Signature = punsafeBuiltin PLC.VerifySchnorrSecp256k1Signature diff --git a/Plutarch/DataRepr.hs b/Plutarch/DataRepr.hs index 181952638..b0f5abf25 100644 --- a/Plutarch/DataRepr.hs +++ b/Plutarch/DataRepr.hs @@ -1,6 +1,6 @@ module Plutarch.DataRepr ( -- * DataRepr - I.PDataSum, + I.PDataSum (PDataSum), I.punDataSum, I.ptryIndexDataSum, I.DataReprHandlers (DRHNil, DRHCons), @@ -8,20 +8,21 @@ module Plutarch.DataRepr ( I.pdcons, I.pdnil, I.PLabeledType ((:=)), - I.PIsDataRepr (type PIsDataReprRepr, pmatchRepr), - I.pmatchDataSum, - I.PIsDataReprInstances (PIsDataReprInstances), I.pindexDataRecord, I.pdropDataRecord, I.DerivePConstantViaData (DerivePConstantViaData), - I.pasDataSum, + I.PConstantData, + I.PLiftData, + I.PlutusTypeData, -- * Fields F.PDataFields (ptoFields, type PFields), F.pletFields, F.pfield, - F.hrecField, F.HRec, + F.HRecOf, + F.PMemberFields, + F.PMemberField, ) where import qualified Plutarch.DataRepr.Internal as I diff --git a/Plutarch/DataRepr/Internal.hs b/Plutarch/DataRepr/Internal.hs index 2fa9806db..48ceff01d 100644 --- a/Plutarch/DataRepr/Internal.hs +++ b/Plutarch/DataRepr/Internal.hs @@ -1,133 +1,219 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans -Wno-redundant-constraints #-} +{-# LANGUAGE UndecidableSuperClasses #-} module Plutarch.DataRepr.Internal ( - PDataSum, + PDataSum (..), punDataSum, ptryIndexDataSum, - pmatchDataSum, pdcons, pdnil, DataReprHandlers (..), + PConstantData, PDataRecord (..), + PLiftData, PLabeledType (..), type PLabelIndex, type PUnLabel, - PIsDataRepr (..), - PIsDataReprInstances (..), + type PLookupLabel, pindexDataRecord, pdropDataRecord, DerivePConstantViaData (..), - pasDataSum, + DualReprHandler (..), + PlutusTypeData, ) where -import Data.Kind (Type) +import Data.Coerce (coerce) +import qualified Data.Functor.Compose as F +import Data.Functor.Const (Const (Const)) +import Data.Kind (Constraint, Type) import Data.List (groupBy, maximumBy, sortOn) import Data.Proxy (Proxy (Proxy)) +import Data.SOP.NP (cana_NP) +import GHC.Generics (Generic) import GHC.TypeLits ( - ErrorMessage (ShowType, Text, (:<>:)), KnownNat, Nat, Symbol, - TypeError, natVal, type (+), ) import Generics.SOP ( All, - All2, - AllZipN, - Code, - Generic, - I (I), + Compose, K (K), - LiftedCoercible, NP (Nil, (:*)), - POP, + NS (S, Z), SListI, SOP (SOP), - from, - hcmap, + case_SList, hcollapse, - hfromI, hindex, - to, + hmap, + para_SList, ) import Plutarch ( Dig, PInner, - PMatch, + POpaque, PType, PlutusType, S, Term, - pcon', + pcon, + pdelay, perror, + pforce, phoistAcyclic, plam, plet, - pmatch', + pmatch, + popaque, pto, (#), (#$), type (:-->), ) -import Plutarch.Bool (pif, (#==)) +import Plutarch.Bool (PBool, PEq, POrd, PPartialOrd, pif, (#<), (#<=), (#==)) import Plutarch.Builtin ( PAsData, PBuiltinList, - PBuiltinPair, PData, PIsData, pasConstr, + pchooseListBuiltin, pconstrBuiltin, pdata, + pdataImpl, pforgetData, pfromData, + pfromDataImpl, pfstBuiltin, psndBuiltin, ) -import Plutarch.DataRepr.Internal.Generic (MkSum (mkSum)) -import Plutarch.DataRepr.Internal.HList (type Drop, type IndexList) +import Plutarch.DataRepr.Internal.HList ( + HRec (HCons, HNil), + HRecGeneric (HRecGeneric), + Labeled (Labeled), + type Drop, + type IndexList, + ) import Plutarch.Integer (PInteger) -import Plutarch.Internal (S (SI)) -import Plutarch.Internal.TypeFamily (ToPType2) -import Plutarch.Lift (PConstant, PConstantRepr, PConstanted, PLift, pconstant, pconstantFromRepr, pconstantToRepr) +import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom, gpto) +import Plutarch.Internal.PlutusType ( + DerivedPInner, + PlutusTypeStrat, + PlutusTypeStratConstraint, + derivedPCon, + derivedPMatch, + pcon', + pmatch', + ) +import Plutarch.Lift ( + PConstant, + PConstantDecl, + PConstantRepr, + PConstanted, + PLift, + PLifted, + pconstant, + pconstantFromRepr, + pconstantToRepr, + ) import Plutarch.List (PListLike (pnil), pcons, pdrop, phead, ptail, ptryIndex) -import Plutarch.TermCont (TermCont, hashOpenTerm, runTermCont) +import Plutarch.TermCont (TermCont, hashOpenTerm, runTermCont, tcont, unTermCont) +import Plutarch.Trace (ptraceError) +import Plutarch.TryFrom (PSubtype, PSubtype', PTryFrom, PTryFromExcess, ptryFrom, ptryFrom', pupcast) +import Plutarch.Unit (PUnit (PUnit)) import Plutarch.Unsafe (punsafeCoerce) -import qualified Plutus.V1.Ledger.Api as Ledger +import qualified PlutusLedgerApi.V1 as Ledger + +import Plutarch.Reducible (NoReduce, Reduce) {- | A "record" of `exists a. PAsData a`. The underlying representation is `PBuiltinList PData`. -} data PDataRecord (as :: [PLabeledType]) (s :: S) where PDCons :: - forall name x xs s. + forall name_x x xs s. + PUnLabel name_x ~ x => Term s (PAsData x) -> (Term s (PDataRecord xs)) -> - PDataRecord ((name ':= x) ': xs) s + -- GHC bug prevents `name ':= x` from working well + PDataRecord (name_x ': xs) s PDNil :: PDataRecord '[] s -instance PlutusType (PDataRecord ((name ':= x) ': xs)) where - type PInner (PDataRecord ((name ':= x) ': xs)) _ = PBuiltinList PData - pcon' (PDCons x xs) = pto result - where - result :: Term _ (PDataRecord ((name ':= x) ': xs)) - result = pdcons # x # xs - pmatch' l' f = plet l' $ \l -> - let x :: Term _ (PAsData x) - x = punsafeCoerce $ phead # l - xs :: Term _ (PDataRecord xs) - xs = punsafeCoerce $ ptail # l - in f $ PDCons x xs - -instance PlutusType (PDataRecord '[]) where - type PInner (PDataRecord '[]) _ = PBuiltinList PData - pcon' PDNil = pnil - pmatch' _ f = f PDNil +newtype H s (l :: [PLabeledType]) = H {unH :: forall r. (PDataRecord l s -> Term s r) -> Term s r} + +instance SListI l => PlutusType (PDataRecord l) where + type PInner (PDataRecord l) = PBuiltinList PData + pcon' :: PDataRecord l s -> Term s (PBuiltinList PData) + pcon' (PDCons x xs) = pcons # pforgetData x # pto xs + pcon' PDNil = pcon' PDNil + pmatch' :: Term s (PBuiltinList PData) -> (PDataRecord l s -> Term s b) -> Term s b + pmatch' l' = unH $ + case_SList + (H $ \f -> f PDNil) + $ H $ \f -> + plet l' \l -> + let x :: Term _ (PAsData x) + x = punsafeCoerce $ phead # l + xs :: Term _ (PDataRecord xs) + xs = punsafeCoerce $ ptail # l + in f $ PDCons x xs + +-- | This uses data equality. 'PEq' instances of elements don't make any difference. +instance PEq (PDataRecord xs) where + x #== y = pto x #== pto y + +-- Lexicographic ordering based 'Ord' instances for 'PDataRecord'. + +instance PPartialOrd (PDataRecord '[]) where + _ #<= _ = pconstant True + _ #< _ = pconstant False + +instance POrd (PDataRecord '[]) + +instance (POrd x, PIsData x) => PPartialOrd (PDataRecord '[label ':= x]) where + l1 #< l2 = unTermCont $ do + PDCons x _ <- tcont $ pmatch l1 + PDCons y _ <- tcont $ pmatch l2 + + pure $ pfromData x #< pfromData y + + l1 #<= l2 = unTermCont $ do + PDCons x _ <- tcont $ pmatch l1 + PDCons y _ <- tcont $ pmatch l2 + + pure $ pfromData x #<= pfromData y + +instance (POrd x, PIsData x) => POrd (PDataRecord '[label ':= x]) + +instance + (SListI xs, POrd x, PIsData x, POrd (PDataRecord (x' ': xs))) => + PPartialOrd (PDataRecord ((label ':= x) ': x' ': xs)) + where + l1 #< l2 = unTermCont $ do + PDCons x xs <- tcont $ pmatch l1 + PDCons y ys <- tcont $ pmatch l2 + + a <- tcont . plet $ pfromData x + b <- tcont . plet $ pfromData y + + pure $ pif (a #< b) (pconstant True) $ pif (a #== b) (xs #< ys) $ pconstant False + + l1 #<= l2 = unTermCont $ do + PDCons x xs <- tcont $ pmatch l1 + PDCons y ys <- tcont $ pmatch l2 + + a <- tcont . plet $ pfromData x + b <- tcont . plet $ pfromData y + + pure $ pif (a #< b) (pconstant True) $ pif (a #== b) (xs #<= ys) $ pconstant False + +instance + (SListI xs, POrd x, PIsData x, POrd (PDataRecord (x' ': xs))) => + POrd (PDataRecord ((label ':= x) ': x' ': xs)) {- | Cons a field to a data record. @@ -149,42 +235,111 @@ pdnil = punsafeCoerce $ pnil @PBuiltinList @PData data PLabeledType = Symbol := PType -{- Get the product types of a data record sum constructor --} -type PDataRecordFields :: [Type] -> [PLabeledType] -type family PDataRecordFields as where - PDataRecordFields '[] = '[] - PDataRecordFields '[Term s (PDataRecord fs)] = fs - PDataRecordFields '[t] = TypeError ( 'Text "Expected PDataRecord" ':<>: 'Text "but got" ':<>: 'ShowType t) - PDataRecordFields ts = TypeError ( 'Text "Expected none or PDataRecord" ':<>: 'Text "but got" ':<>: 'ShowType ts) - -{- Return the table of data records for a sum type. - -NOTE: Unfortunately we can't write a generic FMap due to ghc's arity limitations. --} -type PDataRecordFields2 :: [[Type]] -> [[PLabeledType]] -type family PDataRecordFields2 as where - PDataRecordFields2 '[] = '[] - PDataRecordFields2 (a ': as) = PDataRecordFields a ': PDataRecordFields2 as - type family PLabelIndex (name :: Symbol) (as :: [PLabeledType]) :: Nat where - PLabelIndex name ((name ':= a) ': as) = 0 - PLabelIndex name (_' : as) = (PLabelIndex name as) + 1 + PLabelIndex name ((name ':= _) ': _) = 0 + PLabelIndex name (_ ': as) = PLabelIndex name as + 1 + +type PLookupLabel :: Symbol -> [PLabeledType] -> PType +type family PLookupLabel name as where + PLookupLabel name ((name ':= a) ': _) = a + PLookupLabel name (_ ': as) = PLookupLabel name as type family PUnLabel (a :: PLabeledType) :: PType where - PUnLabel (name ':= a) = a + PUnLabel (_ ':= a) = a -{- | A sum of 'PDataRecord's. The underlying representation is the `PDataConstr` constructor, - where the integer is the index of the variant and the list is the record. +instance PIsData (PDataRecord xs) where + pfromDataImpl x = punsafeCoerce (pfromData (punsafeCoerce x) :: Term _ (PBuiltinList PData)) + pdataImpl x = pupcast $ pdata (pupcast x :: Term _ (PBuiltinList PData)) - This is how most data structures are stored on-chain. +{- | A sum of 'PDataRecord's. The underlying representation is the `Constr` constructor, +where the integer is the index of the variant and the list is the record. -} type PDataSum :: [[PLabeledType]] -> PType -data PDataSum (defs :: [[PLabeledType]]) (s :: S) +newtype PDataSum defs s = PDataSum (NS (F.Compose (Term s) PDataRecord) defs) + +class IsPDataSum (a :: [[PType]]) where + type IsPDataSumDefs a :: [[PLabeledType]] + toSum :: SOP (Term s) a -> PDataSum (IsPDataSumDefs a) s + fromSum :: PDataSum (IsPDataSumDefs a) s -> SOP (Term s) a + +instance IsPDataSum '[] where + type IsPDataSumDefs '[] = '[] + toSum (SOP x) = case x of {} + fromSum (PDataSum x) = case x of {} + +instance IsPDataSum xs => IsPDataSum ('[PDataRecord l] : xs) where + type IsPDataSumDefs ('[PDataRecord l] : xs) = (l : IsPDataSumDefs xs) + toSum (SOP (Z (x :* Nil))) = PDataSum $ Z $ coerce x + toSum (SOP (S x)) = case toSum (SOP x) of + PDataSum y -> PDataSum $ S y + fromSum (PDataSum (Z x)) = SOP $ Z $ coerce x :* Nil + fromSum (PDataSum (S x)) = case fromSum (PDataSum x) of + SOP y -> SOP $ S y + +data DataReprHandlers (out :: PType) (defs :: [[PLabeledType]]) (s :: S) where + DRHNil :: DataReprHandlers out '[] s + DRHCons :: (Term s (PDataRecord def) -> Term s out) -> DataReprHandlers out defs s -> DataReprHandlers out (def : defs) s + +newtype A s out defs = A {unA :: (PDataSum defs s -> Term s out) -> DataReprHandlers out defs s} + +instance + ( SListI defs + ) => + PlutusType (PDataSum defs) + where + type PInner (PDataSum defs) = PData + pcon' (PDataSum xss) = + let constrIx = fromIntegral $ hindex xss + datRec = hcollapse $ hmap (K . pto . F.getCompose) xss + in pforgetData $ pconstrBuiltin # pconstant constrIx # datRec + pmatch' d f = + let handlers = conv f + in case handlers of + DRHCons handler DRHNil -> handler $ punDataSum # (punsafeCoerce d :: Term _ (PDataSum defs)) + _ -> plet (pasConstr #$ d) $ \d' -> + plet (pfstBuiltin # d') $ \constr -> + plet (psndBuiltin # d') $ \args -> + let handlers' = applyHandlers args handlers + in runTermCont (findCommon handlers') $ \common -> + reprHandlersGo + common + 0 + handlers' + constr + where + applyHandlers :: forall out s defs. Term s (PBuiltinList PData) -> DataReprHandlers out defs s -> [Term s out] + applyHandlers _ DRHNil = [] + applyHandlers args (DRHCons handler rest) = handler (punsafeCoerce args) : applyHandlers args rest + + conv :: forall out s defs. SListI defs => (PDataSum defs s -> Term s out) -> DataReprHandlers out defs s + conv = + unA $ + para_SList + (A $ const DRHNil) + ( \(A prev) -> A \f -> + DRHCons + (\x -> f (PDataSum (Z $ coerce x))) + $ prev (\(PDataSum x) -> f (PDataSum (S x))) + ) instance PIsData (PDataSum defs) where - pdata = punsafeCoerce - pfromData = punsafeCoerce + pfromDataImpl = punsafeCoerce + pdataImpl = punsafeCoerce + +instance PEq (PDataSum defs) where + x #== y = pdata x #== pdata y + +instance All (Compose POrd PDataRecord) defs => PPartialOrd (PDataSum defs) where + x' #< y' = f # x' # y' + where + f :: Term s (PDataSum defs :--> PDataSum defs :--> PBool) + f = phoistAcyclic $ plam $ \x y -> pmatchLT x y mkLTHandler + x' #<= y' = f # x' # y' + where + f :: Term s (PDataSum defs :--> PDataSum defs :--> PBool) + f = phoistAcyclic $ plam $ \x y -> pmatchLT x y mkLTEHandler + +instance All (Compose POrd PDataRecord) defs => POrd (PDataSum defs) -- | If there is only a single variant, then we can safely extract it. punDataSum :: Term s (PDataSum '[def] :--> PDataRecord def) @@ -215,169 +370,312 @@ pdropDataRecord n xs = punsafeCoerce $ pdrop @PBuiltinList @PData (fromInteger $ natVal n) (punsafeCoerce xs) --- | This is used to define the handlers for 'pmatchDataSum'. -data DataReprHandlers (out :: PType) (defs :: [[PLabeledType]]) (s :: S) where - DRHNil :: DataReprHandlers out '[] s - DRHCons :: (Term s (PDataRecord def) -> Term s out) -> DataReprHandlers out defs s -> DataReprHandlers out (def : defs) s +data PlutusTypeData --- | Pattern match on a 'PDataSum' manually. The common case only appears once in the generated code. -pmatchDataSum :: Term s (PDataSum defs) -> DataReprHandlers out defs s -> Term s out -pmatchDataSum d (DRHCons handler DRHNil) = handler $ punDataSum # d -pmatchDataSum d handlers = - plet (pasConstr #$ pforgetData $ pdata d) $ \d' -> - plet (pfstBuiltin # d') $ \constr -> - plet (psndBuiltin # d') $ \args -> - let handlers' = applyHandlers args handlers - in runTermCont (findCommon handlers') $ \common -> - go - common - 0 - handlers' - constr +class + ( IsPDataSum (PCode a) + , SListI (IsPDataSumDefs (PCode a)) + , PGeneric a + ) => + PlutusTypeDataConstraint a +instance + ( IsPDataSum (PCode a) + , SListI (IsPDataSumDefs (PCode a)) + , PGeneric a + ) => + PlutusTypeDataConstraint a + +instance PlutusTypeStrat PlutusTypeData where + type PlutusTypeStratConstraint PlutusTypeData = PlutusTypeDataConstraint + type DerivedPInner PlutusTypeData a = PDataSum (IsPDataSumDefs (PCode a)) + derivedPCon x = pcon $ toSum $ gpfrom x + derivedPMatch x f = pmatch x (\y -> f $ gpto $ fromSum $ y) + +newtype DualReprHandler s out def = DualRepr (Term s (PDataRecord def) -> Term s (PDataRecord def) -> Term s out) + +-- | Optimized dual pmatch specialized for lexicographic '#<' and '#<=' implementations. +pmatchLT :: Term s (PDataSum defs) -> Term s (PDataSum defs) -> NP (DualReprHandler s PBool) defs -> Term s PBool +pmatchLT d1 d2 (DualRepr handler :* Nil) = handler (punDataSum # d1) (punDataSum # d2) +pmatchLT d1 d2 handlers = unTermCont $ do + a <- tcont . plet $ pasConstr #$ pforgetData $ pdata d1 + b <- tcont . plet $ pasConstr #$ pforgetData $ pdata d2 + + cid1 <- tcont . plet $ pfstBuiltin # a + cid2 <- tcont . plet $ pfstBuiltin # b + + pure $ + pif + (cid1 #< cid2) + -- Left arg's constructor id is less, no need to continue. + (pconstant True) + $ pif + (cid1 #== cid2) + -- Matching constructors, compare fields now. + ( unTermCont $ do + flds1 <- tcont . plet $ psndBuiltin # a + flds2 <- tcont . plet $ psndBuiltin # b + let handlers' = applyHandlers flds1 flds2 handlers + common <- findCommon handlers' + pure $ reprHandlersGo common 0 (applyHandlers flds1 flds2 handlers) cid1 + ) + -- Left arg's constructor id is greater, no need to continue. + $ pconstant False + where + applyHandlers :: + Term s (PBuiltinList PData) -> + Term s (PBuiltinList PData) -> + NP (DualReprHandler s PBool) defs -> + [Term s PBool] + applyHandlers _ _ Nil = [] + applyHandlers args1 args2 (DualRepr handler :* rest) = + handler (punsafeCoerce args1) (punsafeCoerce args2) : + applyHandlers args1 args2 rest + +reprHandlersGo :: + (Dig, Term s out) -> + Integer -> + [Term s out] -> + Term s PInteger -> + Term s out +reprHandlersGo common _ [] _ = snd common +reprHandlersGo common idx (handler : rest) c = + runTermCont (hashOpenTerm handler) $ \hhash -> + if hhash == fst common + then reprHandlersGo common (idx + 1) rest c + else + pif + (fromInteger idx #== c) + handler + $ reprHandlersGo common (idx + 1) rest c + +hashHandlers :: [Term s out] -> TermCont s [(Dig, Term s out)] +hashHandlers [] = pure [] +hashHandlers (handler : rest) = do + hash <- hashOpenTerm handler + hashes <- hashHandlers rest + pure $ (hash, handler) : hashes + +findCommon :: [Term s out] -> TermCont s (Dig, Term s out) +findCommon handlers = do + l <- hashHandlers handlers + pure $ head . maximumBy (\x y -> length x `compare` length y) . groupBy (\x y -> fst x == fst y) . sortOn fst $ l + +mkLTHandler :: forall def s. All (Compose POrd PDataRecord) def => NP (DualReprHandler s PBool) def +mkLTHandler = cana_NP (Proxy @(Compose POrd PDataRecord)) rer $ Const () where - hashHandlers :: [Term s out] -> TermCont s [(Dig, Term s out)] - hashHandlers [] = pure [] - hashHandlers (handler : rest) = do - hash <- hashOpenTerm handler - hashes <- hashHandlers rest - pure $ (hash, handler) : hashes - - findCommon :: [Term s out] -> TermCont s (Dig, Term s out) - findCommon handlers = do - l <- hashHandlers handlers - pure $ head . maximumBy (\x y -> length x `compare` length y) . groupBy (\x y -> fst x == fst y) . sortOn fst $ l - - applyHandlers :: Term s (PBuiltinList PData) -> DataReprHandlers out defs s -> [Term s out] - applyHandlers _ DRHNil = [] - applyHandlers args (DRHCons handler rest) = handler (punsafeCoerce args) : applyHandlers args rest - - go :: - (Dig, Term s out) -> - Integer -> - [Term s out] -> - Term s PInteger -> - Term s out - go common _ [] _ = snd common - go common idx (handler : rest) constr = - runTermCont (hashOpenTerm handler) $ \hhash -> - if hhash == fst common - then go common (idx + 1) rest constr - else - pif - (fromInteger idx #== constr) - handler - $ go common (idx + 1) rest constr - -{- | Use this for implementing the necessary instances for getting the `Data` representation. - You must implement 'PIsDataRepr' to use this. + rer :: + forall (y :: [PLabeledType]) (ys :: [[PLabeledType]]). + Compose POrd PDataRecord y => + Const () (y : ys) -> + (DualReprHandler s PBool y, Const () ys) + rer _ = (DualRepr (#<), Const ()) + +mkLTEHandler :: forall def s. All (Compose POrd PDataRecord) def => NP (DualReprHandler s PBool) def +mkLTEHandler = cana_NP (Proxy @(Compose POrd PDataRecord)) rer $ Const () + where + rer :: + forall (y :: [PLabeledType]) (ys :: [[PLabeledType]]). + Compose POrd PDataRecord y => + Const () (y : ys) -> + (DualReprHandler s PBool y, Const () ys) + rer _ = (DualRepr (#<=), Const ()) + +{- | Type synonym to simplify deriving of @PConstant@ via @DerivePConstantViaData@. + +A type @Foo a@ is considered "ConstantableData" if: + +- The wrapped type @a@ has a @PConstant@ instance. +- The lifted type of @a@ has a @PUnsafeLiftDecl@ instance. +- There is type equality between @a@ and @PLifted (PConstanted a)@. +- The newtype has @FromData@ and @ToData@ instances + +These constraints are sufficient to derive a @PConstant@ instance for the newtype. + +For deriving @PConstant@ for a wrapped type represented in UPLC as @Data@, see +@DerivePConstantViaData@. + +Polymorphic types can be derived as follows: + +>data Bar a = Bar a deriving stock (GHC.Generic) +> +>PlutusTx.makeLift ''Bar +>PlutusTx.makeIsDataIndexed ''Bar [('Bar, 0)] +> +>data PBar (a :: PType) (s :: S) +> = PBar (Term s (PDataRecord '["_0" ':= a])) +> deriving stock (GHC.Generic) +> deriving anyclass (SOP.Generic, PIsDataRepr) +> deriving (PlutusType, PIsData, PDataFields) via PIsDataReprInstances (PBar a) +> +>instance +> forall a. +> PLiftData a => +> PUnsafeLiftDecl (PBar a) +> where +> type PLifted (PBar a) = Bar (PLifted a) +> +>deriving via +> ( DerivePConstantViaData +> (Bar a) +> (PBar (PConstanted a)) +> ) +> instance +> PConstantData a => +> PConstantDecl (Bar a) -} -newtype PIsDataReprInstances (a :: PType) (s :: S) = PIsDataReprInstances (a s) - --- TODO: This 'PMatch' constraint needs to be changed to 'PlutusType (breaking change). -class (PMatch a, PIsData a) => PIsDataRepr (a :: PType) where - type PIsDataReprRepr a :: [[PLabeledType]] - type PIsDataReprRepr a = PDataRecordFields2 (Code (a 'SI)) - - pconRepr :: a s -> Term s (PDataSum (PIsDataReprRepr a)) - default pconRepr :: - forall s code pcode. - ( Generic (a s) - , code ~ Code (a s) - , pcode ~ ToPType2 code - , All SListI pcode - , All Singleton code - , All2 IsBuiltinList pcode - , AllZipN POP (LiftedCoercible I (Term s)) code pcode - ) => - a s -> - Term s (PDataSum (PIsDataReprRepr a)) - pconRepr x = punsafeCoerce expected - where - expected :: Term _ (PAsData (PBuiltinPair PInteger (PBuiltinList PData))) - expected = gpconRepr @a $ from x - - pmatchRepr :: forall s b. Term s (PDataSum (PIsDataReprRepr a)) -> (a s -> Term s b) -> Term s b - default pmatchRepr :: - forall s b code. - ( code ~ Code (a s) - , PDataRecordFields2 code ~ PIsDataReprRepr a - , MkDataReprHandler s a 0 code - ) => - Term s (PDataSum (PIsDataReprRepr a)) -> - (a s -> Term s b) -> - Term s b - pmatchRepr dat = - pmatchDataSum dat . mkDataReprHandler @s @a @0 @code - -gpconRepr :: - forall a s code pcode. - ( Generic (a s) - , code ~ Code (a s) - , pcode ~ ToPType2 code - , All SListI pcode - , All Singleton code - , All2 IsBuiltinList pcode - , AllZipN POP (LiftedCoercible I (Term s)) code pcode +type PConstantData :: Type -> Constraint +type PConstantData h = + ( PConstant h + , Ledger.FromData h + , Ledger.ToData h + , PIsData (PConstanted h) + ) + +type PLiftData :: PType -> Constraint +type PLiftData p = + ( PLift p + , Ledger.FromData (PLifted p) + , Ledger.ToData (PLifted p) + , PIsData p + ) + +{- | + +For deriving @PConstant@ for a wrapped type represented by a builtin type, see +@DerivePConstantViaNewtype@. +-} +newtype + DerivePConstantViaData + (h :: Type) + (p :: PType) -- The Plutarch synonym to the Haskell type + = -- | The Haskell type for which @PConstant is being derived. + DerivePConstantViaData h + +instance + ( PSubtype PData p + , PLift p + , Ledger.FromData h + , Ledger.ToData h ) => - SOP I (Code (a s)) -> - Term s (PAsData (PBuiltinPair PInteger (PBuiltinList PData))) -gpconRepr x = pconstrBuiltin # pconstant (toInteger $ hindex sop) # head (hcollapse sop) + PConstantDecl (DerivePConstantViaData h p) where - sop :: SOP (K (Term s (PBuiltinList PData))) pcode - sop = hcmap (Proxy @IsBuiltinList) (K . dataListFrom) $ hfromI x + type PConstantRepr (DerivePConstantViaData h p) = Ledger.Data + type PConstanted (DerivePConstantViaData h p) = p + pconstantToRepr (DerivePConstantViaData x) = Ledger.toData x + pconstantFromRepr x = DerivePConstantViaData <$> Ledger.fromData x --- | Create a `DataReprhandlers` starting from `n`th sum constructor -class MkDataReprHandler (s :: S) (a :: PType) (n :: Nat) (rest :: [[Type]]) where - mkDataReprHandler :: forall out. (a s -> Term s out) -> DataReprHandlers out (PDataRecordFields2 rest) s +----------------------- HRecP and friends ----------------------------------------------- -instance MkDataReprHandler s a n '[] where - mkDataReprHandler _ = DRHNil +type HRecPApply :: [(Symbol, PType)] -> S -> [(Symbol, Type)] +type family HRecPApply as s where + HRecPApply ('(name, ty) ': rest) s = '(name, Reduce (ty s)) ': HRecPApply rest s + HRecPApply '[] _ = '[] -instance - ( Generic (a s) - , code ~ Code (a s) - , r ~ IndexList n code - , r ~ '[Term s (PDataRecord fs)] - , MkSum n code - , MkDataReprHandler s a (n + 1) rs - ) => - MkDataReprHandler s a n (r ': rs) - where - mkDataReprHandler f = - DRHCons (f . to . mkSOP . mkProduct) $ - mkDataReprHandler @s @a @(n + 1) @rs f - where - mkProduct :: Term s (PDataRecord fs) -> NP I r - mkProduct x = I x :* Nil - mkSOP :: NP I r -> SOP I (Code (a s)) - mkSOP = SOP . mkSum @n @code +newtype HRecP (as :: [(Symbol, PType)]) (s :: S) = HRecP (NoReduce (HRecGeneric (HRecPApply as s))) + deriving stock (Generic) -pasDataSum :: PIsDataRepr a => Term s a -> Term s (PDataSum (PIsDataReprRepr a)) -pasDataSum = punsafeCoerce +newtype Flip f a b = Flip (f b a) + deriving stock (Generic) -instance PIsDataRepr a => PIsData (PIsDataReprInstances a) where - pdata = punsafeCoerce - pfromData = punsafeCoerce +class Helper2 (b :: Bool) a where + type Helper2Excess b a :: PType + ptryFromData' :: forall s r. Proxy b -> Term s PData -> ((Term s (PAsData a), Reduce (Helper2Excess b a s)) -> Term s r) -> Term s r -instance PIsDataRepr a => PlutusType (PIsDataReprInstances a) where - type PInner (PIsDataReprInstances a) _ = PDataSum (PIsDataReprRepr a) - pcon' (PIsDataReprInstances x) = pconRepr x - pmatch' x f = pmatchRepr x (f . PIsDataReprInstances) +instance PTryFrom PData (PAsData a) => Helper2 'False a where + type Helper2Excess 'False a = PTryFromExcess PData (PAsData a) + ptryFromData' _ = ptryFrom' -newtype DerivePConstantViaData (h :: Type) (p :: PType) = DerivePConstantViaData h +instance PTryFrom PData a => Helper2 'True a where + type Helper2Excess 'True a = PTryFromExcess PData a + ptryFromData' _ x = runTermCont $ do + (y, exc) <- tcont $ ptryFrom @a @PData x + pure (punsafeCoerce y, exc) -instance (PIsDataRepr p, PLift p, Ledger.FromData h, Ledger.ToData h) => PConstant (DerivePConstantViaData h p) where - type PConstantRepr (DerivePConstantViaData h p) = Ledger.Data - type PConstanted (DerivePConstantViaData h p) = p - pconstantToRepr (DerivePConstantViaData x) = Ledger.toData x - pconstantFromRepr x = DerivePConstantViaData <$> Ledger.fromData x +-- We could have a more advanced instance but it's not needed really. +newtype ExcessForField (b :: Bool) (a :: PType) (s :: S) = ExcessForField (Term s (PAsData a), Reduce (Helper2Excess b a s)) + deriving stock (Generic) --- I wish type families could be applied partially.... -class Singleton a -instance Singleton (x ': '[]) +instance PTryFrom (PBuiltinList PData) (PDataRecord '[]) where + type PTryFromExcess (PBuiltinList PData) (PDataRecord '[]) = HRecP '[] + ptryFrom' opq = runTermCont $ do + _ <- + tcont . plet . pforce $ + pchooseListBuiltin # opq # pdelay (pcon PUnit) # pdelay (ptraceError "ptryFrom(PDataRecord[]): list is longer than zero") + pure (pdnil, HRecGeneric HNil) -class IsBuiltinList a where - dataListFrom :: Term s a -> Term s (PBuiltinList PData) +type family UnHRecP (x :: PType) :: [(Symbol, PType)] where + UnHRecP (HRecP as) = as -instance IsBuiltinList (PDataRecord l) where - dataListFrom = punsafeCoerce +instance + ( Helper2 (PSubtype' PData pty) pty + , PTryFrom (PBuiltinList PData) (PDataRecord as) + , PTryFromExcess (PBuiltinList PData) (PDataRecord as) ~ HRecP ase + ) => + PTryFrom (PBuiltinList PData) (PDataRecord ((name ':= pty) ': as)) + where + type + PTryFromExcess (PBuiltinList PData) (PDataRecord ((name ':= pty) ': as)) = + HRecP + ( '(name, ExcessForField (PSubtype' PData pty) pty) + ': UnHRecP (PTryFromExcess (PBuiltinList PData) (PDataRecord as)) + ) + ptryFrom' opq = runTermCont $ do + h <- tcont $ plet $ phead # opq + hv <- tcont $ ptryFromData' (Proxy @(PSubtype' PData pty)) h + t <- tcont $ plet $ ptail # opq + tv <- tcont $ ptryFrom @(PDataRecord as) @(PBuiltinList PData) t + pure (punsafeCoerce opq, HRecGeneric (HCons (Labeled hv) (coerce $ snd tv))) + +newtype Helper a b s = Helper (Reduce (a s), Reduce (b s)) deriving stock (Generic) + +instance + ( PTryFrom (PBuiltinList PData) (PDataRecord as) + , PTryFromExcess (PBuiltinList PData) (PDataRecord as) ~ HRecP ase + ) => + PTryFrom PData (PAsData (PDataRecord as)) + where + type + PTryFromExcess PData (PAsData (PDataRecord as)) = + Helper (Flip Term (PDataRecord as)) (PTryFromExcess (PBuiltinList PData) (PDataRecord as)) + ptryFrom' opq = runTermCont $ do + l <- snd <$> tcont (ptryFrom @(PAsData (PBuiltinList PData)) opq) + r <- tcont $ ptryFrom @(PDataRecord as) l + pure (punsafeCoerce opq, r) + +class SumValidation (n :: Nat) (sum :: [[PLabeledType]]) where + validateSum :: Proxy n -> Proxy sum -> Term s PInteger -> Term s (PBuiltinList PData) -> Term s POpaque + +instance + forall (n :: Nat) (x :: [PLabeledType]) (xs :: [[PLabeledType]]). + ( PTryFrom (PBuiltinList PData) (PDataRecord x) + , SumValidation (n + 1) xs + , KnownNat n + ) => + SumValidation n (x ': xs) + where + validateSum _ _ constr fields = + pif + (fromInteger (natVal $ Proxy @n) #== constr) + ( unTermCont $ do + _ <- tcont $ ptryFrom @(PDataRecord x) fields + pure $ popaque $ pcon PUnit + ) + (validateSum (Proxy @(n + 1)) (Proxy @xs) constr fields) + +instance SumValidation n '[] where + validateSum _ _ _ _ = ptraceError "reached end of sum while still not having found the constructor" + +instance SumValidation 0 ys => PTryFrom PData (PDataSum ys) where + type PTryFromExcess _ _ = Const () + ptryFrom' opq = runTermCont $ do + x <- tcont $ plet $ pasConstr # opq + constr <- tcont $ plet $ pfstBuiltin # x + fields <- tcont $ plet $ psndBuiltin # x + _ <- tcont $ plet $ validateSum (Proxy @0) (Proxy @ys) constr fields + pure (punsafeCoerce opq, ()) + +instance PTryFrom PData (PDataSum ys) => PTryFrom PData (PAsData (PDataSum ys)) where + type PTryFromExcess _ _ = Const () + ptryFrom' x = runTermCont $ do + (y, exc) <- tcont $ ptryFrom x + pure (pdata y, exc) diff --git a/Plutarch/DataRepr/Internal/Field.hs b/Plutarch/DataRepr/Internal/Field.hs index ce20854e2..c9e0b9bf3 100644 --- a/Plutarch/DataRepr/Internal/Field.hs +++ b/Plutarch/DataRepr/Internal/Field.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Plutarch.DataRepr.Internal.Field ( @@ -9,8 +10,12 @@ module Plutarch.DataRepr.Internal.Field ( -- * BindFields class mechanism BindFields (..), + type Bindings, type BoundTerms, type Drop, + type HRecOf, + type PMemberFields, + type PMemberField, -- * Re-exports HRec (..), @@ -24,13 +29,15 @@ import GHC.TypeLits ( Symbol, ) -import Data.Kind (Type) +import Data.Kind (Constraint, Type) import Plutarch ( + PInner, PType, S, Term, plam, plet, + pto, (#), (#$), type (:-->), @@ -38,19 +45,18 @@ import Plutarch ( import Plutarch.Builtin ( PAsData, - PIsData (pfromData), + PIsData, + pfromData, ) import Plutarch.DataRepr.Internal ( PDataRecord, PDataSum, - PIsDataRepr (type PIsDataReprRepr), - PIsDataReprInstances, PLabeledType ((:=)), - pasDataSum, pdropDataRecord, pindexDataRecord, punDataSum, type PLabelIndex, + type PLookupLabel, type PUnLabel, ) import Plutarch.DataRepr.Internal.FromData (PFromDataable, pmaybeFromAsData) @@ -59,15 +65,19 @@ import Plutarch.DataRepr.Internal.HList ( Labeled (Labeled, unLabeled), hrecField, type Drop, + type ElemOf, + type IndexLabel, type IndexList, - type SingleItem, ) -import Plutarch.Internal (punsafeCoerce) +import Plutarch.Internal.Witness (witness) import Plutarch.TermCont (TermCont (TermCont), runTermCont) -------------------------------------------------------------------------------- ---------- PDataField class & deriving utils +type family Helper (x :: PType) :: [PLabeledType] where + Helper (PDataSum '[y]) = y + {- | Class allowing 'letFields' to work for a PType, usually via `PIsDataRepr`, but is derived for some other types for convenience. @@ -76,8 +86,12 @@ class PDataFields (a :: PType) where -- | Fields in HRec bound by 'letFields' type PFields a :: [PLabeledType] + type PFields a = Helper (PInner a) + -- | Convert a Term to a 'PDataList' ptoFields :: Term s a -> Term s (PDataRecord (PFields a)) + default ptoFields :: PInner a ~ PDataSum '[PFields a] => Term s a -> Term s (PDataRecord (PFields a)) + ptoFields x = punDataSum #$ pto x instance PDataFields (PDataRecord as) where type PFields (PDataRecord as) = as @@ -87,20 +101,6 @@ instance PDataFields (PDataSum '[as]) where type PFields (PDataSum '[as]) = as ptoFields = (punDataSum #) -instance - forall a fields. - ( PIsDataRepr a - , PIsDataReprRepr a ~ '[fields] - , SingleItem (PIsDataReprRepr a) ~ fields - ) => - PDataFields (PIsDataReprInstances a) - where - type - PFields (PIsDataReprInstances a) = - SingleItem (PIsDataReprRepr a) - - ptoFields x = punDataSum #$ pasDataSum (punsafeCoerce x :: Term _ a) - instance forall a. ( PIsData a @@ -111,6 +111,51 @@ instance type PFields (PAsData a) = PFields a ptoFields = ptoFields . pfromData +-- | The 'HRec' yielded by 'pletFields @fs t'. +type HRecOf t fs s = + HRec + ( BoundTerms + (PFields t) + (Bindings (PFields t) fs) + s + ) + +{- | Constrain an 'HRec' to contain the specified fields from the given Plutarch type. + +=== Example === + +@ +import qualified GHC.Generics as GHC +import Generics.SOP + +import Plutarch.Prelude +import Plutarch.DataRepr + +newtype PFooType s = PFooType (Term s (PDataRecord '["frst" ':= PInteger, "scnd" ':= PBool, "thrd" ':= PString])) + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData, PDataFields, PEq) + via PIsDataReprInstances PFooType + +foo :: PMemberFields PFooType '["scnd", "frst"] s as => HRec as -> Term s PInteger +foo h = pif (getField @"scnd" h) (getField @"frst" h) 0 +@ +-} +type PMemberFields :: PType -> [Symbol] -> S -> [(Symbol, Type)] -> Constraint +type family PMemberFields t fs s as where + PMemberFields _ '[] _ _ = () + PMemberFields t (name ': rest) s as = (PMemberField t name s as, PMemberFields t rest s as) + +-- | Single field version of 'PMemberFields'. +type PMemberField :: PType -> Symbol -> S -> [(Symbol, Type)] -> Constraint +type family PMemberField t name s as where + PMemberField t name s as = + ( IndexLabel name as ~ Term s (PAsData (PLookupLabel name (PFields t))) + , ElemOf name (Term s (PAsData (PLookupLabel name (PFields t)))) as + ) + {- | Bind a HRec of named fields containing all the specified fields. @@ -123,11 +168,11 @@ pletFields :: , BindFields ps bs ) => Term s a -> - (HRec (BoundTerms ps bs s) -> Term s b) -> + (HRecOf a fs s -> Term s b) -> Term s b pletFields t = runTermCont $ - bindFields @ps @bs $ ptoFields @a t + bindFields (Proxy @bs) $ ptoFields @a t data ToBind = Bind | Skip @@ -153,11 +198,12 @@ type family CutSkip (bs :: [ToBind]) :: [ToBind] where Get the 'Term' representations to be bound based on the result of 'Bindings'. -} -type family BoundTerms (ps :: [PLabeledType]) (bs :: [ToBind]) (s :: S) :: [Type] where +type BoundTerms :: [PLabeledType] -> [ToBind] -> S -> [(Symbol, Type)] +type family BoundTerms ps bs s where BoundTerms '[] _ _ = '[] BoundTerms _ '[] _ = '[] BoundTerms (_ ': ps) ( 'Skip ': bs) s = BoundTerms ps bs s - BoundTerms ((name ':= p) ': ps) ( 'Bind ': bs) s = (Labeled name (Term s (PAsData p))) ': (BoundTerms ps bs s) + BoundTerms ((name ':= p) ': ps) ( 'Bind ': bs) s = '(name, Term s (PAsData p)) ': BoundTerms ps bs s class BindFields (ps :: [PLabeledType]) (bs :: [ToBind]) where -- | @@ -166,45 +212,45 @@ class BindFields (ps :: [PLabeledType]) (bs :: [ToBind]) where -- -- A continuation is returned to enable sharing of -- the generated bound-variables. - bindFields :: Term s (PDataRecord ps) -> TermCont s (HRec (BoundTerms ps bs s)) + bindFields :: Proxy bs -> Term s (PDataRecord ps) -> TermCont s (HRec (BoundTerms ps bs s)) -instance {-# OVERLAPPING #-} BindFields ((l ':= p) ': ps) ( 'Bind ': '[]) where - bindFields t = +instance {-# OVERLAPPABLE #-} BindFields ((l ':= p) ': ps) ( 'Bind ': '[]) where + bindFields _ t = pure $ HCons (Labeled $ pindexDataRecord (Proxy @0) t) HNil instance {-# OVERLAPPABLE #-} (BindFields ps bs) => BindFields ((l ':= p) ': ps) ( 'Bind ': bs) where - bindFields t = do + bindFields _ t = do t' <- TermCont $ plet t - xs <- bindFields @ps @bs (pdropDataRecord (Proxy @1) t') + xs <- bindFields (Proxy @bs) (pdropDataRecord (Proxy @1) t') pure $ HCons (Labeled $ pindexDataRecord (Proxy @0) t') xs -instance {-# OVERLAPPING #-} (BindFields ps bs) => BindFields (p1 ': ps) ( 'Skip ': bs) where - bindFields t = do - bindFields @ps @bs $ pdropDataRecord (Proxy @1) t +instance {-# OVERLAPPABLE #-} (BindFields ps bs) => BindFields (p1 ': ps) ( 'Skip ': bs) where + bindFields _ t = do + bindFields (Proxy @bs) $ pdropDataRecord (Proxy @1) t -instance {-# OVERLAPPING #-} (BindFields ps bs) => BindFields (p1 ': p2 ': ps) ( 'Skip ': 'Skip ': bs) where - bindFields t = do - bindFields @ps @bs $ pdropDataRecord (Proxy @2) t +instance {-# OVERLAPPABLE #-} (BindFields ps bs) => BindFields (p1 ': p2 ': ps) ( 'Skip ': 'Skip ': bs) where + bindFields _ t = do + bindFields (Proxy @bs) $ pdropDataRecord (Proxy @2) t -instance {-# OVERLAPPING #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': ps) ( 'Skip ': 'Skip ': 'Skip ': bs) where - bindFields t = do - bindFields @ps @bs $ pdropDataRecord (Proxy @3) t +instance {-# OVERLAPPABLE #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': ps) ( 'Skip ': 'Skip ': 'Skip ': bs) where + bindFields _ t = do + bindFields (Proxy @bs) $ pdropDataRecord (Proxy @3) t -instance {-# OVERLAPPING #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': p4 ': ps) ( 'Skip ': 'Skip ': 'Skip ': 'Skip ': bs) where - bindFields t = do - bindFields @ps @bs $ pdropDataRecord (Proxy @4) t +instance {-# OVERLAPPABLE #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': p4 ': ps) ( 'Skip ': 'Skip ': 'Skip ': 'Skip ': bs) where + bindFields _ t = do + bindFields (Proxy @bs) $ pdropDataRecord (Proxy @4) t -instance {-# OVERLAPPING #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': p4 ': p5 ': ps) ( 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': bs) where - bindFields t = do - bindFields @ps @bs $ pdropDataRecord (Proxy @5) t +instance {-# OVERLAPPABLE #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': p4 ': p5 ': ps) ( 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': bs) where + bindFields _ t = do + bindFields (Proxy @bs) $ pdropDataRecord (Proxy @5) t -instance {-# OVERLAPPING #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': p4 ': p5 ': p6 ': ps) ( 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': bs) where - bindFields t = do - bindFields @ps @bs $ pdropDataRecord (Proxy @6) t +instance {-# OVERLAPPABLE #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': p4 ': p5 ': p6 ': ps) ( 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': bs) where + bindFields _ t = do + bindFields (Proxy @bs) $ pdropDataRecord (Proxy @6) t -instance {-# OVERLAPPING #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': p4 ': p5 ': p6 ': p7 ': ps) ( 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': bs) where - bindFields t = do - bindFields @ps @bs $ pdropDataRecord (Proxy @7) t +instance {-# OVERLAPPABLE #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': p4 ': p5 ': p6 ': p7 ': ps) ( 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': 'Skip ': bs) where + bindFields _ t = do + bindFields (Proxy @bs) $ pdropDataRecord (Proxy @7) t -------------------------------------------------------------------------------- @@ -216,14 +262,16 @@ instance {-# OVERLAPPING #-} (BindFields ps bs) => BindFields (p1 ': p2 ': p3 ': which will generate the bindings more efficiently. -} pfield :: - forall name p s a as n b. + forall name b p s a as n. ( PDataFields p - , as ~ (PFields p) - , n ~ (PLabelIndex name as) + , as ~ PFields p + , n ~ PLabelIndex name as , KnownNat n - , a ~ (PUnLabel (IndexList n as)) + , a ~ PUnLabel (IndexList n as) , PFromDataable a b ) => Term s (p :--> b) -pfield = plam $ \i -> - pmaybeFromAsData $ pindexDataRecord (Proxy @n) $ ptoFields @p i +pfield = + let _ = witness (Proxy @(n ~ PLabelIndex name as)) + in plam $ \i -> + pmaybeFromAsData $ pindexDataRecord (Proxy @n) $ ptoFields @p i diff --git a/Plutarch/DataRepr/Internal/FromData.hs b/Plutarch/DataRepr/Internal/FromData.hs index 77874b1d4..912f26e55 100644 --- a/Plutarch/DataRepr/Internal/FromData.hs +++ b/Plutarch/DataRepr/Internal/FromData.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Plutarch.DataRepr.Internal.FromData (PFromDataable, pmaybeFromAsData) where -import Plutarch.Internal.Other (PType, Term) +import Plutarch.Internal (PType, Term) -import Plutarch.Builtin (PAsData, PIsData (pfromData)) +import Plutarch.Builtin (PAsData, PIsData, pfromData) {- | removes the PAsData if the hole requires it but leaves it @@ -22,7 +22,7 @@ import Plutarch.Builtin (PAsData, PIsData (pfromData)) class PFromDataable (a :: PType) (b :: PType) | b -> a, a -> b where pmaybeFromAsData :: Term s (PAsData a) -> Term s b -instance {-# OVERLAPS #-} PFromDataable a (PAsData a) where +instance {-# OVERLAPPABLE #-} PFromDataable a (PAsData a) where pmaybeFromAsData = id instance {-# OVERLAPPABLE #-} (PIsData a, b ~ a) => PFromDataable a b where diff --git a/Plutarch/DataRepr/Internal/Generic.hs b/Plutarch/DataRepr/Internal/Generic.hs deleted file mode 100644 index 2810c8829..000000000 --- a/Plutarch/DataRepr/Internal/Generic.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE UndecidableInstances #-} - --- | Common generics-sop utilities for use in Plutarch. -module Plutarch.DataRepr.Internal.Generic ( - MkSum (..), -) where - -import Data.Kind (Type) -import GHC.TypeLits (Nat, type (-)) -import Generics.SOP (I, NP, NS (S, Z)) -import Plutarch.DataRepr.Internal.HList.Utils (IndexList) - -{- | -Infrastructure to create a single sum constructor given its type index and value. - -- `mkSum @0 @(Code a) x` creates the first sum constructor; -- `mkSum @1 @(Code a) x` creates the second sum constructor; -- etc. - -It is type-checked that the `x` here matches the type of nth constructor of `a`. --} -class MkSum (idx :: Nat) (xss :: [[Type]]) where - mkSum :: NP I (IndexList idx xss) -> NS (NP I) xss - -instance {-# OVERLAPPING #-} MkSum 0 (xs ': xss) where - mkSum = Z - -instance - {-# OVERLAPPABLE #-} - ( MkSum (idx - 1) xss - , IndexList idx (xs ': xss) ~ IndexList (idx - 1) xss - ) => - MkSum idx (xs ': xss) - where - mkSum x = S $ mkSum @(idx - 1) @xss x diff --git a/Plutarch/DataRepr/Internal/HList.hs b/Plutarch/DataRepr/Internal/HList.hs index c7d3c9f19..bc7b969f8 100644 --- a/Plutarch/DataRepr/Internal/HList.hs +++ b/Plutarch/DataRepr/Internal/HList.hs @@ -1,14 +1,16 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Plutarch.DataRepr.Internal.HList ( -- * HRec and Label types HRec (HNil, HCons), + HRecGeneric (HRecGeneric), Labeled (Labeled, unLabeled), -- * Field indexing functions hrecField, + hrecField', -- * Type families type IndexList, @@ -21,11 +23,10 @@ module Plutarch.DataRepr.Internal.HList ( ElemOf (..), ) where -import Data.Kind (Type) +import Data.Kind (Constraint, Type) import GHC.Records (HasField, getField) import GHC.TypeLits (Symbol) -import Plutarch (Term) -import Plutarch.Builtin +import Plutarch.Builtin (PAsData) import Plutarch.DataRepr.Internal.FromData (PFromDataable, pmaybeFromAsData) import Plutarch.DataRepr.Internal.HList.Utils ( Drop, @@ -35,19 +36,22 @@ import Plutarch.DataRepr.Internal.HList.Utils ( Labeled (Labeled, unLabeled), SingleItem, ) +import Plutarch.Internal (Term) +import Plutarch.Internal.TypeFamily (Snd) -------------------------------------------------------------------------------- ---------- HList and HRec types -data HRec (as :: [Type]) where +type HRec :: [(Symbol, Type)] -> Type +data HRec as where HNil :: HRec '[] - HCons :: (Labeled name a) -> HRec as -> HRec ((Labeled name a) ': as) + HCons :: Labeled name a -> HRec as -> HRec ('(name, a) ': as) ---------- Field indexing functions -- | Index HRec using Elem -indexHRec :: HRec as -> (forall a. Elem a as -> a) -indexHRec (HCons x _) Here = x +indexHRec :: HRec as -> (forall a. Elem a as -> Snd a) +indexHRec (HCons x _) Here = unLabeled x indexHRec (HCons _ xs) (There i) = indexHRec xs i indexHRec HNil impossible = case impossible of {} @@ -60,12 +64,10 @@ indexHRec HNil impossible = case impossible of {} -} hrecField' :: forall name a as. - ( (IndexLabel name as ~ a) - , ElemOf name a as - ) => + ElemOf name a as => HRec as -> a -hrecField' xs = unLabeled $ indexHRec xs $ elemOf @name @a @as +hrecField' xs = indexHRec xs $ elemOf @name @a @as ---------- Internal utils @@ -75,11 +77,8 @@ hrecField' xs = unLabeled $ indexHRec xs $ elemOf @name @a @as This class could instead be a more direct version of 'indexHList', but perhaps the `Elem` encoding will be useful. -} -class - (IndexLabel name as ~ a) => - ElemOf (name :: Symbol) (a :: Type) (as :: [Type]) - | as name -> a - where +type ElemOf :: Symbol -> Type -> [(Symbol, Type)] -> Constraint +class IndexLabel name as ~ a => ElemOf name a as | as name -> a where -- | Construct the `Elem` corresponding to a Nat index. -- -- Example: @@ -89,10 +88,10 @@ class -- -- >>> natElem @_ @3 -- There (There (There Here)) - elemOf :: Elem (Labeled name a) as + elemOf :: Elem '(name, a) as -instance {-# OVERLAPPING #-} ElemOf name a ((Labeled name a) ': as) where - elemOf :: Elem (Labeled name a) ((Labeled name a) ': as) +instance ElemOf name a ('(name, a) ': as) where + elemOf :: Elem '(name, a) ('(name, a) ': as) elemOf = Here instance @@ -102,7 +101,7 @@ instance ) => ElemOf name a (b ': as) where - elemOf :: Elem (Labeled name a) (b ': as) + elemOf :: Elem '(name, a) (b ': as) elemOf = There (elemOf @name @a @as) {- | @@ -114,19 +113,19 @@ instance >>> 2 -} hrecField :: - forall name a as b c s. - ( IndexLabel name as ~ a - , ElemOf name a as + forall name c as a b s. + ( ElemOf name a as , Term s (PAsData b) ~ a , PFromDataable b c ) => HRec as -> Term s c hrecField xs = pmaybeFromAsData $ hrecField' @name xs +{-# DEPRECATED hrecField "please use getField from GHC.Records" #-} ---------- HasField instances instance - forall name a as b c s. + forall name c as a b s. ( IndexLabel name as ~ a , ElemOf name a as , Term s (PAsData b) ~ a @@ -135,3 +134,16 @@ instance HasField name (HRec as) (Term s c) where getField = hrecField @name + +-- Generic HRec + +newtype HRecGeneric as = HRecGeneric (HRec as) + +instance + forall name a as. + ( IndexLabel name as ~ a + , ElemOf name a as + ) => + HasField name (HRecGeneric as) a + where + getField (HRecGeneric x) = hrecField' @name x diff --git a/Plutarch/DataRepr/Internal/HList/Utils.hs b/Plutarch/DataRepr/Internal/HList/Utils.hs index 230dfe5fa..ef582e91c 100644 --- a/Plutarch/DataRepr/Internal/HList/Utils.hs +++ b/Plutarch/DataRepr/Internal/HList/Utils.hs @@ -31,11 +31,12 @@ data Elem (a :: k) (as :: [k]) where type family IndexList (n :: Nat) (l :: [k]) :: k where IndexList _ '[] = TypeError ( 'Text "IndexList: index out of bounds") IndexList 0 (x ': _) = x - IndexList n (x : xs) = IndexList (n - 1) xs + IndexList n (_ : xs) = IndexList (n - 1) xs --- | Indexing list of labeled types by label -type family IndexLabel (name :: Symbol) (as :: [Type]) :: Type where - IndexLabel name ((Labeled name a) ': _) = a +-- | Indexing list of labeled pairs by label +type IndexLabel :: Symbol -> [(Symbol, Type)] -> Type +type family IndexLabel name as where + IndexLabel name ('(name, a) ': _) = a IndexLabel name (_ ': as) = IndexLabel name as -- | Return the single item from a singleton list @@ -45,4 +46,4 @@ type family SingleItem (as :: [k]) :: k where -- | Drop first n fields of a list type family Drop (n :: Nat) (as :: [k]) :: [k] where Drop 0 xs = xs - Drop n (x ': xs) = Drop (n - 1) xs + Drop n (_ ': xs) = Drop (n - 1) xs diff --git a/Plutarch/Either.hs b/Plutarch/Either.hs index b8001c71b..466982554 100644 --- a/Plutarch/Either.hs +++ b/Plutarch/Either.hs @@ -1,11 +1,21 @@ -module Plutarch.Either (PEither (..)) where +module Plutarch.Either (PEither (PLeft, PRight)) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) -import Plutarch (PType, PlutusType, S, Term) +import GHC.Generics (Generic) +import Plutarch ( + DPTStrat, + DerivePlutusType, + PType, + PlutusType, + PlutusTypeScott, + S, + Term, + ) +import Plutarch.Bool (PEq) +import Plutarch.Show (PShow) data PEither (a :: PType) (b :: PType) (s :: S) = PLeft (Term s a) | PRight (Term s b) - deriving stock (GHC.Generic) - deriving anyclass (Generic, PlutusType) + deriving stock (Generic) + deriving anyclass (PlutusType, PEq, PShow) +instance DerivePlutusType (PEither a b) where type DPTStrat _ = PlutusTypeScott diff --git a/Plutarch/Evaluate.hs b/Plutarch/Evaluate.hs index e9eab2530..f98af30d1 100644 --- a/Plutarch/Evaluate.hs +++ b/Plutarch/Evaluate.hs @@ -1,74 +1,54 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Plutarch.Evaluate (evaluateBudgetedScript, evaluateScript) where +module Plutarch.Evaluate (evalScript, evalScriptHuge, evalScript', EvalError) where -import Control.Monad.Except (runExceptT) import Data.Text (Text) -import Plutus.V1.Ledger.Scripts (Script (Script)) -import qualified Plutus.V1.Ledger.Scripts as Scripts -import PlutusCore (FreeVariableError, defaultVersion) import qualified PlutusCore as PLC import PlutusCore.Evaluation.Machine.ExBudget ( ExBudget (ExBudget), ExRestrictingBudget (ExRestrictingBudget), minusExBudget, ) -import qualified PlutusCore.Evaluation.Machine.ExMemory as ExMemory +import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCekParameters) +import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (ExCPU), ExMemory (ExMemory)) +import PlutusLedgerApi.V1.Scripts (Script (Script)) import UntypedPlutusCore ( Program (Program), Term, - termMapNames, - unNameDeBruijn, ) -import UntypedPlutusCore.DeBruijn (deBruijnTerm) -import qualified UntypedPlutusCore.Evaluation.Machine.Cek as UPLC +import qualified UntypedPlutusCore as UPLC +import qualified UntypedPlutusCore.Evaluation.Machine.Cek as Cek --- Stolen from pluto, thanks Morgan +type EvalError = (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) -{- | Evaluate a script, returning the trace log and term result. +-- | Evaluate a script with a big budget, returning the trace log and term result. +evalScript :: Script -> (Either EvalError Script, ExBudget, [Text]) +evalScript script = evalScript' budget script + where + -- from https://github.com/input-output-hk/cardano-node/blob/master/configuration/cardano/mainnet-alonzo-genesis.json#L17 + budget = ExBudget (ExCPU 10000000000) (ExMemory 10000000) - This is same as `Plutus.V1.Ledger.Scripts.evaluateScript`, but returns the - result as well. --} -evaluateScript :: Script -> Either Scripts.ScriptError (ExBudget, [Text], Script) -evaluateScript = evaluateBudgetedScript $ ExBudget (ExMemory.ExCPU maxInt) (ExMemory.ExMemory maxInt) +-- | Evaluate a script with a huge budget, returning the trace log and term result. +evalScriptHuge :: Script -> (Either EvalError Script, ExBudget, [Text]) +evalScriptHuge script = evalScript' budget script where - maxInt = fromIntegral (maxBound :: Int) + -- from https://github.com/input-output-hk/cardano-node/blob/master/configuration/cardano/mainnet-alonzo-genesis.json#L17 + budget = ExBudget (ExCPU maxBound) (ExMemory maxBound) -evaluateBudgetedScript :: ExBudget -> Script -> Either Scripts.ScriptError (ExBudget, [Text], Script) -evaluateBudgetedScript totalBudget s = do - p <- case Scripts.mkTermToEvaluate s of - Right p -> pure p - Left e -> Left . Scripts.MalformedScript $ show e - let (logOut, usedBudget, result) = evaluateCekBudgetedTrace totalBudget p - named <- case result of - Right term -> pure term - Left errWithCause@(UPLC.ErrorWithCause err cause) -> - Left $ case err of - UPLC.InternalEvaluationError internalEvalError -> - Scripts.EvaluationException (show errWithCause) (show internalEvalError) - UPLC.UserEvaluationError evalError -> - -- We use `show` here because plutus doesn't expose mkError - Scripts.EvaluationError logOut (show (evalError, cause)) - term' <- runExceptT @FreeVariableError (deBruijnTerm named) - let Right term = term' - let s' = Script $ Program () (defaultVersion ()) $ termMapNames unNameDeBruijn term - pure (usedBudget, logOut, s') +-- | Evaluate a script with a specific budget, returning the trace log and term result. +evalScript' :: ExBudget -> Script -> (Either (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) Script, ExBudget, [Text]) +evalScript' budget (Script (Program _ _ t)) = case evalTerm budget (UPLC.termMapNames UPLC.fakeNameDeBruijn $ t) of + (res, remaining, logs) -> (Script . Program () (PLC.defaultVersion ()) . UPLC.termMapNames UPLC.unNameDeBruijn <$> res, remaining, logs) -{- | Evaluate a program in the CEK machine against the given budget, with the - usual text dynamic builtins and tracing, additionally returning the trace - output. --} -evaluateCekBudgetedTrace :: - -- | The resource budget which must not be exceeded during evaluation +evalTerm :: ExBudget -> - Program PLC.Name PLC.DefaultUni PLC.DefaultFun () -> - ( [Text] + Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun () -> + ( Either + EvalError + (Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()) , ExBudget - , Either - (UPLC.CekEvaluationException PLC.DefaultUni PLC.DefaultFun) - (Term PLC.Name PLC.DefaultUni PLC.DefaultFun ()) + , [Text] ) -evaluateCekBudgetedTrace budget (Program _ _ t) = - case UPLC.runCek PLC.defaultCekParameters (UPLC.restricting (ExRestrictingBudget budget)) UPLC.logEmitter t of - (errOrRes, UPLC.RestrictingSt (ExRestrictingBudget final), logs) -> (logs, budget `minusExBudget` final, errOrRes) +evalTerm budget t = + case Cek.runCekDeBruijn defaultCekParameters (Cek.restricting (ExRestrictingBudget budget)) Cek.logEmitter t of + (errOrRes, Cek.RestrictingSt (ExRestrictingBudget final), logs) -> (errOrRes, budget `minusExBudget` final, logs) diff --git a/Plutarch/FFI.hs b/Plutarch/FFI.hs new file mode 100644 index 000000000..00724ecc2 --- /dev/null +++ b/Plutarch/FFI.hs @@ -0,0 +1,242 @@ +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.FFI ( + type (>~<), + PTxList (PTxCons, PTxNil), + PTxMaybe (PTxJust, PTxNothing), + foreignExport, + foreignImport, + opaqueExport, + opaqueImport, + plistFromTx, + plistToTx, + pmaybeFromTx, + pmaybeToTx, + unsafeForeignExport, + unsafeForeignImport, +) where + +import Data.Kind (Constraint, Type) +import Data.Proxy (Proxy (Proxy)) +import qualified Data.Text as T +import Data.Void (Void) +import GHC.Generics (Generic) +import qualified GHC.TypeLits as TypeLits +import qualified Generics.SOP as SOP +import Generics.SOP.GGP (GCode, GDatatypeInfoOf) +import Generics.SOP.Type.Metadata ( + ConstructorInfo (Constructor, Infix, Record), + ConstructorName, + DatatypeInfo (ADT, Newtype), + ) +import Plutarch ( + ClosedTerm, + Config, + DPTStrat, + DerivePlutusType, + PDelayed, + PForall (PForall), + POpaque, + PType, + PlutusTypeNewtype, + PlutusTypeScott, + S, + compile, + pcon, + pdelay, + pforce, + phoistAcyclic, + plam, + pmatch, + pto, + (#), + (:-->), + ) +import Plutarch.Bool (PBool, PEq, (#==)) +import Plutarch.Builtin (PData) +import Plutarch.ByteString (PByteString) +import Plutarch.Integer (PInteger) +import Plutarch.Internal ( + RawTerm (RCompiled), + Term (Term), + TermResult (TermResult), + ) +import Plutarch.Internal.Generic (PCode) +import Plutarch.Internal.PlutusType (PlutusType (PInner, pcon', pmatch')) +import Plutarch.Internal.Witness (witness) +import Plutarch.List (PList, PListLike (PElemConstraint, pcons, pelimList, pnil), pconvertLists, plistEquals) +import Plutarch.Maybe (PMaybe (PJust, PNothing)) +import Plutarch.Show (PShow) +import Plutarch.String (PString) +import Plutarch.Unit (PUnit) +import PlutusLedgerApi.V1.Scripts (Script (Script, unScript), fromCompiledCode) +import PlutusTx.Builtins.Internal (BuiltinBool, BuiltinByteString, BuiltinData, BuiltinUnit) +import PlutusTx.Code (CompiledCode, CompiledCodeIn (DeserializedCode)) +import PlutusTx.Prelude (BuiltinString) +import UntypedPlutusCore (fakeNameDeBruijn) +import qualified UntypedPlutusCore as UPLC + +{- | Plutarch type of lists compatible with the PlutusTx encoding of Haskell + lists and convertible with the regular 'PList' using 'plistToTx' and + 'plistFromTx'. +-} +data PTxList (a :: PType) (s :: S) + = PTxCons (Term s a) (Term s (PTxList a)) + | PTxNil + deriving stock (Generic) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, PShow) + +{- | Plutarch type compatible with the PlutusTx encoding of Haskell 'Maybe' and + convertible with the regular 'PMaybe' using 'pmaybeToTx' and 'pmaybeFromTx'. +-} +data PTxMaybe (a :: PType) (s :: S) + = PTxJust (Term s a) + | PTxNothing + deriving stock (Generic) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, PEq, PShow) + +instance PEq a => PEq (PTxList a) where + (#==) xs ys = plistEquals # xs # ys + +-- | Compile and export a Plutarch term so it can be used by `PlutusTx.applyCode`. +foreignExport :: forall p t. p >~< t => Config -> ClosedTerm p -> CompiledCode t +foreignExport = let _ = witness (Proxy @(p >~< t)) in unsafeForeignExport + +-- | Import compiled UPLC code (such as a spliced `PlutusTx.compile` result) as a Plutarch term. +foreignImport :: forall p t. p >~< t => CompiledCode t -> ClosedTerm p +foreignImport = let _ = witness (Proxy @(p >~< t)) in unsafeForeignImport + +-- | Export Plutarch term of any type as @CompiledCode Void@. +opaqueExport :: Config -> ClosedTerm p -> CompiledCode Void +opaqueExport = unsafeForeignExport + +-- | Import compiled UPLC code of any type as a Plutarch opaque term. +opaqueImport :: CompiledCode t -> ClosedTerm POpaque +opaqueImport = unsafeForeignImport + +-- | Seriously unsafe, may fail at run time or result in unexpected behaviour in your on-chain validator. +unsafeForeignExport :: Config -> ClosedTerm p -> CompiledCode t +unsafeForeignExport config t = DeserializedCode program Nothing mempty + where + (Script (UPLC.Program _ version term)) = either (error . T.unpack) id $ compile config t + program = + UPLC.Program () version $ + UPLC.termMapNames fakeNameDeBruijn term + +-- | Seriously unsafe, may fail at run time or result in unexpected behaviour in your on-chain validator. +unsafeForeignImport :: CompiledCode t -> ClosedTerm p +unsafeForeignImport c = Term $ const $ pure $ TermResult (RCompiled $ UPLC._progTerm $ unScript $ fromCompiledCode c) [] + +-- | Convert a 'PList' to a 'PTxList', perhaps before exporting it with 'foreignExport'. +plistToTx :: Term s (PList a :--> PTxList a) +plistToTx = pconvertLists + +-- | Convert a 'PTxList' to a 'PList', probably after importing it with 'foreignImport'. +plistFromTx :: Term s (PTxList a :--> PList a) +plistFromTx = pconvertLists + +-- | Convert a 'PMaybe' to a 'PTxMaybe', perhaps before exporting it with 'foreignExport'. +pmaybeToTx :: Term s (PMaybe a :--> PTxMaybe a) +pmaybeToTx = + plam $ + flip pmatch $ + pcon . \case + PNothing -> PTxNothing + PJust x -> PTxJust x + +-- | Convert a 'PTxMaybe' to a 'PMaybe', probably after importing it with 'foreignImport'. +pmaybeFromTx :: Term s (PTxMaybe a :--> PMaybe a) +pmaybeFromTx = + plam $ + flip pmatch $ + pcon . \case + PTxNothing -> PNothing + PTxJust x -> PJust x + +newtype PTxList' a r s = PTxList' (Term s (PDelayed (r :--> (a :--> PTxList a :--> r) :--> r))) + deriving stock (Generic) + deriving anyclass (PlutusType) +instance DerivePlutusType (PTxList' a r) where type DPTStrat _ = PlutusTypeNewtype + +instance PlutusType (PTxList a) where + type PInner (PTxList a) = PForall (PTxList' a) + pcon' (PTxCons x xs) = pcon $ PForall $ pcon $ PTxList' $ pdelay $ plam $ \_nil cons -> cons # x # xs + pcon' PTxNil = pcon $ PForall $ pcon $ PTxList' $ phoistAcyclic $ pdelay $ plam $ \nil _cons -> nil + pmatch' elim f = pmatch elim \(PForall elim) -> pforce (pto elim) # f PTxNil # (plam $ \x xs -> f $ PTxCons x xs) + +instance PListLike PTxList where + type PElemConstraint PTxList _ = () + pelimList cons nil list = pmatch (pto list) \(PForall list) -> pforce (pto list) # nil # plam cons + pcons = phoistAcyclic $ plam $ \x xs -> pcon (PTxCons x xs) + pnil = pcon PTxNil + +newtype PTxMaybe' a r s = PTxMaybe' (Term s (PDelayed ((a :--> r) :--> r :--> r))) + deriving stock (Generic) + deriving anyclass (PlutusType) +instance DerivePlutusType (PTxMaybe' a r) where type DPTStrat _ = PlutusTypeNewtype + +instance PlutusType (PTxMaybe a) where + type PInner (PTxMaybe a) = PForall (PTxMaybe' a) + pcon' (PTxJust x) = pcon $ PForall $ pcon $ PTxMaybe' $ pdelay $ plam $ \just _nothing -> just # x + pcon' PTxNothing = pcon $ PForall $ pcon $ PTxMaybe' $ phoistAcyclic $ pdelay $ plam $ \_just nothing -> nothing + pmatch' elim f = pmatch elim \(PForall elim) -> pforce (pto elim) # (plam $ f . PTxJust) # f PTxNothing + +type family F (p :: [PType]) (t :: [Type]) :: Constraint where + F '[] '[] = () + F (x : xs) (y : ys) = (x >~< y, F xs ys) + +type family G (p :: [[PType]]) (t :: [[Type]]) :: Constraint where + G '[] '[] = () + G (x : xs) (y : ys) = (F x y, G xs ys) + +-- | Equality of inner types - Plutarch on the left and Haskell on the right. +type family (p :: PType) >~< (t :: Type) :: Constraint where + PBool >~< BuiltinBool = () + PInteger >~< Integer = () + PString >~< BuiltinString = () + PByteString >~< BuiltinByteString = () + PData >~< BuiltinData = () + PUnit >~< BuiltinUnit = () + (a :--> b) >~< (a' -> b') = (a >~< a', b >~< b') + (PTxList a) >~< [a'] = a >~< a' + (PTxMaybe a) >~< Maybe a' = a >~< a' + (PDelayed p) >~< t = (DPTStrat p ~ PlutusTypeScott, G (PCode p) (TypeEncoding t)) + +type TypeEncoding a = (TypeEncoding' (GCode a) (GDatatypeInfoOf a)) + +type TypeEncoding' :: [[Type]] -> DatatypeInfo -> [[Type]] +type family TypeEncoding' a rep where + TypeEncoding' '[ '[b]] ( 'Newtype _ _ _) = TypeEncoding b +-- Matching the behaviour of PlutusTx.Lift.Class.sortedCons + TypeEncoding' sop ( 'ADT _ "Bool" _ _) = sop + TypeEncoding' sop ( 'ADT _ _ cons _) = Fst (SortedBy '(sop, NamesOf cons)) + +type Fst :: (a, b) -> a +type family Fst x where + Fst '(a, _) = a + +type SortedBy :: ([[Type]], [ConstructorName]) -> ([[Type]], [ConstructorName]) +type family SortedBy xs where + SortedBy '((ts ': tss), (name ': names)) = Insert ts name (SortedBy '(tss, names)) + SortedBy '( '[], '[]) = '( '[], '[]) + +type Insert :: [Type] -> ConstructorName -> ([[Type]], [ConstructorName]) -> ([[Type]], [ConstructorName]) +type family Insert ts name xs where + Insert ts1 name1 '(ts2 ': tss, name2 : names) = Insert' (TypeLits.CmpSymbol name1 name2) ts1 name1 '(ts2 ': tss, name2 : names) + Insert ts name '( '[], '[]) = '( '[ts], '[name]) + +type Insert' :: Ordering -> [Type] -> ConstructorName -> ([[Type]], [ConstructorName]) -> ([[Type]], [ConstructorName]) +type family Insert' o ts name xs where + Insert' 'GT ts1 name1 '(ts2 ': tss, name2 ': names) = Cons ts2 name2 (Insert ts1 name1 '(tss, names)) + Insert' _ ts name '(tss, names) = '(ts ': tss, name ': names) + +type Cons :: a -> b -> ([a], [b]) -> ([a], [b]) +type family Cons ts name xs where + Cons ts name '(tss, names) = '(ts ': tss, name ': names) + +type NamesOf :: [ConstructorInfo] -> [ConstructorName] +type family NamesOf cs where + NamesOf ( 'Constructor name ': cs) = name ': NamesOf cs + NamesOf ( 'Infix name _ _ ': cs) = name ': NamesOf cs + NamesOf ( 'Record name _ ': cs) = name ': NamesOf cs + NamesOf '[] = '[] diff --git a/Plutarch/Integer.hs b/Plutarch/Integer.hs index 4bb079b09..10aeaec1e 100644 --- a/Plutarch/Integer.hs +++ b/Plutarch/Integer.hs @@ -1,40 +1,54 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Integer (PInteger, PIntegral (..)) where -import Plutarch.Bool (PEq, POrd, pif, (#<), (#<=), (#==)) -import Plutarch.Internal.Other ( - DerivePNewtype, +import GHC.Generics (Generic) +import Plutarch.Bool (PEq, POrd, PPartialOrd, pif, (#<), (#<=), (#==)) +import Plutarch.Internal ( Term, phoistAcyclic, - plam, - plet, - pto, - (#), - type (:-->), + (:-->), ) +import Plutarch.Internal.Newtype (PlutusTypeNewtype) +import Plutarch.Internal.Other (POpaque, pto) +import Plutarch.Internal.PLam (plam, (#)) +import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PInner, PlutusType) import Plutarch.Lift ( DerivePConstantDirect (DerivePConstantDirect), - PConstant, + PConstantDecl, PLifted, PUnsafeLiftDecl, pconstant, ) -import Plutarch.Unsafe (punsafeBuiltin, punsafeFrom) +import Plutarch.Num (PNum, pabs, pfromInteger, pnegate, psignum, (#*), (#+), (#-)) +import Plutarch.Unsafe (punsafeBuiltin, punsafeDowncast) import qualified PlutusCore as PLC -- | Plutus BuiltinInteger -data PInteger s +data PInteger s = PInteger (Term s POpaque) + deriving stock (Generic) + deriving anyclass (PlutusType) + +instance DerivePlutusType PInteger where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PInteger where type PLifted PInteger = Integer -deriving via (DerivePConstantDirect Integer PInteger) instance (PConstant Integer) +deriving via (DerivePConstantDirect Integer PInteger) instance PConstantDecl Integer class PIntegral a where pdiv :: Term s (a :--> a :--> a) + default pdiv :: PIntegral (PInner a) => Term s (a :--> a :--> a) + pdiv = phoistAcyclic $ plam $ \x y -> punsafeDowncast $ pdiv # pto x # pto y pmod :: Term s (a :--> a :--> a) + default pmod :: PIntegral (PInner a) => Term s (a :--> a :--> a) + pmod = phoistAcyclic $ plam $ \x y -> punsafeDowncast $ pmod # pto x # pto y pquot :: Term s (a :--> a :--> a) + default pquot :: PIntegral (PInner a) => Term s (a :--> a :--> a) + pquot = phoistAcyclic $ plam $ \x y -> punsafeDowncast $ pquot # pto x # pto y prem :: Term s (a :--> a :--> a) + default prem :: PIntegral (PInner a) => Term s (a :--> a :--> a) + prem = phoistAcyclic $ plam $ \x y -> punsafeDowncast $ prem # pto x # pto y instance PIntegral PInteger where pdiv = punsafeBuiltin PLC.DivideInteger @@ -45,17 +59,19 @@ instance PIntegral PInteger where instance PEq PInteger where x #== y = punsafeBuiltin PLC.EqualsInteger # x # y -instance POrd PInteger where +instance PPartialOrd PInteger where x #<= y = punsafeBuiltin PLC.LessThanEqualsInteger # x # y x #< y = punsafeBuiltin PLC.LessThanInteger # x # y -instance Num (Term s PInteger) where - x + y = punsafeBuiltin PLC.AddInteger # x # y - x - y = punsafeBuiltin PLC.SubtractInteger # x # y - x * y = punsafeBuiltin PLC.MultiplyInteger # x # y - abs x' = plet x' $ \x -> pif (x #<= -1) (negate x) x - negate x = 0 - x - signum x' = plet x' $ \x -> +instance POrd PInteger + +instance PNum PInteger where + x #+ y = punsafeBuiltin PLC.AddInteger # x # y + x #- y = punsafeBuiltin PLC.SubtractInteger # x # y + x #* y = punsafeBuiltin PLC.MultiplyInteger # x # y + pabs = phoistAcyclic $ plam \x -> pif (x #<= -1) (negate x) x + pnegate = phoistAcyclic $ plam \x -> 0 #- x + psignum = plam \x -> pif (x #== 0) 0 @@ -63,10 +79,4 @@ instance Num (Term s PInteger) where (x #<= 0) (-1) 1 - fromInteger = pconstant - -instance PIntegral b => PIntegral (DerivePNewtype a b) where - pdiv = phoistAcyclic $ plam $ \x y -> punsafeFrom $ pdiv # pto x # pto y - pmod = phoistAcyclic $ plam $ \x y -> punsafeFrom $ pmod # pto x # pto y - pquot = phoistAcyclic $ plam $ \x y -> punsafeFrom $ pquot # pto x # pto y - prem = phoistAcyclic $ plam $ \x y -> punsafeFrom $ prem # pto x # pto y + pfromInteger = pconstant diff --git a/Plutarch/Internal.hs b/Plutarch/Internal.hs index 93273b0e9..a9a63f755 100644 --- a/Plutarch/Internal.hs +++ b/Plutarch/Internal.hs @@ -2,10 +2,11 @@ module Plutarch.Internal ( -- | $hoisted - (:-->), + (:-->) (PLam), PDelayed, -- | $term - Term (Term, asRawTerm), + Term (..), + asClosedRawTerm, mapTerm, plam', plet, @@ -19,6 +20,7 @@ module Plutarch.Internal ( punsafeConstant, punsafeConstantInternal, compile, + compile', ClosedTerm, Dig, hashTerm, @@ -27,24 +29,34 @@ module Plutarch.Internal ( TermResult (TermResult, getDeps, getTerm), S (SI), PType, + pthrow, + Config (..), + TracingMode (..), + pgetConfig, + TermMonad (..), ) where +import Control.Monad.Reader (ReaderT (ReaderT), ask, runReaderT) import Crypto.Hash (Context, Digest, hashFinalize, hashInit, hashUpdate) import Crypto.Hash.Algorithms (Blake2b_160) import Crypto.Hash.IO (HashAlgorithm) import qualified Data.ByteString as BS +import Data.Default (Default (def)) +import Data.Functor ((<&>)) import Data.Kind (Type) import Data.List (foldl', groupBy, sortOn) import qualified Data.Map.Lazy as M import qualified Data.Set as S +import Data.String (fromString) +import Data.Text (Text) import qualified Flat.Run as F -import GHC.Stack (HasCallStack) -import Numeric.Natural (Natural) -import Plutarch.Evaluate (evaluateScript) -import Plutus.V1.Ledger.Scripts (Script (Script)) +import GHC.Stack (HasCallStack, callStack, prettyCallStack) +import GHC.Word (Word64) +import Plutarch.Evaluate (evalScript) import PlutusCore (Some (Some), ValueOf (ValueOf)) import qualified PlutusCore as PLC import PlutusCore.DeBruijn (DeBruijn (DeBruijn), Index (Index)) +import PlutusLedgerApi.V1.Scripts (Script (Script)) import qualified UntypedPlutusCore as UPLC {- $hoisted @@ -67,14 +79,17 @@ type Dig = Digest Blake2b_160 data HoistedTerm = HoistedTerm Dig RawTerm deriving stock (Show) +type UTerm = UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun () + data RawTerm - = RVar Natural - | RLamAbs Natural RawTerm + = RVar Word64 + | RLamAbs Word64 RawTerm | RApply RawTerm [RawTerm] | RForce RawTerm | RDelay RawTerm | RConstant (Some (ValueOf PLC.DefaultUni)) | RBuiltin PLC.DefaultFun + | RCompiled UTerm | RError | RHoisted HoistedTerm deriving stock (Show) @@ -91,6 +106,7 @@ hashRawTerm' (RConstant x) = flip hashUpdate ("5" :: BS.ByteString) . flip hashU hashRawTerm' (RBuiltin x) = flip hashUpdate ("6" :: BS.ByteString) . flip hashUpdate (F.flat x) hashRawTerm' RError = flip hashUpdate ("7" :: BS.ByteString) hashRawTerm' (RHoisted (HoistedTerm hash _)) = flip hashUpdate ("8" :: BS.ByteString) . flip hashUpdate hash +hashRawTerm' (RCompiled code) = flip hashUpdate ("9" :: BS.ByteString) . flip hashUpdate (F.flat code) hashRawTerm :: RawTerm -> Dig hashRawTerm t = hashFinalize . hashRawTerm' t $ hashInit @@ -116,7 +132,23 @@ data S = SI -- | Shorthand for Plutarch types. type PType = S -> Type -type role Term phantom representational +data Config = Config + { tracingMode :: TracingMode + } + +data TracingMode = NoTracing | DoTracing | DetTracing + +-- | Default is to be efficient +instance Default Config where + def = + Config + { tracingMode = NoTracing + } + +newtype TermMonad m = TermMonad {runTermMonad :: ReaderT Config (Either Text) m} + deriving newtype (Functor, Applicative, Monad) + +type role Term nominal nominal {- $term Source: Unembedding Domain-Specific Languages by Robert Atkey, Sam Lindley, Jeremy Yallop @@ -132,7 +164,7 @@ type role Term phantom representational de-Bruijn index needed to reach its own level given the level it itself is instantiated with. -} -newtype Term (s :: S) (a :: PType) = Term {asRawTerm :: Natural -> TermResult} +newtype Term (s :: S) (a :: PType) = Term {asRawTerm :: Word64 -> TermMonad TermResult} {- | *Closed* terms with no free variables. @@ -140,6 +172,7 @@ newtype Term (s :: S) (a :: PType) = Term {asRawTerm :: Natural -> TermResult} type ClosedTerm (a :: PType) = forall (s :: S). Term s a data (:-->) (a :: PType) (b :: PType) (s :: S) + = PLam (Term s a -> Term s b) infixr 0 :--> data PDelayed (a :: PType) (s :: S) @@ -151,14 +184,14 @@ data PDelayed (a :: PType) (s :: S) Use 'plam' instead, to support currying. -} plam' :: (Term s a -> Term s b) -> Term s (a :--> b) -plam' f = Term $ \i -> - let v = Term $ \j -> mkTermRes $ RVar (j - (i + 1)) - in case asRawTerm (f v) (i + 1) of +plam' f = Term \i -> + let v = Term \j -> pure $ mkTermRes $ RVar (j - (i + 1)) + in flip fmap (asRawTerm (f v) (i + 1)) \case -- eta-reduce for arity 1 t@(getTerm -> RApply t'@(getArity -> Just _) [RVar 0]) -> t {getTerm = t'} -- eta-reduce for arity 2 + n t@(getTerm -> RLamAbs n (RApply t'@(getArity -> Just n') args)) - | (maybe False (== [0 .. n + 1]) $ traverse (\case RVar n -> Just n; _ -> Nothing) args) + | (== Just [0 .. n + 1]) (traverse (\case RVar n -> Just n; _ -> Nothing) args) && n' >= n + 1 -> t {getTerm = t'} -- increment arity @@ -167,14 +200,14 @@ plam' f = Term $ \i -> t -> mapTerm (RLamAbs 0) t where -- 0 is 1 - getArity :: RawTerm -> Maybe Natural + getArity :: RawTerm -> Maybe Word64 -- We only do this if it's hoisted, since it's only safe if it doesn't -- refer to any of the variables in the wrapping lambda. getArity (RHoisted (HoistedTerm _ (RLamAbs n _))) = Just n getArity (RHoisted (HoistedTerm _ t)) = getArityBuiltin t getArity t = getArityBuiltin t - getArityBuiltin :: RawTerm -> Maybe Natural + getArityBuiltin :: RawTerm -> Maybe Word64 getArityBuiltin (RBuiltin PLC.AddInteger) = Just 1 getArityBuiltin (RBuiltin PLC.SubtractInteger) = Just 1 getArityBuiltin (RBuiltin PLC.MultiplyInteger) = Just 1 @@ -196,7 +229,9 @@ plam' f = Term $ \i -> getArityBuiltin (RBuiltin PLC.Sha2_256) = Just 0 getArityBuiltin (RBuiltin PLC.Sha3_256) = Just 0 getArityBuiltin (RBuiltin PLC.Blake2b_256) = Just 0 - getArityBuiltin (RBuiltin PLC.VerifySignature) = Just 2 + getArityBuiltin (RBuiltin PLC.VerifyEd25519Signature) = Just 2 + getArityBuiltin (RBuiltin PLC.VerifyEcdsaSecp256k1Signature) = Just 2 + getArityBuiltin (RBuiltin PLC.VerifySchnorrSecp256k1Signature) = Just 2 getArityBuiltin (RBuiltin PLC.AppendString) = Just 1 getArityBuiltin (RBuiltin PLC.EqualsString) = Just 1 getArityBuiltin (RBuiltin PLC.EncodeUtf8) = Just 0 @@ -238,43 +273,52 @@ plam' f = Term $ \i -> But sufficiently small terms in WHNF may be inlined for efficiency. -} plet :: Term s a -> (Term s a -> Term s b) -> Term s b -plet v f = Term $ \i -> case asRawTerm v i of - -- Inline sufficiently small terms in WHNF - (getTerm -> RVar _) -> asRawTerm (f v) i - (getTerm -> RBuiltin _) -> asRawTerm (f v) i - (getTerm -> RHoisted _) -> asRawTerm (f v) i - _ -> asRawTerm (papp (plam' f) v) i +plet v f = Term \i -> + asRawTerm v i >>= \case + -- Inline sufficiently small terms in WHNF + (getTerm -> RVar _) -> asRawTerm (f v) i + (getTerm -> RBuiltin _) -> asRawTerm (f v) i + (getTerm -> RHoisted _) -> asRawTerm (f v) i + _ -> asRawTerm (papp (plam' f) v) i + +pthrow' :: HasCallStack => Text -> TermMonad a +pthrow' msg = TermMonad $ ReaderT $ const $ Left (fromString (prettyCallStack callStack) <> "\n\n" <> msg) + +pthrow :: HasCallStack => Text -> Term s a +pthrow = Term . pure . pthrow' -- | Lambda Application. -papp :: Term s (a :--> b) -> Term s a -> Term s b -papp x y = Term $ \i -> case (asRawTerm x i, asRawTerm y i) of - -- Applying anything to an error is an error. - (getTerm -> RError, _) -> mkTermRes RError - -- Applying an error to anything is an error. - (_, getTerm -> RError) -> mkTermRes RError - -- Applying to `id` changes nothing. - (getTerm -> RLamAbs 0 (RVar 0), y') -> y' - (getTerm -> RHoisted (HoistedTerm _ (RLamAbs 0 (RVar 0))), y') -> y' - -- append argument - (x'@(getTerm -> RApply x'l x'r), y') -> TermResult (RApply x'l (getTerm y' : x'r)) (getDeps x' <> getDeps y') - -- new RApply - (x', y') -> TermResult (RApply (getTerm x') [getTerm y']) (getDeps x' <> getDeps y') +papp :: HasCallStack => Term s (a :--> b) -> Term s a -> Term s b +papp x y = Term \i -> + (,) <$> (asRawTerm x i) <*> (asRawTerm y i) >>= \case + -- Applying anything to an error is an error. + (getTerm -> RError, _) -> pthrow' "application to an error" + -- Applying an error to anything is an error. + (_, getTerm -> RError) -> pthrow' "application with an error" + -- Applying to `id` changes nothing. + (getTerm -> RLamAbs 0 (RVar 0), y') -> pure y' + (getTerm -> RHoisted (HoistedTerm _ (RLamAbs 0 (RVar 0))), y') -> pure y' + -- append argument + (x'@(getTerm -> RApply x'l x'r), y') -> pure $ TermResult (RApply x'l (getTerm y' : x'r)) (getDeps x' <> getDeps y') + -- new RApply + (x', y') -> pure $ TermResult (RApply (getTerm x') [getTerm y']) (getDeps x' <> getDeps y') {- | Plutus \'delay\', used for laziness. -} pdelay :: Term s a -> Term s (PDelayed a) -pdelay x = Term $ \i -> mapTerm RDelay $ asRawTerm x i +pdelay x = Term \i -> mapTerm RDelay <$> asRawTerm x i {- | Plutus \'force\', used to force evaluation of 'PDelayed' terms. -} pforce :: Term s (PDelayed a) -> Term s a -pforce x = Term $ \i -> case asRawTerm x i of - -- A force cancels a delay - t@(getTerm -> RDelay t') -> t {getTerm = t'} - t -> mapTerm RForce t +pforce x = Term \i -> + asRawTerm x i <&> \case + -- A force cancels a delay + t@(getTerm -> RDelay t') -> t {getTerm = t'} + t -> mapTerm RForce t {- | Plutus \'error\'. @@ -283,7 +327,12 @@ pforce x = Term $ \i -> case asRawTerm x i of the containing term is delayed, avoiding premature evaluation. -} perror :: Term s a -perror = Term $ \_ -> mkTermRes RError +perror = Term \_ -> pure $ mkTermRes RError + +pgetConfig :: (Config -> Term s a) -> Term s a +pgetConfig f = Term \lvl -> TermMonad $ do + config <- ask + runTermMonad $ asRawTerm (f config) lvl {- | Unsafely coerce the type-tag of a Term. @@ -295,15 +344,15 @@ punsafeCoerce :: Term s a -> Term s b punsafeCoerce (Term x) = Term x punsafeBuiltin :: UPLC.DefaultFun -> Term s a -punsafeBuiltin f = Term $ \_ -> mkTermRes $ RBuiltin f +punsafeBuiltin f = Term \_ -> pure $ mkTermRes $ RBuiltin f {-# DEPRECATED punsafeConstant "Use `pconstant` instead." #-} punsafeConstant :: Some (ValueOf PLC.DefaultUni) -> Term s a punsafeConstant = punsafeConstantInternal punsafeConstantInternal :: Some (ValueOf PLC.DefaultUni) -> Term s a -punsafeConstantInternal c = Term $ \_ -> - case c of +punsafeConstantInternal c = Term \_ -> + pure $ case c of -- These constants are smaller than variable references. Some (ValueOf PLC.DefaultUniBool _) -> mkTermRes $ RConstant c Some (ValueOf PLC.DefaultUniUnit _) -> mkTermRes $ RConstant c @@ -312,22 +361,23 @@ punsafeConstantInternal c = Term $ \_ -> let hoisted = HoistedTerm (hashRawTerm $ RConstant c) (RConstant c) in TermResult (RHoisted hoisted) [hoisted] -asClosedRawTerm :: ClosedTerm a -> TermResult +asClosedRawTerm :: ClosedTerm a -> TermMonad TermResult asClosedRawTerm t = asRawTerm t 0 -- FIXME: Give proper error message when mutually recursive. phoistAcyclic :: HasCallStack => ClosedTerm a -> Term s a -phoistAcyclic t = case asRawTerm t 0 of - -- Built-ins are smaller than variable references - t'@(getTerm -> RBuiltin _) -> Term $ \_ -> t' - t' -> case evaluateScript . Script $ UPLC.Program () (PLC.defaultVersion ()) (compile' t') of - Right _ -> - let hoisted = HoistedTerm (hashRawTerm . getTerm $ t') (getTerm t') - in Term $ \_ -> TermResult (RHoisted hoisted) (hoisted : getDeps t') - Left e -> error $ "Hoisted term errs! " <> show e +phoistAcyclic t = Term \_ -> + asRawTerm t 0 >>= \case + -- Built-ins are smaller than variable references + t'@(getTerm -> RBuiltin _) -> pure $ t' + t' -> case evalScript . Script . UPLC.Program () (PLC.defaultVersion ()) $ compile' t' of + (Right _, _, _) -> + let hoisted = HoistedTerm (hashRawTerm . getTerm $ t') (getTerm t') + in pure $ TermResult (RHoisted hoisted) (hoisted : getDeps t') + (Left e, _, _) -> pthrow' $ "Hoisted term errs! " <> fromString (show e) -- Couldn't find a definition for this in plutus-core -subst :: Natural -> (Natural -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()) -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun () -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun () +subst :: Word64 -> (Word64 -> UTerm) -> UTerm -> UTerm subst idx x (UPLC.Apply () yx yy) = UPLC.Apply () (subst idx x yx) (subst idx x yy) subst idx x (UPLC.LamAbs () name y) = UPLC.LamAbs () name (subst (idx + 1) x y) subst idx x (UPLC.Delay () y) = UPLC.Delay () (subst idx x y) @@ -338,8 +388,8 @@ subst idx _ (UPLC.Var () (DeBruijn (Index idx'))) | idx < idx' = UPLC.Var () (De subst _ _ y = y rawTermToUPLC :: - (HoistedTerm -> Natural -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()) -> - Natural -> + (HoistedTerm -> Word64 -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()) -> + Word64 -> RawTerm -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun () rawTermToUPLC _ _ (RVar i) = UPLC.Var () (DeBruijn . Index $ i + 1) -- Why the fuck does it start from 1 and not 0? @@ -363,24 +413,25 @@ rawTermToUPLC m l (RDelay t) = UPLC.Delay () (rawTermToUPLC m l t) rawTermToUPLC m l (RForce t) = UPLC.Force () (rawTermToUPLC m l t) rawTermToUPLC _ _ (RBuiltin f) = UPLC.Builtin () f rawTermToUPLC _ _ (RConstant c) = UPLC.Constant () c +rawTermToUPLC _ _ (RCompiled code) = code rawTermToUPLC _ _ RError = UPLC.Error () -- rawTermToUPLC m l (RHoisted hoisted) = UPLC.Var () . DeBruijn . Index $ l - m hoisted rawTermToUPLC m l (RHoisted hoisted) = m hoisted l -- UPLC.Var () . DeBruijn . Index $ l - m hoisted -- The logic is mostly for hoisting -compile' :: TermResult -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun () +compile' :: TermResult -> UTerm compile' t = let t' = getTerm t deps = getDeps t - f :: Natural -> Maybe Natural -> (Bool, Maybe Natural) + f :: Word64 -> Maybe Word64 -> (Bool, Maybe Word64) f n Nothing = (True, Just n) f _ (Just n) = (False, Just n) g :: HoistedTerm -> - (M.Map Dig Natural, [(Natural, RawTerm)], Natural) -> - (M.Map Dig Natural, [(Natural, RawTerm)], Natural) + (M.Map Dig Word64, [(Word64, RawTerm)], Word64) -> + (M.Map Dig Word64, [(Word64, RawTerm)], Word64) g (HoistedTerm hash term) (map, defs, n) = case M.alterF (f n) hash map of (True, map) -> (map, (n, term) : defs, n + 1) (False, map) -> (map, defs, n) @@ -414,10 +465,9 @@ compile' t = in wrapped -- | Compile a (closed) Plutus Term to a usable script -compile :: ClosedTerm a -> Script -compile t = Script $ UPLC.Program () (PLC.defaultVersion ()) (compile' $ asClosedRawTerm $ t) +compile :: Config -> ClosedTerm a -> Either Text Script +compile config t = case asClosedRawTerm t of + TermMonad (ReaderT t') -> (Script . UPLC.Program () (UPLC.Version () 1 0 0) . compile') <$> t' config -hashTerm :: ClosedTerm a -> Dig -hashTerm t = - let t' = asRawTerm t 0 - in hashRawTerm . getTerm $ t' +hashTerm :: Config -> ClosedTerm a -> Either Text Dig +hashTerm config t = hashRawTerm . getTerm <$> runReaderT (runTermMonad $ asRawTerm t 0) config diff --git a/Plutarch/Internal/Generic.hs b/Plutarch/Internal/Generic.hs new file mode 100644 index 000000000..438ffe613 --- /dev/null +++ b/Plutarch/Internal/Generic.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +{- Common generics-sop utilities for use in Plutarch. +-} +module Plutarch.Internal.Generic ( + -- * Plutarch adapters for generics-sop API + PGeneric, + PGeneric', + PCode, + gpfrom, + gpto, +) where + +-- lol +import Data.Constraint (Dict (Dict)) +import Data.Kind (Constraint) +import GHC.Exts (Any) +import GHC.Generics (Generic) +import Generics.SOP (All2, I, SOP, Top) +import Generics.SOP.GGP (GCode, GDatatypeInfo, GFrom, GTo, gfrom, gto) +import Plutarch.Internal (PType, S, Term) +import Plutarch.Internal.TypeFamily (ToPType2) +import Unsafe.Coerce (unsafeCoerce) + +class GFrom a => GFrom' a +instance GFrom a => GFrom' a + +class GTo a => GTo' a +instance GTo a => GTo' a + +type PGeneric' :: PType -> S -> Constraint +class + ( Generic (a s) + , GFrom (a s) + , GTo (a s) + , All2 Top (PCode a) -- DO NOT REMOVE! Will cause unsound behavior otherwise. See `unsafeCoerce` below. + , All2 Top (GCode (a s)) + , GDatatypeInfo (a s) + ) => + PGeneric' a s +instance + ( Generic (a s) + , GFrom (a s) + , GTo (a s) + , All2 Top (PCode a) -- DO NOT REMOVE! Will cause unsound behavior otherwise. See `unsafeCoerce` below. + , All2 Top (GCode (a s)) + , GDatatypeInfo (a s) + ) => + PGeneric' a s + +-- | `Generic` constraint extended to work with Plutarch types. +type PGeneric :: PType -> Constraint +class (forall s. PGeneric' a s) => PGeneric a + +instance (forall s. PGeneric' a s) => PGeneric a + +type PCode :: PType -> [[PType]] + +-- | Like `Code` but for Plutarch types +type PCode a = ToPType2 (GCode (a Any)) + +gpfrom :: forall a s. PGeneric a => a s -> SOP (Term s) (PCode a) +-- This could be done safely, but it's a PITA. +-- Depends on `All` constraint above. +gpfrom x = case (Dict :: Dict (PGeneric' a s)) of + Dict -> unsafeCoerce (gfrom x :: SOP I (GCode (a s))) + +gpto :: forall a s. PGeneric a => SOP (Term s) (PCode a) -> a s +-- This could be done safely, but it's a PITA. +-- Depends on `All` constraint above. +gpto x = case (Dict :: Dict (PGeneric' a s)) of + Dict -> gto (unsafeCoerce x :: SOP I (GCode (a s))) diff --git a/Plutarch/Internal/Newtype.hs b/Plutarch/Internal/Newtype.hs new file mode 100644 index 000000000..b98d72228 --- /dev/null +++ b/Plutarch/Internal/Newtype.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.Internal.Newtype (PlutusTypeNewtype) where + +import qualified Generics.SOP as SOP +import Plutarch.Internal (PType) +import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom, gpto) +import Plutarch.Internal.PlutusType ( + DerivedPInner, + PlutusTypeStrat, + PlutusTypeStratConstraint, + derivedPCon, + derivedPMatch, + ) + +data PlutusTypeNewtype + +class (PGeneric a, PCode a ~ '[ '[GetPNewtype a]]) => Helper (a :: PType) +instance (PGeneric a, PCode a ~ '[ '[GetPNewtype a]]) => Helper (a :: PType) + +instance PlutusTypeStrat PlutusTypeNewtype where + type PlutusTypeStratConstraint PlutusTypeNewtype = Helper + type DerivedPInner PlutusTypeNewtype a = GetPNewtype a + derivedPCon x = case gpfrom x of + SOP.SOP (SOP.Z (x SOP.:* SOP.Nil)) -> x + SOP.SOP (SOP.S x) -> case x of {} + derivedPMatch x f = f (gpto $ SOP.SOP $ SOP.Z $ x SOP.:* SOP.Nil) + +type family GetPNewtype' (a :: [[PType]]) :: PType where + GetPNewtype' '[ '[a]] = a + +type family GetPNewtype (a :: PType) :: PType where + GetPNewtype a = GetPNewtype' (PCode a) diff --git a/Plutarch/Internal/Other.hs b/Plutarch/Internal/Other.hs index 66cccc4e2..8a369e9a3 100644 --- a/Plutarch/Internal/Other.hs +++ b/Plutarch/Internal/Other.hs @@ -1,49 +1,29 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE UndecidableInstances #-} module Plutarch.Internal.Other ( - (PI.:-->), - PI.ClosedTerm, - PI.compile, - PI.Dig, - PI.hashTerm, - PI.papp, - PI.pdelay, - PI.PDelayed, - PI.perror, - PI.pforce, - PI.phoistAcyclic, - PI.plam', - PI.plet, - PI.Term, - PI.S, - PI.PType, - PlutusType (..), printTerm, printScript, - (#$), - (#), - pinl, - PCon (..), - PMatch (..), pto, pfix, POpaque (..), popaque, - plam, - DerivePNewtype (DerivePNewtype), ) where -import Data.Coerce (Coercible, coerce) -import Plutarch.Internal (ClosedTerm, PType, Term, compile, phoistAcyclic, punsafeCoerce, (:-->)) -import qualified Plutarch.Internal as PI -import Plutarch.Internal.PLam (pinl, plam, (#), (#$)) -import Plutarch.Internal.PlutusType (PCon (pcon), PMatch (pmatch), PlutusType (PInner, pcon', pmatch')) -import Plutus.V1.Ledger.Scripts (Script (Script)) +import qualified Data.Text as T +import GHC.Stack (HasCallStack) +import Plutarch.Internal (ClosedTerm, Config, Term, compile, phoistAcyclic, punsafeCoerce, (:-->)) +import Plutarch.Internal.PLam (plam, (#)) +import Plutarch.Internal.PlutusType ( + PContravariant', + PCovariant', + PInner, + PVariant', + PlutusType, + pcon', + pmatch', + ) import PlutusCore.Pretty (prettyPlcReadableDebug) +import PlutusLedgerApi.V1.Scripts (Script (Script)) -- | Prettyprint a compiled Script via the PLC pretty printer printScript :: Script -> String @@ -57,20 +37,23 @@ printScript = show . prettyPlcReadableDebug . (\(Script s) -> s) > show . prettyPlcReadableDef . (\(Right p) -> p) . Scripts.mkTermToEvaluate . compile $ term -} -printTerm :: ClosedTerm a -> String -printTerm term = printScript $ compile term +printTerm :: HasCallStack => Config -> ClosedTerm a -> String +printTerm config term = printScript $ either (error . T.unpack) id $ compile config term {- | Safely coerce from a Term to it's 'PInner' representation. -} -pto :: Term s a -> (forall b. Term s (PInner a b)) +pto :: Term s a -> Term s (PInner a) pto x = punsafeCoerce x -- | An Arbitrary Term with an unknown type data POpaque s = POpaque (Term s POpaque) instance PlutusType POpaque where - type PInner POpaque _ = POpaque + type PInner POpaque = POpaque + type PCovariant' POpaque = () + type PContravariant' POpaque = () + type PVariant' POpaque = () pcon' (POpaque x) = x pmatch' x f = f (POpaque x) @@ -103,44 +86,3 @@ pfix = phoistAcyclic $ plam $ \f -> (plam $ \(x :: Term s POpaque) -> f # (plam $ \(v :: Term s POpaque) -> (punsafeCoerce x) # x # v)) # punsafeCoerce (plam $ \(x :: Term s POpaque) -> f # (plam $ \(v :: Term s POpaque) -> (punsafeCoerce x) # x # v)) - -{- | Facilitates deriving 'PlutusType' and 'PIsData' for newtypes. - -For any newtype represented as- -> newtype PFoo (s :: S) = PFoo (Term s PBar) - -where 'PBar' has a 'PIsData' instance, you can derive 'PlutusType' and 'PIsData' using- -> deriving (PlutusType, PIsData) via (DerivePNewtype PFoo PBar) - -This will make 'PFoo' simply be represnted as 'PBar' under the hood. --} -newtype DerivePNewtype (a :: PType) (b :: PType) (s :: PI.S) = DerivePNewtype (a s) - -instance (forall (s :: PI.S). Coercible (a s) (Term s b)) => PlutusType (DerivePNewtype a b) where - type PInner (DerivePNewtype a b) _ = b - pcon' (DerivePNewtype t) = ptypeInner t - pmatch' x f = f . DerivePNewtype $ ptypeOuter x - -instance Semigroup (Term s b) => Semigroup (Term s (DerivePNewtype a b)) where - x <> y = punsafeFrom $ pto x <> pto y - -instance Monoid (Term s b) => Monoid (Term s (DerivePNewtype a b)) where - mempty = punsafeFrom $ mempty @(Term s b) - -instance Num (Term s b) => Num (Term s (DerivePNewtype a b)) where - x + y = punsafeFrom $ pto x + pto y - x - y = punsafeFrom $ pto x - pto y - x * y = punsafeFrom $ pto x * pto y - abs x = punsafeFrom $ abs $ pto x - negate x = punsafeFrom $ negate $ pto x - signum x = punsafeFrom $ signum $ pto x - fromInteger x = punsafeFrom $ fromInteger @(Term s b) x - -ptypeInner :: forall (x :: PType) y s. Coercible (x s) (Term s y) => x s -> Term s y -ptypeInner = coerce - -ptypeOuter :: forall (x :: PType) y s. Coercible (x s) (Term s y) => Term s y -> x s -ptypeOuter = coerce - -punsafeFrom :: (forall b. Term s (PInner a b)) -> Term s a -punsafeFrom x = PI.punsafeCoerce x diff --git a/Plutarch/Internal/PLam.hs b/Plutarch/Internal/PLam.hs index 86b93bfdc..89a9b20e5 100644 --- a/Plutarch/Internal/PLam.hs +++ b/Plutarch/Internal/PLam.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Plutarch.Internal.PLam ( @@ -9,6 +9,7 @@ module Plutarch.Internal.PLam ( ) where import Data.Kind (Type) +import GHC.Stack (HasCallStack) import Plutarch.Internal (PType, S, Term, papp, plam', (:-->)) {- | @@ -18,7 +19,7 @@ import Plutarch.Internal (PType, S, Term, papp, plam', (:-->)) >>> f # x # y f x y -} -(#) :: Term s (a :--> b) -> Term s a -> Term s b +(#) :: HasCallStack => Term s (a :--> b) -> Term s a -> Term s b (#) = papp infixl 8 # @@ -30,7 +31,7 @@ infixl 8 # >>> f # x #$ g # y # z f x (g y z) -} -(#$) :: Term s (a :--> b) -> Term s a -> Term s b +(#$) :: HasCallStack => Term s (a :--> b) -> Term s a -> Term s b (#$) = papp infixr 0 #$ @@ -51,10 +52,10 @@ infixr 0 #$ class PLamN (a :: Type) (b :: PType) (s :: S) | a -> b, s b -> a where plam :: forall c. (Term s c -> a) -> Term s (c :--> b) -instance (a' ~ Term s a) => PLamN a' a s where +instance {-# OVERLAPPABLE #-} (a' ~ Term s a) => PLamN a' a s where plam = plam' -instance {-# OVERLAPPING #-} (a' ~ Term s a, PLamN b' b s) => PLamN (a' -> b') (a :--> b) s where +instance (a' ~ Term s a, PLamN b' b s) => PLamN (a' -> b') (a :--> b) s where plam f = plam' $ \x -> plam (f x) pinl :: Term s a -> (Term s a -> Term s b) -> Term s b diff --git a/Plutarch/Internal/PlutusType.hs b/Plutarch/Internal/PlutusType.hs index edfd5936a..f2c03e019 100644 --- a/Plutarch/Internal/PlutusType.hs +++ b/Plutarch/Internal/PlutusType.hs @@ -1,348 +1,127 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} module Plutarch.Internal.PlutusType ( - PlutusType (..), - PCon (..), - PMatch (..), + PlutusType, + PlutusTypeStratConstraint, + PCon, + PMatch, + pcon', + pmatch', + pmatch, + pcon, + PInner, + PlutusTypeStrat, + DerivePlutusType, + DPTStrat, + DerivedPInner, + derivedPCon, + derivedPMatch, + PVariant, + PCovariant, + PContravariant, + PVariant', + PCovariant', + PContravariant', ) where -import Data.Kind (Type) -import Data.SOP.Constraint (AllZipF) -import GHC.TypeLits (ErrorMessage (Text), Nat, TypeError, type (+)) -import Generics.SOP ( - All, - AllZip, - AllZipN, - Generic (..), - I, - LiftedCoercible, - NP (..), - NS (..), - Prod, - SOP (SOP), - SameShapeAs, - Top, - hcoerce, - unSOP, - ) -import Plutarch.DataRepr.Internal.Generic (MkSum (mkSum)) -import Plutarch.DataRepr.Internal.HList.Utils (IndexList) -import Plutarch.Internal (PType, S, Term, pforce, plam', punsafeCoerce, (:-->)) -import qualified Plutarch.Internal as PI +import Data.Kind (Constraint, Type) +import Data.Proxy (Proxy (Proxy)) +import GHC.TypeLits (ErrorMessage (ShowType, Text, (:<>:)), TypeError) +import Generics.SOP (All2) +import Plutarch.Internal (PType, Term, plam', plet, punsafeCoerce, (:-->) (PLam)) +import Plutarch.Internal.Generic (PCode) import Plutarch.Internal.PLam ((#)) -import Plutarch.Internal.TypeFamily (ToPType, ToPType2) - -{- | - - The 'PlutusType' class allows encoding Haskell data-types as plutus terms - via constructors and destructors. - - Typically, you want to use scott encoding to represent the data type, which - can be automatically derived as follows: - - > import qualified GHC.Generics as GHC - > import Generics.SOP - > - > data MyType (a :: PType) (b :: PType) (s :: S) - > = One (Term s a) - > | Two (Term s b) - > deriving stock (GHC.Generic) - > deriving anyclass (Generic, PlutusType) - - If you instead want to use data encoding, you should first implement "Plutarch.PDataRepr.PIsDataRepr", and then - derive 'PlutusType' via "Plutarch.PDataRepr.PIsDataReprInstances": - - > import qualified GHC.Generics as GHC - > import Generics.SOP - > import Plutarch.DataRepr - > - > data MyType (a :: PType) (b :: PType) (s :: S) - > = One (Term s (PDataRecord '[ "_0" ':= a ])) - > | Two (Term s (PDataRecord '[ "_0" ':= b ])) - > deriving stock (GHC.Generic) - > deriving anyclass (Generic, PIsDataRepr) - > deriving (PlutusType, PIsData) via PIsDataReprInstances (MyType a b) - - Alternatively, you may derive 'PlutusType' by hand as well. A simple example, encoding a - Sum type as an Enum via PInteger: - - > data AB (s :: S) = A | B - > - > instance PlutusType AB where - > type PInner AB _ = PInteger - > - > pcon' A = 0 - > pcon' B = 1 - > - > pmatch' x f = - > pif (x #== 0) (f A) (f B) - > - - instead of using `pcon'` and `pmatch'` directly, - use 'pcon' and 'pmatch', to hide the `PInner` type: - - > swap :: Term s AB -> Term s AB - > swap x = pmatch x $ \case - > A -> pcon B - > B -> pcon A - - Further examples can be found in examples/PlutusType.hs --} -class (PCon a, PMatch a) => PlutusType (a :: PType) where - -- `b' :: k'` causes GHC to fail type checking at various places - -- due to not being able to expand the type family. - type PInner a (b' :: PType) :: PType - type PInner a (b' :: PType) = ScottFn (ScottList 'PI.SI (ToPType2 (Code (a 'PI.SI))) b') b' - pcon' :: forall s b. a s -> Term s (PInner a b) - default pcon' :: - forall s b code pcode. - ( code ~ Code (a s) - , pcode ~ ToPType2 code - , Generic (a s) - , GPCon pcode b s - , PLamL (ScottList' s pcode b) b s - , ScottFn' (ScottList s pcode b) b ~ PInner a b - , ScottFn (ScottList' s pcode b) b ~ PInner a b - , AllZipF (AllZip (LiftedCoercible I (Term s))) code pcode - , SameShapeAs code pcode - , SameShapeAs pcode code - , All Top pcode - ) => - a s -> - Term s (PInner a b) - pcon' x = gpcon @a @b $ from x - - pmatch' :: forall s b. (Term s (PInner a b)) -> (a s -> Term s b) -> Term s b - default pmatch' :: - forall s b code pcode. - ( code ~ Code (a s) - , pcode ~ ToPType2 code - , Generic (a s) - , AppL b (ScottList' s pcode b) - , GPMatch a 0 code b s - , PInner a b ~ ScottFn (ScottList' s pcode b) b - ) => - (Term s (PInner a b)) -> - (a s -> Term s b) -> - Term s b - pmatch' x f = gpmatch @a x (f . to) - -instance {-# OVERLAPPABLE #-} PlutusType a => PMatch a where - pmatch x f = pmatch' (punsafeCoerce x) f - -instance PlutusType a => PCon a where - pcon x = punsafeCoerce (pcon' x) - -class PCon a where - -- | Construct a Plutarch Term via a Haskell datatype - pcon :: a s -> Term s a - -class PMatch a where - -- | Pattern match over Plutarch Terms via a Haskell datatype - pmatch :: Term s a -> (a s -> Term s b) -> Term s b - --- | Generic version of `pcon'` -gpcon :: - forall a c s code pcode. - ( PlutusType a - , Generic (a s) - , code ~ Code (a s) - , pcode ~ ToPType2 code - , GPCon pcode c s - , PLamL (ScottList' s pcode c) c s - , ScottFn (ScottList' s pcode c) c ~ ScottFn' (ScottList s pcode c) c - , AllZipN (Prod SOP) (LiftedCoercible I (Term s)) code pcode +import Plutarch.Internal.Quantification (PFix (PFix), PForall (PForall), PSome (PSome)) +import Plutarch.Internal.Witness (witness) + +class PlutusTypeStrat (strategy :: Type) where + type PlutusTypeStratConstraint strategy :: PType -> Constraint + type DerivedPInner strategy (a :: PType) :: PType + derivedPCon :: forall a s. (DerivePlutusType a, DPTStrat a ~ strategy) => a s -> Term s (DerivedPInner strategy a) + derivedPMatch :: forall a s b. (DerivePlutusType a, DPTStrat a ~ strategy) => Term s (DerivedPInner strategy a) -> (a s -> Term s b) -> Term s b + +class + ( PInner a ~ DerivedPInner (DPTStrat a) a + , PlutusTypeStrat (DPTStrat a) + , PlutusTypeStratConstraint (DPTStrat a) a + , PlutusType a ) => - SOP I (Code (a s)) -> - Term s (ScottFn' (ScottList s pcode c) c) -gpcon val = - plamL @(ScottList' s pcode c) @c $ \(f :: NP (Term s) (ScottList' s pcode c)) -> - gpcon' @pcode @c @s f $ - unSOP $ pSop val + DerivePlutusType (a :: PType) where - pSop :: AllZipN (Prod SOP) (LiftedCoercible I (Term s)) xss (ToPType2 xss) => SOP I xss -> SOP (Term s) (ToPType2 xss) - pSop = hcoerce - -{- | - `gpcon'`, given a *partial* scott encoding (as a `PLamL`) and a sum choice, applies - that encoding to the sum choice. - - The partial encoding is any tail of the full scott encoded function, such that - one of its elements corresponds to the sum choice. --} -class GPCon (xss :: [[PType]]) (c :: PType) (s :: S) where - gpcon' :: NP (Term s) (ScottList' s xss c) -> NS (NP (Term s)) xss -> Term s c - -instance GPCon '[] c s where - gpcon' Nil = \case {} - -instance (GPCon xs c s, AppL c x) => GPCon (x ': xs) c s where - gpcon' (f :* fs) = \case - Z x -> f `appL` x - S xs -> gpcon' fs xs - -{- | - Generic version of `pmatch'` --} -gpmatch :: - forall a s c code pcode. - ( Generic (a s) - , code ~ Code (a s) - , pcode ~ ToPType2 code - , AppL c (ScottList' s pcode c) - , GPMatch a 0 code c s - ) => - Term s (ScottFn (ScottList' s pcode c) c) -> - (SOP I (Code (a s)) -> Term s c) -> - Term s c -gpmatch x f = - x `appL` gpmatch' @a @0 @code @c @s f - -{- | - `gpmatch'` returns a hlist of lambdas (or delayed terms) to be applied on the - scott encoding function. --} -class GPMatch (a :: PType) (n :: Nat) (xss :: [[Type]]) (c :: PType) (s :: S) where - gpmatch' :: (SOP I (Code (a s)) -> Term s c) -> NP (Term s) (ScottList' s (ToPType2 xss) c) - -instance GPMatch a n '[] c s where - gpmatch' _ = Nil - -instance - ( code ~ Code (a s) - , xs ~ IndexList n code - , GPMatch a (n + 1) xss c s - , PLamL (ToPType xs) c s - , MkSum n (Code (a s)) - , AllZipF (LiftedCoercible (Term s) I) (ToPType xs) xs - , SameShapeAs xs (ToPType xs) - , SameShapeAs (ToPType xs) xs - , All Top (ToPType xs) - , All Top xs - ) => - GPMatch a n (xs : xss) c s - where - gpmatch' f = - plamL @(ToPType xs) @c (f . SOP . mkSum @n @(Code (a s)) . unPsop) - :* gpmatch' @a @(n + 1) @xss @c @s f - where - unPsop :: - ( AllZipF (LiftedCoercible (Term s) I) (ToPType xs) xs - , SameShapeAs xs (ToPType xs) - , SameShapeAs (ToPType xs) xs - , All Top (ToPType xs) - , All Top xs - ) => - NP (Term s) (ToPType xs) -> - NP I xs - unPsop = hcoerce - -{- | - `plamL` is like `plamL'`, but pdelays the 0-arity case. - - ``` - plamL $ \Nil -> pcon 42 -- Equivalent to: `pdelay (pcon 42)`. --} -class PLamL (as :: [PType]) (b :: PType) (s :: S) where - plamL :: (NP (Term s) as -> Term s b) -> Term s (ScottFn as b) - -instance PLamL '[] b s where - plamL f = PI.pdelay $ f Nil - -instance PLamL' as b s => PLamL (a ': as) b s where - plamL f = plam' $ \a -> plamL' $ \as -> f (a :* as) - -{- | - `plamL'` produces a multi-arity plam, but taking a HList of Plutarch terms as - arguments. - - ``` - plamL $ \(x :* y :* Nil) -> - x + y - ``` - - - `NP (Term s) '[x, y]` corresponds to `x :* y :* Nil`. - - `ScottFn' '[x, y] b` corresponds to `x :--> y :--> b`. --} -class PLamL' (as :: [PType]) (b :: PType) (s :: S) where - plamL' :: (NP (Term s) as -> Term s b) -> Term s (ScottFn' as b) - -instance PLamL' '[] b s where - plamL' f = f Nil - -instance PLamL' as b s => PLamL' (a ': as) b s where - plamL' f = plam' $ \a -> plamL' $ \as -> f (a :* as) - -{- | - `appL` is like `appL'`, but pforce's the 0-arity case. - - ``` - f = plamL $ \Nil -> pdelay $ pcon 42 - g = f `appL` Ni - ``` --} -class AppL (c :: PType) (xs :: [PType]) where - appL :: Term s (ScottFn xs c) -> NP (Term s) xs -> Term s c - -instance AppL c '[] where - appL f Nil = pforce f - -instance (AppL' c xs, AppL c xs) => AppL c (x ': xs) where - appL f (x :* xs) = (f # x) `appL'` xs - -{- | - `appL'` takes a multi-argument lambda (produced by `plamL`) and applies it to - the associated list of values. - - ``` - f = plamL $ \(x :* y :* z :* Nil) -> x + y + z - g = f `appL'` (1 :* 2 :* 3 :* Nil) - ``` --} -class AppL' (c :: PType) (xs :: [PType]) where - appL' :: Term s (ScottFn' xs c) -> NP (Term s) xs -> Term s c - -instance AppL' c '[] where - appL' f Nil = f - -instance AppL' c xs => AppL' c (x ': xs) where - appL' f (x :* xs) = (f # x) `appL'` xs - -{- | - List of scott-encoded constructors of a Plutarch type (represented by `Code`) - - ScottList s (Code (PEither a b s)) c = '[a :--> c, b :--> c] --} -type ScottList :: S -> [[PType]] -> PType -> [PType] -type family ScottList s code c where --- We disallow certain shapes because Scott encoding is not appropriate for them. - ScottList _ '[] c = TypeError ( 'Text "PlutusType(scott encoding): Data type without constructors not accepted") - ScottList _ '[ '[]] c = TypeError ( 'Text "PlutusType(scott encoding): Data type with single nullary constructor not accepted") - ScottList _ '[ '[_]] c = TypeError ( 'Text "PlutusType(scott encoding): Data type with single unary constructor not accepted; use newtype!") - ScottList s (xs ': xss) c = ScottFn xs c ': ScottList' s xss c - -type ScottList' :: S -> [[PType]] -> PType -> [PType] -type family ScottList' s code c where - ScottList' _ '[] c = '[] - ScottList' s (xs ': xss) c = ScottFn xs c ': ScottList' s xss c - -{- | - An individual constructor function of a Scott encoding. - - ScottFn '[a, b] c = (a :--> b :--> c) - ScottFn '[] c = PDelayed c --} -type ScottFn :: [PType] -> PType -> PType -type family ScottFn xs b where - ScottFn '[] b = PI.PDelayed b - ScottFn (x ': xs) b = x :--> ScottFn' xs b - -{- | - Like `ScottFn`, but without the PDelayed case. --} -type ScottFn' :: [PType] -> PType -> PType -type family ScottFn' xs b where - ScottFn' '[] b = b - ScottFn' (x ': xs) b = x :--> ScottFn' xs b + type DPTStrat a :: Type + type DPTStrat a = TypeError ( 'Text "Please specify a strategy for deriving PlutusType for type " ':<>: 'ShowType a) + +class PlutusType (a :: PType) where + type PInner a :: PType + type PInner a = DerivedPInner (DPTStrat a) a + type PCovariant' a :: Constraint + type PCovariant' a = All2 PCovariant'' (PCode a) + type PContravariant' a :: Constraint + type PContravariant' a = All2 PContravariant'' (PCode a) + type PVariant' a :: Constraint + type PVariant' a = All2 PVariant'' (PCode a) + pcon' :: forall s. a s -> Term s (PInner a) + default pcon' :: DerivePlutusType a => forall s. a s -> Term s (PInner a) + pcon' = let _ = witness (Proxy @(PlutusType a)) in derivedPCon + + pmatch' :: forall s b. Term s (PInner a) -> (a s -> Term s b) -> Term s b + -- FIXME buggy GHC, needs AllowAmbiguousTypes + default pmatch' :: DerivePlutusType a => forall s b. Term s (PInner a) -> (a s -> Term s b) -> Term s b + pmatch' = derivedPMatch + +{-# DEPRECATED PCon "Use PlutusType" #-} +type PCon = PlutusType +{-# DEPRECATED PMatch "Use PlutusType" #-} +type PMatch = PlutusType + +-- | Construct a Plutarch Term via a Haskell datatype +pcon :: PlutusType a => a s -> Term s a +pcon x = punsafeCoerce (pcon' x) + +-- | Pattern match over Plutarch Terms via a Haskell datatype +pmatch :: PlutusType a => Term s a -> (a s -> Term s b) -> Term s b +pmatch x = pmatch' (punsafeCoerce x) + +class PCovariant' a => PCovariant'' a +instance PCovariant' a => PCovariant'' a + +class PContravariant' a => PContravariant'' a +instance PContravariant' a => PContravariant'' a + +class PVariant' a => PVariant'' a +instance PVariant' a => PVariant'' a + +class (forall t. PCovariant'' t => PCovariant'' (a t)) => PCovariant a +instance (forall t. PCovariant'' t => PCovariant'' (a t)) => PCovariant a + +class (forall t. PCovariant'' t => PContravariant'' (a t)) => PContravariant a +instance (forall t. PCovariant'' t => PContravariant'' (a t)) => PContravariant a + +class (forall t. PVariant'' t => PVariant'' (a t)) => PVariant a +instance (forall t. PVariant'' t => PVariant'' (a t)) => PVariant a + +instance PlutusType (a :--> b) where + type PInner (a :--> b) = a :--> b + type PCovariant' (a :--> b) = (PContravariant' a, PCovariant' b) + type PContravariant' (a :--> b) = (PCovariant' a, PContravariant' b) + type PVariant' (a :--> b) = (PVariant' a, PVariant' b) + pcon' (PLam f) = plam' f + pmatch' f g = plet f \f' -> g (PLam (f' #)) + +instance PlutusType (PForall f) where + type PInner (PForall f) = PForall f + pcon' (PForall x) = punsafeCoerce x + pmatch' x f = f (PForall $ punsafeCoerce x) + +instance PlutusType (PSome f) where + type PInner (PSome f) = PSome f + pcon' (PSome x) = punsafeCoerce x + pmatch' x f = f (PSome $ punsafeCoerce x) + +instance PlutusType (PFix f) where + type PInner (PFix f) = f (PFix f) + pcon' (PFix x) = x + pmatch' x f = f (PFix x) diff --git a/Plutarch/Internal/Quantification.hs b/Plutarch/Internal/Quantification.hs new file mode 100644 index 000000000..0bf68fdfb --- /dev/null +++ b/Plutarch/Internal/Quantification.hs @@ -0,0 +1,12 @@ +module Plutarch.Internal.Quantification (PForall (PForall), PSome (PSome), PFix (PFix)) where + +import Plutarch.Internal (PType, Term) + +type PForall :: (a -> PType) -> PType +newtype PForall (b :: a -> PType) s = PForall (forall (x :: a). Term s (b x)) + +type PSome :: (a -> PType) -> PType +data PSome (b :: a -> PType) s = forall (x :: a). PSome (Term s (b x)) + +type PFix :: (PType -> PType) -> PType +newtype PFix f s = PFix (Term s (f (PFix f))) diff --git a/Plutarch/Internal/ScottEncoding.hs b/Plutarch/Internal/ScottEncoding.hs new file mode 100644 index 000000000..65aba9f33 --- /dev/null +++ b/Plutarch/Internal/ScottEncoding.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module Plutarch.Internal.ScottEncoding (PlutusTypeScott, PScottEncoded (PScottEncoded)) where + +import Data.Proxy (Proxy (Proxy)) +import Generics.SOP ( + All, + NP (Nil, (:*)), + NS (S, Z), + SListI, + SListI2, + SOP (SOP), + case_SList, + cpara_SList, + para_SList, + ) +import Plutarch.Internal (PDelayed, PType, Term, pdelay, pforce, plam', plet, (:-->)) +import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom, gpto) +import Plutarch.Internal.PLam ((#)) +import Plutarch.Internal.PlutusType ( + DerivedPInner, + PInner, + PlutusType, + PlutusTypeStrat, + PlutusTypeStratConstraint, + derivedPCon, + derivedPMatch, + pcon, + pcon', + pmatch, + pmatch', + ) +import Plutarch.Internal.Quantification (PForall (PForall)) + +data PlutusTypeScott + +type ScottFn' :: [PType] -> PType -> PType +type family ScottFn' xs r where + ScottFn' '[] r = r + ScottFn' (x ': xs) r = x :--> ScottFn' xs r + +type ScottFn :: [PType] -> PType -> PType +type family ScottFn xs r where + ScottFn '[] r = PDelayed r + ScottFn xs r = ScottFn' xs r + +-- scottList l r = map (flip scottFn r) l +type ScottList :: [[PType]] -> PType -> [PType] +type family ScottList code r where + ScottList '[] _ = '[] + ScottList (xs ': xss) r = ScottFn xs r ': ScottList xss r + +newtype PScottEncoded a r s = PScottEncoded (Term s (ScottFn (ScottList a r) r)) + +instance PlutusType (PScottEncoded a r) where + type PInner (PScottEncoded a r) = ScottFn (ScottList a r) r + pcon' (PScottEncoded x) = x + pmatch' x f = f (PScottEncoded x) + +newtype PLamL' s b as = PLamL' {unPLamL' :: (NP (Term s) as -> Term s b) -> Term s (ScottFn' as b)} + +-- Explicitly variadic `plam`. +plamL' :: SListI as => (NP (Term s) as -> Term s b) -> Term s (ScottFn' as b) +plamL' = unPLamL' $ para_SList (PLamL' \f -> f Nil) (\(PLamL' prev) -> PLamL' \f -> plam' \a -> prev \as -> f (a :* as)) + +newtype PLamL s b as = PLamL {unPLamL :: (NP (Term s) as -> Term s b) -> Term s (ScottFn as b)} + +-- `pdelay`s the 0-arity case. +plamL :: SListI as => (NP (Term s) as -> Term s b) -> Term s (ScottFn as b) +plamL = unPLamL $ case_SList (PLamL \f -> pdelay $ f Nil) (PLamL plamL') + +newtype PAppL' s r as = PAppL' {unPAppL' :: Term s (ScottFn' as r) -> NP (Term s) as -> Term s r} + +pappL' :: SListI as => Term s (ScottFn' as c) -> NP (Term s) as -> Term s c +pappL' = unPAppL' $ para_SList (PAppL' \f Nil -> f) (\(PAppL' prev) -> PAppL' \f (x :* xs) -> prev (f # x) xs) + +newtype PAppL s r as = PAppL {unPAppL :: Term s (ScottFn as r) -> NP (Term s) as -> Term s r} + +pappL :: SListI as => Term s (ScottFn as r) -> NP (Term s) as -> Term s r +pappL = unPAppL $ case_SList (PAppL \f Nil -> pforce f) (PAppL pappL') + +newtype PLetL s r as = PLetL {unPLetL :: NP (Term s) as -> (NP (Term s) as -> Term s r) -> Term s r} + +pletL' :: SListI as => NP (Term s) as -> (NP (Term s) as -> Term s r) -> Term s r +pletL' = unPLetL $ para_SList + (PLetL \Nil f -> f Nil) + \(PLetL prev) -> PLetL \(x :* xs) f -> plet x \x' -> + prev xs (\xs' -> f (x' :* xs')) + +pletL :: All SListI as => SOP (Term s) as -> (SOP (Term s) as -> Term s r) -> Term s r +pletL (SOP (Z x)) f = pletL' x \x' -> f (SOP $ Z x') +pletL (SOP (S xs)) f = pletL (SOP xs) \(SOP xs') -> f (SOP $ S xs') + +newtype GPCon' s r as = GPCon' {unGPCon' :: NP (Term s) (ScottList as r) -> NS (NP (Term s)) as -> Term s r} + +{- | + `gpcon'`, given a *partial* scott encoding (as a `PLamL`) and a sum choice, applies + that encoding to the sum choice. + + The partial encoding is any tail of the full scott encoded function, such that + one of its elements corresponds to the sum choice. +-} +gpcon' :: SListI2 as => NP (Term s) (ScottList as r) -> NS (NP (Term s)) as -> Term s r +gpcon' = unGPCon' $ cpara_SList (Proxy @SListI) (GPCon' \Nil -> \case {}) \(GPCon' prev) -> GPCon' \(arg :* args) -> \case + Z x -> pappL arg x + S xs -> prev args xs + +-- | Generic version of `pcon'` +gpcon :: + forall as r s. + (SListI (ScottList as r), SListI2 as) => + SOP (Term s) as -> + Term s (PScottEncoded as r) +gpcon fields' = + pletL fields' \(SOP fields) -> + pcon $ PScottEncoded $ plamL \args -> (gpcon' args fields :: Term s r) + +newtype GPMatch' s r as = GPMatch' {unGPMatch' :: (SOP (Term s) as -> Term s r) -> NP (Term s) (ScottList as r)} + +gpmatch' :: + forall as r s. + SListI2 as => + (SOP (Term s) as -> Term s r) -> + NP (Term s) (ScottList as r) +gpmatch' = unGPMatch' $ cpara_SList (Proxy @SListI) (GPMatch' (const Nil)) \(GPMatch' prev) -> GPMatch' \f -> + plamL (\args -> f (SOP $ Z args)) :* prev (\(SOP x) -> f (SOP (S x))) + +gpmatch :: + forall as r s. + (SListI (ScottList as r), SListI2 as) => + Term s (PScottEncoded as r) -> + (SOP (Term s) as -> Term s r) -> + Term s r +gpmatch x' f = pmatch x' \(PScottEncoded x) -> pappL x (gpmatch' f) + +class SListI (ScottList (PCode a) r) => SListIScottList a r +instance SListI (ScottList (PCode a) r) => SListIScottList a r + +class + ( forall r. SListIScottList a r + , SListI2 (PCode a) + , PGeneric a + ) => + PlutusTypeScottConstraint a +instance + ( forall r. SListIScottList a r + , SListI2 (PCode a) + , PGeneric a + ) => + PlutusTypeScottConstraint a + +instance PlutusTypeStrat PlutusTypeScott where + type PlutusTypeStratConstraint PlutusTypeScott = PlutusTypeScottConstraint + type DerivedPInner PlutusTypeScott a = PForall (PScottEncoded (PCode a)) + derivedPCon x = pcon $ PForall $ gpcon $ gpfrom x + derivedPMatch x' f = pmatch x' \(PForall x) -> gpmatch x (f . gpto) diff --git a/Plutarch/Internal/TypeFamily.hs b/Plutarch/Internal/TypeFamily.hs index 335da1367..4d107f5de 100644 --- a/Plutarch/Internal/TypeFamily.hs +++ b/Plutarch/Internal/TypeFamily.hs @@ -1,6 +1,9 @@ -module Plutarch.Internal.TypeFamily (ToPType, ToPType2, UnTerm) where +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.Internal.TypeFamily (ToPType, ToPType2, UnTerm, Snd) where import Data.Kind (Type) +import GHC.TypeLits (ErrorMessage (Text), TypeError) import Plutarch.Internal (PType, Term) -- | Convert a list of `Term s a` to a list of `a`. @@ -16,4 +19,8 @@ type family ToPType2 as where type UnTerm :: Type -> PType type family UnTerm x where - UnTerm (Term s a) = a + UnTerm (Term _ a) = a + UnTerm _ = TypeError ( 'Text "Non-term in Plutarch data type not allowed") + +type family Snd ab where + Snd '(_, b) = b diff --git a/Plutarch/Internal/Witness.hs b/Plutarch/Internal/Witness.hs new file mode 100644 index 000000000..48d231010 --- /dev/null +++ b/Plutarch/Internal/Witness.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + +module Plutarch.Internal.Witness (witness) where + +import Data.Proxy (Proxy) + +witness :: c => Proxy c -> () +witness _ = () diff --git a/Plutarch/Lift.hs b/Plutarch/Lift.hs index d9ad2380b..a1984f65f 100644 --- a/Plutarch/Lift.hs +++ b/Plutarch/Lift.hs @@ -1,8 +1,15 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} +{- | +Module: Plutarch.Lift +Description: Conversion to and from Plutarch terms and Haskell types + +This module defines functions, associated type families, and newtypes for use with +[@DerivingVia@](https://ryanglscott.github.io/papers/deriving-via.pdf) to allow +Plutarch to convert to and from PTypes and Haskell types. +-} module Plutarch.Lift ( -- * Converstion between Plutarch terms and Haskell types pconstant, @@ -11,28 +18,39 @@ module Plutarch.Lift ( LiftError, -- * Define your own conversion - PConstant (..), + PConstantDecl (..), PLift, + PConstant, DerivePConstantDirect (..), DerivePConstantViaNewtype (..), + DerivePConstantViaBuiltin (..), -- * Internal use PUnsafeLiftDecl (..), ) where -import Data.Coerce -import Data.Kind (Type) +import Control.Lens ((^?)) +import Data.Coerce (Coercible, coerce) +import Data.Kind (Constraint, Type) +import Data.Text (Text) import GHC.Stack (HasCallStack) -import Plutarch.Evaluate (evaluateScript) -import Plutarch.Internal (ClosedTerm, PType, Term, compile, punsafeConstantInternal) -import qualified Plutus.V1.Ledger.Scripts as Scripts +import Plutarch.Evaluate (EvalError, evalScriptHuge) +import Plutarch.Internal (ClosedTerm, Config (Config, tracingMode), PType, Term, compile, punsafeConstantInternal, pattern DoTracing) import qualified PlutusCore as PLC -import PlutusCore.Constant (readKnownConstant) -import PlutusCore.Evaluation.Machine.Exception (ErrorWithCause, MachineError) +import PlutusCore.Builtin (KnownTypeError, readKnownConstant) +import PlutusCore.Evaluation.Machine.Exception (_UnliftingErrorE) +import qualified PlutusLedgerApi.V1.Scripts as Scripts +import PlutusTx (BuiltinData, Data, builtinDataToData, dataToBuiltinData) +import PlutusTx.Builtins.Class (FromBuiltin, ToBuiltin, fromBuiltin, toBuiltin) import qualified UntypedPlutusCore as UPLC -class (PConstant (PLifted p), PConstanted (PLifted p) ~ p) => PUnsafeLiftDecl (p :: PType) where - type PLifted p :: Type +{- | +Laws: + - It must be that @PConstantRepr (PLifted p)@ when encoded as a constant + in UPLC (via the 'UntypedPlutusCore.Constant' constructor) is a valid @p@. +-} +class (PConstantDecl (PLifted p), PConstanted (PLifted p) ~ p) => PUnsafeLiftDecl (p :: PType) where + type PLifted p = (r :: Type) | r -> p {- | Class of Haskell types `h` that can be represented as a Plutus core builtin and converted to a Plutarch type. @@ -40,8 +58,21 @@ and converted to a Plutarch type. The Plutarch type is determined by `PConstanted h`. Its Plutus Core representation is given by `PConstantRepr h`. This typeclass is closely tied with 'PLift'. + +Laws: + - @pconstantFromRepr . pconstantToRepr ≡ Just@ + - @(pconstantToRepr <$>) . pconstantFromRepr ≡ Just@ + - @plift . pfromData . flip ptryFrom fst . pconstant . PlutusTx.toData ≡ id@ + - @PlutusTx.fromData . plift . pforgetData . pdata . pconstant ≡ Just@ + +These laws must be upheld for the sake of soundness of the type system. -} -class (PUnsafeLiftDecl (PConstanted h), PLC.DefaultUni `PLC.Includes` PConstantRepr h) => PConstant (h :: Type) where +class + ( PUnsafeLiftDecl (PConstanted h) + , PLC.DefaultUni `PLC.Includes` PConstantRepr h + ) => + PConstantDecl (h :: Type) + where type PConstantRepr h :: Type type PConstanted h :: PType pconstantToRepr :: h -> PConstantRepr h @@ -53,6 +84,7 @@ The Haskell type is determined by `PLifted p`. This typeclass is closely tied with 'PConstant'. -} +type PLift :: PType -> Constraint type PLift = PUnsafeLiftDecl {- | Create a Plutarch-level constant, from a Haskell value. @@ -64,48 +96,142 @@ pconstant x = punsafeConstantInternal $ PLC.someValue @(PConstantRepr (PLifted p -- | Error during script evaluation. data LiftError - = LiftError_ScriptError Scripts.ScriptError - | LiftError_EvalException (ErrorWithCause (MachineError PLC.DefaultFun) ()) + = LiftError_EvalError EvalError + | LiftError_KnownTypeError KnownTypeError | LiftError_FromRepr - | LiftError_WrongRepr - deriving stock (Eq, Show) + | LiftError_CompilationError Text + deriving stock (Eq) {- | Convert a Plutarch term to the associated Haskell value. Fail otherwise. This will fully evaluate the arbitrary closed expression, and convert the resulting value. -} -plift' :: forall p. PUnsafeLiftDecl p => ClosedTerm p -> Either LiftError (PLifted p) -plift' prog = case evaluateScript (compile prog) of - Right (_, _, Scripts.unScript -> UPLC.Program _ _ term) -> - case readKnownConstant @_ @(PConstantRepr (PLifted p)) @(MachineError PLC.DefaultFun) Nothing term of - Right r -> case pconstantFromRepr r of - Just h -> Right h - Nothing -> Left LiftError_FromRepr - Left e -> Left $ LiftError_EvalException e - Left e -> Left $ LiftError_ScriptError e +plift' :: forall p. PUnsafeLiftDecl p => Config -> ClosedTerm p -> Either LiftError (PLifted p) +plift' config prog = case compile config prog of + Left msg -> Left $ LiftError_CompilationError msg + Right script -> case evalScriptHuge script of + (Right (Scripts.unScript -> UPLC.Program _ _ term), _, _) -> + case readKnownConstant term of + Right r -> case pconstantFromRepr r of + Just h -> Right h + Nothing -> Left LiftError_FromRepr + Left e -> Left $ LiftError_KnownTypeError e + (Left e, _, _) -> Left $ LiftError_EvalError e -- | Like `plift'` but throws on failure. plift :: forall p. (HasCallStack, PLift p) => ClosedTerm p -> PLifted p -plift prog = case plift' prog of +plift prog = case plift' (Config {tracingMode = DoTracing}) prog of Right x -> x - Left e -> error $ "plift failed: " <> show e - --- TODO: Add haddock + Left LiftError_FromRepr -> error "plift failed: pconstantFromRepr returned 'Nothing'" + Left (LiftError_KnownTypeError e) -> + let unliftErrMaybe = e ^? _UnliftingErrorE + in error $ + "plift failed: incorrect type: " + <> maybe "absurd evaluation failure" show unliftErrMaybe + Left (LiftError_EvalError e) -> error $ "plift failed: erring term: " <> show e + Left (LiftError_CompilationError msg) -> error $ "plift failed: compilation failed: " <> show msg + +{- | Newtype wrapper for deriving @PConstant@ when the wrapped type is directly +represented by a builtin UPLC type that is /not/ @Data@. + + Ex: @PInteger@ is directly represented as a builtin integer. +-} newtype DerivePConstantDirect (h :: Type) (p :: PType) = DerivePConstantDirect h instance (PLift p, PLC.DefaultUni `PLC.Includes` h) => - PConstant (DerivePConstantDirect h p) + PConstantDecl (DerivePConstantDirect h p) where type PConstantRepr (DerivePConstantDirect h p) = h type PConstanted (DerivePConstantDirect h p) = p pconstantToRepr = coerce pconstantFromRepr = Just . coerce --- TODO: Add haddock -newtype DerivePConstantViaNewtype (h :: Type) (p :: PType) (p' :: PType) = DerivePConstantViaNewtype h +{- | Newtype wrapper for deriving @PConstant@ when the wrapped type is represented +indirectly by a builtin UPLC type that is /not/ @Data@. + + Ex: @PPubKeyHash@ is a newtype to a @PByteString@ and @PByteString@ is directly + represented as a builtin bytestring. + +Polymorphic types can be derived as follows: + +>newtype Foo a = Foo a +> +>newtype PFoo a s = PFoo (Term s a) +> +>instance forall a. PLift a => PUnsafeLiftDecl (PFoo a) where +> type PLifted (PFoo a) = Foo (PLifted a) +> +>deriving via +> ( DerivePConstantViaNewtype +> (Foo a) +> (PFoo (PConstanted a)) +> (PConstanted a) +> ) +> instance +> PConstant a => +> PConstantDecl (Foo a) +-} +newtype + DerivePConstantViaNewtype + (h :: Type) + (p :: PType) -- PType to associate with the newtype + (p' :: PType) -- Underlying UPLC representation type + = -- | The Haskell newtype we are deriving a @PConstant@ instance for + DerivePConstantViaNewtype h + +{- | Type synonym to simplify deriving of @PConstant@ via @DerivePConstantViaNewtype@. + +A newtype @Foo a@ is considered "Constantable" if: + +- The wrapped type @a@ has a @PConstant@ instance. +- The lifted type of @a@ has a @PUnsafeLiftDecl@ instance. +- There is type equality between @a@ and @PLifted (PConstanted a)@. + +These constraints are sufficient to derive a @PConstant@ instance for the newtype. -instance (PLift p, PLift p', Coercible h (PLifted p')) => PConstant (DerivePConstantViaNewtype h p p') where +For deriving @PConstant@ for a wrapped type represented in UPLC as @Data@, see +@DerivePConstantViaData@. +-} +type PConstant :: Type -> Constraint +type PConstant a = (a ~ PLifted (PConstanted a), PConstantDecl a) + +instance (PLift p, PLift p', Coercible h (PLifted p')) => PConstantDecl (DerivePConstantViaNewtype h p p') where type PConstantRepr (DerivePConstantViaNewtype h p p') = PConstantRepr (PLifted p') type PConstanted (DerivePConstantViaNewtype h p p') = p pconstantToRepr x = pconstantToRepr @(PLifted p') $ coerce x pconstantFromRepr x = coerce $ pconstantFromRepr @(PLifted p') x + +class ToBuiltin' a arep | a -> arep where + toBuiltin' :: a -> arep + +class FromBuiltin' arep a | arep -> a where + fromBuiltin' :: arep -> a + +-- FIXME this overlappable instance is nonsense and disregards the fundep +instance {-# OVERLAPPABLE #-} ToBuiltin a arep => ToBuiltin' a arep where + toBuiltin' = toBuiltin + +instance {-# OVERLAPPABLE #-} FromBuiltin arep a => FromBuiltin' arep a where + fromBuiltin' = fromBuiltin + +instance ToBuiltin' Data BuiltinData where + toBuiltin' = dataToBuiltinData + +instance FromBuiltin' BuiltinData Data where + fromBuiltin' = builtinDataToData + +newtype DerivePConstantViaBuiltin (h :: Type) (p :: PType) (p' :: PType) = DerivePConstantViaBuiltin h + +instance + ( PLift p + , PLift p' + , Coercible h h' + , ToBuiltin' (PLifted p') h' + , FromBuiltin' h' (PLifted p') + ) => + PConstantDecl (DerivePConstantViaBuiltin h p p') + where + type PConstantRepr (DerivePConstantViaBuiltin h p p') = PConstantRepr (PLifted p') + type PConstanted (DerivePConstantViaBuiltin h p p') = p + pconstantToRepr x = pconstantToRepr @(PLifted p') $ fromBuiltin' (coerce x :: h') + pconstantFromRepr x = coerce (toBuiltin' <$> pconstantFromRepr @(PLifted p') x :: Maybe h') diff --git a/Plutarch/List.hs b/Plutarch/List.hs index ba09ad1d9..6a20a8bce 100644 --- a/Plutarch/List.hs +++ b/Plutarch/List.hs @@ -4,6 +4,7 @@ module Plutarch.List ( PListLike (..), PIsListLike, pconvertLists, + pshowList, -- * Comparison plistEquals, @@ -13,10 +14,17 @@ module Plutarch.List ( plength, ptryIndex, pdrop, + pfind, + pelemAt, + (#!!), -- * Construction psingleton, + -- * Deconstruction + puncons, + ptryUncons, + -- * Combine pconcat, pzipWith, @@ -42,13 +50,15 @@ module Plutarch.List ( import Numeric.Natural (Natural) -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) +import GHC.Generics (Generic) import Plutarch ( ClosedTerm, + DPTStrat, + DerivePlutusType, PDelayed, PType, PlutusType, + PlutusTypeScott, S, Term, pcon, @@ -63,18 +73,44 @@ import Plutarch ( (#$), type (:-->), ) -import Plutarch.Bool (PBool (PFalse, PTrue), PEq, pif, (#&&), (#==), (#||)) +import Plutarch.Bool (PBool (PFalse, PTrue), PEq, pif, (#&&), (#<), (#==), (#||)) import Plutarch.Integer (PInteger) import Plutarch.Lift (pconstant) +import Plutarch.Maybe (PMaybe (PJust, PNothing)) import Plutarch.Pair (PPair (PPair)) +import Plutarch.String (PString) import Data.Kind +import Plutarch.Show (PShow (pshow'), pshow) +import Plutarch.Trace (ptraceError) data PList (a :: PType) (s :: S) = PSCons (Term s a) (Term s (PList a)) | PSNil - deriving stock (GHC.Generic) - deriving anyclass (Generic, PlutusType) + deriving stock (Generic) + deriving anyclass (PlutusType) +instance DerivePlutusType (PList a) where type DPTStrat _ = PlutusTypeScott + +instance PShow a => PShow (PList a) where + pshow' _ x = pshowList @PList @a # x + +pshowList :: forall list a s. (PShow a, PIsListLike list a) => Term s (list a :--> PString) +pshowList = + phoistAcyclic $ + plam $ \list -> + "[" <> pshowList' @list @a # list <> "]" + +pshowList' :: forall list a s. (PShow a, PIsListLike list a) => Term s (list a :--> PString) +pshowList' = + phoistAcyclic $ + precList + ( \self x xs -> + pelimList + (\_ _ -> pshow x <> ", " <> self # xs) + (pshow x) + xs + ) + (const "") instance PEq a => PEq (PList a) where (#==) xs ys = plistEquals # xs # ys @@ -85,7 +121,7 @@ instance PEq a => PEq (PList a) where type PIsListLike list a = (PListLike list, PElemConstraint list a) -- | Plutarch types that behave like lists. -class PListLike (list :: (PType) -> PType) where +class PListLike (list :: PType -> PType) where type PElemConstraint list (a :: PType) :: Constraint -- | Canonical eliminator for list-likes. @@ -133,6 +169,24 @@ pconvertLists = phoistAcyclic $ (\x xs -> pcons # x #$ self # xs) pnil +-- | Extract head and tail of the list, throws error if list is empty. +ptryUncons :: + PIsListLike list a => + Term s (list a :--> PPair a (list a)) +ptryUncons = + phoistAcyclic $ + plam $ + pelimList (\x -> pcon . PPair x) perror + +-- | Extract head and tail of the list, if list is not empty. +puncons :: + PIsListLike list a => + Term s (list a :--> PMaybe (PPair a (list a))) +puncons = + phoistAcyclic $ + plam $ + pelimList (\x -> pcon . PJust . pcon . PPair x) (pcon PNothing) + -- | Like 'pelimList', but with a fixpoint recursion hatch. precList :: PIsListLike list a => @@ -166,11 +220,11 @@ pelem = -- | / O(n) /. Count the number of elements in the list plength :: PIsListLike list a => Term s (list a :--> PInteger) -plength = phoistAcyclic $ - plam $ \xs -> - let go :: PIsListLike list a => Term s (list a :--> PInteger :--> PInteger) - go = (pfix #$ plam $ \self ls n -> pelimList (\_ xs -> self # xs # n + 1) n ls) - in go # xs # 0 +plength = + phoistAcyclic $ + let go :: PIsListLike list a => Term s (PInteger :--> list a :--> PInteger) + go = pfix #$ plam $ \self n -> pelimList (\_ xs -> self # (n + 1) # xs) n + in go # 0 -- | Index a BuiltinList, throwing an error if the index is out of bounds. ptryIndex :: (PIsListLike list a) => Natural -> Term s (list a) -> Term s a @@ -197,20 +251,18 @@ pdrop n xs = pdrop' n # xs pfoldl :: PIsListLike list a => Term s ((b :--> a :--> b) :--> b :--> list a :--> b) pfoldl = phoistAcyclic $ plam $ \f -> - pfix #$ plam $ \self z l -> + pfix #$ plam $ \self z -> pelimList (\x xs -> self # (f # z # x) # xs) z - l -- | The same as 'pfoldl', but with Haskell-level reduction function. pfoldl' :: PIsListLike list a => (forall s. Term s b -> Term s a -> Term s b) -> Term s (b :--> list a :--> b) pfoldl' f = phoistAcyclic $ - pfix #$ plam $ \self z l -> + pfix #$ plam $ \self z -> pelimList (\x xs -> self # f z x # xs) z - l -- | / O(n) /. Fold on a list right-associatively. pfoldr :: PIsListLike list a => Term s ((a :--> b :--> b) :--> b :--> list a :--> b) @@ -363,3 +415,42 @@ plistEquals = ) (pelimList (\_ _ -> pconstant False) (pconstant True) ylist) xlist + +-- | / O(n) /. Like Haskell level `(!!)` but on the plutarch level +(#!!) :: (PIsListLike l a) => Term s (l a) -> Term s PInteger -> Term s a +l #!! i = pelemAt # i # l + +{- | / O(n) /. Like Haskell level `(!!)` but on the Plutarch level, not infix and + with arguments reversed, errors if the specified index is greater than or equal + to the lists length +-} +pelemAt :: PIsListLike l a => Term s (PInteger :--> l a :--> a) +pelemAt = phoistAcyclic $ + plam $ \n xs -> + pif + (n #< 0) + (ptraceError "pelemAt: negative index") + (pelemAt' # n # xs) + +-- | / O(n) /. like `pelemAt` but doesn't fail on negative indexes +pelemAt' :: PIsListLike l a => Term s (PInteger :--> l a :--> a) +pelemAt' = phoistAcyclic $ + pfix #$ plam $ \self n xs -> + pif + (n #== 0) + (phead # xs) + (self # (n - 1) #$ ptail # xs) + +-- | / O(n) /. like haskell level `find` but on plutarch level +pfind :: PIsListLike l a => Term s ((a :--> PBool) :--> l a :--> PMaybe a) +pfind = phoistAcyclic $ + pfix #$ plam $ \self f xs -> + pelimList + ( \y ys -> + pif + (f # y) + (pcon $ PJust y) + (self # f # ys) + ) + (pcon PNothing) + xs diff --git a/Plutarch/Maybe.hs b/Plutarch/Maybe.hs index 9c63c5467..e2a3cbdfd 100644 --- a/Plutarch/Maybe.hs +++ b/Plutarch/Maybe.hs @@ -1,17 +1,40 @@ -module Plutarch.Maybe (PMaybe (..)) where +module Plutarch.Maybe ( + PMaybe (PJust, PNothing), + pfromJust, +) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) +import GHC.Generics (Generic) import Plutarch ( + DPTStrat, + DerivePlutusType, PType, PlutusType, + PlutusTypeScott, S, Term, + perror, + phoistAcyclic, + plam, + pmatch, + type (:-->), ) +import Plutarch.Bool (PEq) +import Plutarch.Show (PShow) -- | Plutus Maybe type, with Scott-encoded repr data PMaybe (a :: PType) (s :: S) = PJust (Term s a) | PNothing - deriving stock (GHC.Generic) - deriving anyclass (Generic, PlutusType) + deriving stock (Generic) + deriving anyclass (PlutusType, PEq, PShow) + +instance DerivePlutusType (PMaybe a) where type DPTStrat _ = PlutusTypeScott + +{- | + fallible unwrapping from @PMaybe@ +-} +pfromJust :: Term s (PMaybe a :--> a) +pfromJust = phoistAcyclic $ + plam $ \maybe -> pmatch maybe $ \case + PNothing -> perror + PJust a -> a diff --git a/Plutarch/Num.hs b/Plutarch/Num.hs new file mode 100644 index 000000000..20f480798 --- /dev/null +++ b/Plutarch/Num.hs @@ -0,0 +1,53 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Plutarch.Num (PNum (..)) where + +import Plutarch.Internal ( + PType, + Term, + punsafeCoerce, + (:-->), + ) +import Plutarch.Internal.Other (pto) +import Plutarch.Internal.PLam ((#)) +import Plutarch.Internal.PlutusType (PInner) +import Plutarch.Unsafe (punsafeDowncast) + +class PNum (a :: PType) where + (#+) :: Term s a -> Term s a -> Term s a + default (#+) :: PNum (PInner a) => Term s a -> Term s a -> Term s a + x #+ y = punsafeDowncast $ pto x #+ pto y + + (#-) :: Term s a -> Term s a -> Term s a + default (#-) :: PNum (PInner a) => Term s a -> Term s a -> Term s a + x #- y = punsafeDowncast $ pto x #- pto y + + (#*) :: Term s a -> Term s a -> Term s a + default (#*) :: PNum (PInner a) => Term s a -> Term s a -> Term s a + x #* y = punsafeDowncast $ pto x #* pto y + + pnegate :: Term s (a :--> a) + default pnegate :: PNum (PInner a) => Term s (a :--> a) + pnegate = punsafeCoerce (pnegate :: Term s (PInner a :--> PInner a)) + + pabs :: Term s (a :--> a) + default pabs :: PNum (PInner a) => Term s (a :--> a) + pabs = punsafeCoerce (pabs :: Term s (PInner a :--> PInner a)) + + psignum :: Term s (a :--> a) + default psignum :: PNum (PInner a) => Term s (a :--> a) + psignum = punsafeCoerce (psignum :: Term s (PInner a :--> PInner a)) + + pfromInteger :: Integer -> Term s a + default pfromInteger :: PNum (PInner a) => Integer -> Term s a + pfromInteger x = punsafeDowncast $ pfromInteger x + +-- orphan instance, but only visibly orphan when importing internal modules +instance PNum a => Num (Term s a) where + (+) = (#+) + (-) = (#-) + (*) = (#*) + abs x = pabs # x + negate x = pnegate # x + signum x = psignum # x + fromInteger = pfromInteger diff --git a/Plutarch/Pair.hs b/Plutarch/Pair.hs index efaf3d113..c66c27f20 100644 --- a/Plutarch/Pair.hs +++ b/Plutarch/Pair.hs @@ -1,15 +1,20 @@ module Plutarch.Pair (PPair (..)) where -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) -import Plutarch (PType, PlutusType, S, Term) +import GHC.Generics (Generic) +import Plutarch.Bool (PEq) +import Plutarch.Internal (PType, S, Term) +import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType) +import Plutarch.Internal.ScottEncoding (PlutusTypeScott) +import Plutarch.Show (PShow) {- | Plutus encoding of Pairs. - Note: This is represented differently than 'BuiltinPair' + Note: This is represented differently than 'BuiltinPair'. It is scott-encoded. -} data PPair (a :: PType) (b :: PType) (s :: S) = PPair (Term s a) (Term s b) - deriving stock (GHC.Generic) - deriving anyclass (Generic, PlutusType) + deriving stock (Generic) + deriving anyclass (PlutusType, PEq, PShow) + +instance DerivePlutusType (PPair a b) where type DPTStrat _ = PlutusTypeScott diff --git a/Plutarch/Positive.hs b/Plutarch/Positive.hs new file mode 100644 index 000000000..45e96367b --- /dev/null +++ b/Plutarch/Positive.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.Positive (PPositive, ppositive, ptryPositive) where + +import Data.Functor.Const (Const) +import GHC.Generics (Generic) + +import Plutarch.Bool (PEq, POrd, PPartialOrd, pif, (#<=)) +import Plutarch.Builtin (PAsData, PData, PIsData, pdata) +import Plutarch.Integer (PInteger, PIntegral) + +import Plutarch.Maybe (PMaybe (PJust, PNothing)) + +import Plutarch ( + DerivePlutusType (DPTStrat), + PlutusType, + PlutusTypeNewtype, + Term, + TermCont (runTermCont), + pcon, + phoistAcyclic, + plam, + plet, + pthrow, + pto, + (#), + (#$), + type (:-->), + ) +import Plutarch.Num (PNum (pfromInteger, (#-))) +import Plutarch.Show (PShow) +import Plutarch.TermCont (tcont) +import Plutarch.Trace (ptraceError) +import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'), ptryFrom) + +newtype PPositive s = PPositive (Term s PInteger) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd, PIntegral, PShow) +instance DerivePlutusType PPositive where type DPTStrat _ = PlutusTypeNewtype + +instance PNum PPositive where + x #- y = ptryPositive #$ pto x #- pto y + + pfromInteger x + | x <= 0 = pthrow "PPositive.pfromInteger: encountered non positive" + | otherwise = pcon $ PPositive $ pfromInteger x + +instance PTryFrom PInteger PPositive where + type PTryFromExcess PInteger PPositive = Const () + ptryFrom' opq = runTermCont $ pure (ptryPositive # opq, ()) + +newtype Flip f a b = Flip (f b a) deriving stock (Generic) + +instance PTryFrom PData (PAsData PPositive) where + type PTryFromExcess PData (PAsData PPositive) = Flip Term PPositive + ptryFrom' opq = runTermCont $ do + (_, i) <- tcont $ ptryFrom @(PAsData PInteger) opq + res <- tcont . plet $ ptryPositive # i + resData <- tcont . plet $ pdata res + pure (resData, res) + +-- | Build a 'PPositive' from a 'PInteger'. Yields 'PNothing' if argument is zero. +ppositive :: Term s (PInteger :--> PMaybe PPositive) +ppositive = phoistAcyclic $ + plam $ \i -> + pif + (i #<= 0) + (pcon PNothing) + $ pcon . PJust . pcon $ PPositive i + +-- | Partial version of 'PPositive'. Errors if argument is zero. +ptryPositive :: Term s (PInteger :--> PPositive) +ptryPositive = phoistAcyclic $ + plam $ \i -> + pif + (i #<= 0) + (ptraceError "ptryPositive: building with non positive") + $ pcon $ PPositive i diff --git a/Plutarch/Prelude.hs b/Plutarch/Prelude.hs index 8fe129866..ad2cba234 100644 --- a/Plutarch/Prelude.hs +++ b/Plutarch/Prelude.hs @@ -3,8 +3,8 @@ module Plutarch.Prelude ( (:-->), PDelayed, Term, + ClosedTerm, plam, - plam', papp, pdelay, pforce, @@ -16,28 +16,37 @@ module Plutarch.Prelude ( pinl, pto, pfix, + pthrow, Type, S, PType, PlutusType (PInner), - PCon (pcon), - PMatch (pmatch), + DerivePlutusType, + DPTStrat, + PlutusTypeScott, + PlutusTypeNewtype, + PlutusTypeData, + PCon, + PMatch, + pcon, + pmatch, + PForall (PForall), -- * Integers and integer utilities PInteger, PIntegral (pdiv, pmod, pquot, prem), -- * Rational numbers and utilities - PRational, + PRational (PRational), pnumerator, pdenominator, - pfromInteger, pround, -- * Booleans and boolean functions PBool (..), PEq ((#==)), - POrd ((#<=), (#<)), + PPartialOrd ((#<=), (#<)), + POrd, pif, pnot, (#&&), @@ -64,6 +73,7 @@ module Plutarch.Prelude ( PIsListLike, plistEquals, pelem, + pelemAt, plength, ptryIndex, pdrop, @@ -74,12 +84,14 @@ module Plutarch.Prelude ( pzip, pmap, pfilter, + pfind, precList, pfoldr, pfoldrLazy, pfoldl, pall, pany, + (#!!), -- * Scott encoded list type PList (..), @@ -93,31 +105,38 @@ module Plutarch.Prelude ( -- * Scott encoded pair type and utilities PPair (..), + -- * Opaque type + POpaque (POpaque), + popaque, + -- * Builtin types and utilities - PData (..), + PData, pfstBuiltin, psndBuiltin, PBuiltinPair, PBuiltinList (..), - PIsData (pfromData, pdata), + PIsData, + pfromData, + pdata, PAsData, -- * DataRepr and related functions PDataRecord, PDataSum, - PIsDataRepr, PLabeledType ((:=)), pdcons, pdnil, pfield, + getField, pletFields, - hrecField, -- * Tracing ptrace, + ptraceShowId, ptraceIfFalse, ptraceIfTrue, ptraceError, + pshow, -- * Cryptographic hashes and signatures psha2_256, @@ -130,19 +149,25 @@ module Plutarch.Prelude ( plift, PConstant, PLift, - - -- * Typeclass derivers. - DerivePNewtype (DerivePNewtype), + PConstantData, + PLiftData, -- * Continuation monad TermCont (TermCont, runTermCont), unTermCont, tcont, + pupcast, + ptryFrom, + PTryFrom, + PSubtype, + Generic, ) where import Prelude () import Data.Kind (Type) +import GHC.Generics (Generic) +import GHC.Records (getField) import Plutarch import Plutarch.Bool import Plutarch.Builtin @@ -156,7 +181,9 @@ import Plutarch.List import Plutarch.Maybe import Plutarch.Pair import Plutarch.Rational +import Plutarch.Show import Plutarch.String import Plutarch.TermCont import Plutarch.Trace +import Plutarch.TryFrom import Plutarch.Unit diff --git a/Plutarch/Pretty.hs b/Plutarch/Pretty.hs new file mode 100644 index 000000000..70c708d9c --- /dev/null +++ b/Plutarch/Pretty.hs @@ -0,0 +1,319 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Plutarch.Pretty (prettyTerm, prettyTerm', prettyScript) where + +import Control.Monad.Reader (ReaderT (runReaderT)) +import Control.Monad.ST (runST) +import Control.Monad.State (MonadState (get, put), StateT (runStateT), modify, modify') +import Data.Foldable (fold) +import Data.Functor (($>), (<&>)) +import Data.Text (Text) +import qualified Data.Text as Txt +import Data.Traversable (for) + +import System.Random.Stateful (mkStdGen, newSTGenM) + +import Prettyprinter ((<+>)) +import qualified Prettyprinter as PP + +import Plutarch.Internal (ClosedTerm, Config, compile) +import qualified PlutusCore as PLC +import PlutusLedgerApi.V1.Scripts (Script (unScript)) +import UntypedPlutusCore ( + DeBruijn (DeBruijn), + DefaultFun, + DefaultUni, + Program (_progTerm), + Term (Apply, Builtin, Constant, Delay, Error, Force, LamAbs, Var), + ) + +import Plutarch.Pretty.Internal.BuiltinConstant (prettyConstant) +import Plutarch.Pretty.Internal.Config (indentWidth) +import Plutarch.Pretty.Internal.Name (freshVarName, smartName) +import Plutarch.Pretty.Internal.TermUtils ( + unwrapApply, + unwrapBindings, + unwrapLamAbs, + pattern IfThenElseLikeAST, + ) +import Plutarch.Pretty.Internal.Types ( + PrettyCursor (Normal, Special), + PrettyMonad, + PrettyState (PrettyState, ps'cursor, ps'nameMap), + builtinFunAtRef, + forkState, + insertBindings, + insertName, + nameOfRef, + normalizeCursor, + specializeCursor, + ) + +-- | 'prettyTerm' for pre-compiled 'Script's. +prettyScript :: Script -> PP.Doc () +prettyScript = prettyUPLC . _progTerm . unScript + +{- | Prettify a Plutarch term. + +This will call 'error' if there's a compilation failure. Use 'prettyTerm'' for a non-partial version. + +== Example == + +@ +import Plutarch.Prelude +import Plutarch.Api.V1 +import Plutarch.Extra.TermCont + +checkSignatory :: Term s (PPubKeyHash :--> PScriptContext :--> PUnit) +checkSignatory = plam $ \ph ctx' -> unTermCont $ do + ctx <- pletFieldsC @["txInfo", "purpose"] ctx' + purph <- pmatchC ctx.purpose + pure $ case purph of + PSpending _ -> + let signatories = pfield @"signatories" # ctx.txInfo + in pif + (pelem # pdata ph # pfromData signatories) + -- Success! + (pconstant ()) + -- Signature not present. + perror + _ -> ptraceError "checkSignatoryCont: not a spending tx" +@ + +Prettification result: + +@ +let frSndPair = !!sndPair + unDataSum = (\xF -> frSndPair (unConstrData xF)) + frTailList = !tailList + frHeadList = !headList + frIfThenElse = !ifThenElse +in (\oP4ECBT qsrxlF0Y7 -> + let cjlB6yrGk = unDataSum qsrxlF0Y7 + cRFO = unConstrData (frHeadList (frTailList cjlB6yrGk)) + cs9iR = !!fstPair cRFO + w4 = frSndPair cRFO + in if equalsInteger 1 cs9iR + then if (\vModHwqYB -> + let blM6d67 = + (\x5sad ePDSInSEC -> + !(!!chooseList + ePDSInSEC + ~False + ~(if equalsData + (frHeadList ePDSInSEC) + vModHwqYB + then True + else x5sad (frTailList ePDSInSEC)))) + mC = (\jfZs -> blM6d67 (\itzT -> jfZs jfZs itzT)) + in blM6d67 (\ispwp_oeT -> mC mC ispwp_oeT)) + (bData oP4ECBT) + (unListData + let q6X3 = frHeadList cjlB6yrGk + in frHeadList + let olbZ = unDataSum q6X3 + in frTailList + (frTailList + (frTailList + (frTailList + (frTailList + (frTailList + (frTailList olbZ))))))) + then () + else ERROR + else !(!trace "checkSignatoryCont: not a spending tx" ~ERROR)) +@ + +== Semantics == + +=== Constants === + +- Builtin integers are printed as regular integers. [0-9]+ +- Builtin bytestrings are printed in hex notation, prefixed by `0x`. 0x[0-9a-f]+/i +- Builtin strings are printed as is. +- Builtin unit is printed as the unit literal. () +- Builtin booleans are printed as the literal `True` or `False`. +- Builtin lists are prettified as list literals, i.e delimited with `[` and `]`. +- Builtin pairs are prettified as 2-ary tuple literals, e.g. `(a, b)`. +- `I` data (i.e data encoded integers) are prettified like builtin integers with a `#` prefix. #[0-9]+ +- `B` data (i.e data encoded bytestrings) are prettified like builtin bytestrings with a `#` prefix. #0x[0-9a-f]+/i +- `List` data (i.e data encoded lists) are prettified like builtin lists with a `#` prefix. +- `Map` data is printed like record literals. Delimited by `{` and `}`. + + Each key value pair is prettified like = and multiple pairs are joined with `,`. + + For example, `Map [(I 42, I 0), (I 100, I 1)]` is prettified as `{ #42 = #0, #100 = #1 }` +- Constr data has two core elements in its prettified form: + + - The constructor index, prettified as an integer prefixed with `Σ` (sigma). + - Its fields, prettified as a list. + + These two elements are then joined with a `.` (period). + + For example, `Constr 1 [I 42]` is prettified as "Σ1.[#42]". + +=== Builtin functions === + +Builtin functions are prettified into their name, in title case. + +=== Forced term === + +Forced terms are prefixed with a `!`. The unary operator `!` has higher fixity than function application. + +=== Delayed term === + +Delayed terms are prefixed with a `~`. The unary operator `~` has higher fixity than function application. + +=== Var === + +Random names are generated for all variable bindings, and these names are used to refer to them. + +Names are always unique, between 1 and 8 characters in length, and begin with a lowercase letter. + +Names may consist of alphanumeric characters, underscore, or single quotes. + +=== LamAbs === + +Lambdas are prettified similar to haskell lambdas, i.e `\x -> ...`. + +Lambdas with multiple arguments are detected and simplified: `\x y z -> ...`. + +=== Apply === + +Application is, simply, a space - just like haskell. `f x`. + +Multi arg applications to the same function are detected and simplified: `f x y`. + +=== Error term === + +`perror` is represented by the literal `ERROR`. + +=== Special handling === + +To achieve better prettification, certain AST structures are given special handling logic. + +- The AST structure produced by `plet` (Single `Apply` + `LamAbs` pair) is prettified into Haskell-like let bindings. +- Lazy if/then/else (`pif` in particular, not `pif'`) is detected and prettified into Haskell-like syntax: + `if cond then expr1 else expr2`. + + Chains of if/then/else are nested: + + @ + if cond + then expr1 + else if cond + then expr2 + else expr3 + @ +- When generating names for bindings, well known structures are identified and given special names. + + This machinery is made to be extensible in the future. + + For example, the structure of the `pfix` function is well known and constant - so it is simply called `fix` in the output. + + Bindings to forced builtin functions inherit the builtin function name, prefixed with a `fr`. +-} +prettyTerm :: Config -> ClosedTerm a -> PP.Doc () +prettyTerm conf x = either (error . Txt.unpack) id $ prettyTerm' conf x + +-- | Non-partial 'prettyTerm'. +prettyTerm' :: Config -> ClosedTerm p -> Either Text (PP.Doc ()) +prettyTerm' conf x = prettyScript <$> compile conf x + +{- This isn't suitable for pretty printing UPLC from any source. It's primarily suited for Plutarch output. +Practically speaking though, it should work with any _idiomatic_ UPLC. +-} +prettyUPLC :: Term DeBruijn DefaultUni DefaultFun () -> PP.Doc () +prettyUPLC uplc = runST $ do + stGen <- newSTGenM $ mkStdGen 42 + (doc, _) <- runReaderT (go uplc) stGen `runStateT` PrettyState mempty mempty Normal + pure doc + where + go :: Term DeBruijn DefaultUni DefaultFun () -> PrettyMonad s (PP.Doc ()) + go (Constant _ c) = pure $ prettyConstant c + go (Builtin _ b) = pure $ PP.pretty b + go (Error _) = pure "ERROR" + go (Var _ (DeBruijn x)) = do + PrettyState {ps'nameMap} <- get + pure $ case nameOfRef x ps'nameMap of + Just nm -> PP.pretty nm + Nothing -> error "impossible: free variable" + go (IfThenElseLikeAST (Force () (Builtin () PLC.IfThenElse)) cond trueBranch falseBranch) = do + prettyIfThenElse (forkState . go) cond trueBranch falseBranch + go ast@(IfThenElseLikeAST scrutinee cond trueBranch falseBranch) = do + PrettyState {ps'nameMap} <- get + case scrutinee of + Var () (DeBruijn (builtinFunAtRef ps'nameMap -> Just PLC.IfThenElse)) -> + prettyIfThenElse (forkState . go) cond trueBranch falseBranch + _ -> case ast of + Force _ t@Apply {} -> modify specializeCursor *> go t <&> ("!" <>) + _ -> error "impossible: IfThenElseLikeAST" + go (Force _ t) = modify specializeCursor *> go t <&> ("!" <>) + go (Delay _ t) = modify specializeCursor *> go t <&> ("~" <>) + go (LamAbs _ _ t') = do + currState@PrettyState {ps'cursor} <- get + let (depth, bodyTerm) = unwrapLamAbs 0 t' + names <- traverse (const freshVarName) [0 .. depth] + -- Add all the new names to the nameMap, starting with 0 index. + put $ insertBindings names currState + modify' normalizeCursor + funcBody <- forkState $ go bodyTerm + pure . parensOnCursor ps'cursor . PP.hang indentWidth $ + PP.sep + [ "\\" <> PP.hsep (reverse $ map PP.pretty names) <+> "->" + , funcBody + ] + go (Apply _ (LamAbs _ _ t) firstArg) = do + PrettyState {ps'cursor} <- get + let (restArgs, coreF) = unwrapBindings [] t + helper (name, expr) = do + modify' normalizeCursor + valueDoc <- forkState $ go expr + pure . PP.hang indentWidth $ + PP.sep + [ PP.pretty name <+> "=" + , valueDoc + ] + firstName <- smartName firstArg + firstBindingDoc <- helper (firstName, firstArg) + modify' $ insertName firstName + restBindingDoc <- fmap fold . for (reverse restArgs) $ \argExpr -> do + newName <- smartName argExpr + bindingDoc <- helper (newName, argExpr) + modify' (insertName newName) $> PP.flatAlt PP.hardline "; " <> bindingDoc + modify' normalizeCursor + coreExprDoc <- go coreF + pure . parensOnCursor ps'cursor $ + PP.align $ + PP.vsep + [ "let" <+> PP.align (firstBindingDoc <> restBindingDoc) + , "in" <+> coreExprDoc + ] + go (Apply _ t arg) = do + PrettyState {ps'cursor} <- get + let (l, f) = unwrapApply [] t + args = l <> [arg] + functionDoc <- forkState $ modify' specializeCursor *> go f + argsDoc <- modify' specializeCursor *> traverse (forkState . go) args + pure . parensOnCursor ps'cursor $ + PP.hang indentWidth $ PP.sep $ functionDoc : argsDoc + +prettyIfThenElse :: + (t -> PrettyMonad s (PP.Doc ann)) -> + t -> + t -> + t -> + PrettyMonad s (PP.Doc ann) +prettyIfThenElse cont cond trueBranch falseBranch = do + PrettyState {ps'cursor} <- get + modify' normalizeCursor + condAst <- cont cond + trueAst <- cont trueBranch + falseAst <- cont falseBranch + pure . parensOnCursor ps'cursor $ + PP.hang indentWidth $ PP.vsep ["if" <+> condAst, "then" <+> trueAst, "else" <+> falseAst] + +-- | Wrap prettification result parens depending on cursor state. +parensOnCursor :: PrettyCursor -> PP.Doc ann -> PP.Doc ann +parensOnCursor cursor = do + if cursor == Special then PP.parens else id diff --git a/Plutarch/Pretty/Internal/BuiltinConstant.hs b/Plutarch/Pretty/Internal/BuiltinConstant.hs new file mode 100644 index 000000000..8907beceb --- /dev/null +++ b/Plutarch/Pretty/Internal/BuiltinConstant.hs @@ -0,0 +1,57 @@ +module Plutarch.Pretty.Internal.BuiltinConstant (prettyConstant) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Builder as BSB +import qualified Data.ByteString.Lazy as LBS +import Data.Text (Text) +import qualified Data.Text.Encoding as TxtEnc + +import Prettyprinter ((<+>)) +import qualified Prettyprinter as PP + +import qualified PlutusCore as PLC +import qualified PlutusLedgerApi.V1 as Plutus +import UntypedPlutusCore (DefaultUni) + +import Plutarch.Pretty.Internal.Config (indentWidth) + +prettyConstant :: PLC.Some (PLC.ValueOf DefaultUni) -> PP.Doc () +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniInteger n)) = PP.pretty n +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniByteString b)) = PP.pretty $ encodeHex b +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniString s)) = + -- Have to `show` first to get a quoted string. + PP.pretty $ show s +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniUnit _)) = "()" +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniBool b)) = PP.pretty b +prettyConstant (PLC.Some (PLC.ValueOf (PLC.DefaultUniList a) l)) = + PP.list $ + map (prettyConstant . PLC.Some . PLC.ValueOf a) l +prettyConstant (PLC.Some (PLC.ValueOf (PLC.DefaultUniPair a b) ~(x, y))) = + PP.tupled + [prettyConstant . PLC.Some $ PLC.ValueOf a x, prettyConstant . PLC.Some $ PLC.ValueOf b y] +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniData (Plutus.Constr ix dl))) = + "Σ" <> PP.pretty ix <> "." + <> PP.list (prettyConstant . PLC.Some . PLC.ValueOf PLC.DefaultUniData <$> dl) +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniData (Plutus.Map ascList))) = + PP.group + . PP.encloseSep (PP.flatAlt "{ " "{") (PP.flatAlt " }" "}") ", " + $ map + ( \(a, b) -> + PP.hang indentWidth $ + PP.sep + [ prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniData a)) <+> "=" + , prettyConstant $ PLC.Some $ PLC.ValueOf PLC.DefaultUniData b + ] + ) + ascList +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniData (Plutus.List l))) = + "#" <> PP.list (prettyConstant . PLC.Some . PLC.ValueOf PLC.DefaultUniData <$> l) +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniData (Plutus.B b))) = + "#" <> prettyConstant (PLC.Some $ PLC.ValueOf PLC.DefaultUniByteString b) +prettyConstant (PLC.Some (PLC.ValueOf PLC.DefaultUniData (Plutus.I i))) = + "#" <> prettyConstant (PLC.Some $ PLC.ValueOf PLC.DefaultUniInteger i) +prettyConstant (PLC.Some (PLC.ValueOf uni _)) = + error $ "prettyConstant(impossible): " <> show uni + +encodeHex :: ByteString -> Text +encodeHex = ("0x" <>) . TxtEnc.decodeUtf8 . LBS.toStrict . BSB.toLazyByteString . BSB.byteStringHex diff --git a/Plutarch/Pretty/Internal/Config.hs b/Plutarch/Pretty/Internal/Config.hs new file mode 100644 index 000000000..47cd02e62 --- /dev/null +++ b/Plutarch/Pretty/Internal/Config.hs @@ -0,0 +1,23 @@ +module Plutarch.Pretty.Internal.Config (keywords, indentWidth, forcedPrefix) where + +import Data.Set (Set) +import qualified Data.Set as Set +import Data.String (fromString) +import Data.Text (Text) + +import qualified Prettyprinter as PP + +import qualified PlutusCore as PLC + +keywords :: Set Text +keywords = + Set.fromList $ + ["let", "in"] + <> map (fromString . show . PP.pretty) [(minBound @PLC.DefaultFun) .. maxBound] + +indentWidth :: Int +indentWidth = 2 + +-- | Prefix to use for naming forced builtin functions. +forcedPrefix :: Text +forcedPrefix = "fr" diff --git a/Plutarch/Pretty/Internal/Name.hs b/Plutarch/Pretty/Internal/Name.hs new file mode 100644 index 000000000..2da634503 --- /dev/null +++ b/Plutarch/Pretty/Internal/Name.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Plutarch.Pretty.Internal.Name (smartName, freshVarName) where + +import Control.Monad.Reader (ask) +import Control.Monad.State ( + get, + lift, + modify', + ) +import Data.Functor (($>)) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as Txt +import Data.Traversable (for) + +import System.Random.Stateful (randomRM, uniformRM) + +import qualified PlutusCore as PLC +import UntypedPlutusCore ( + DeBruijn (DeBruijn), + DefaultFun, + Term (Builtin, Force, Var), + ) + +import Plutarch.Pretty.Internal.Config (forcedPrefix, keywords) +import Plutarch.Pretty.Internal.TermUtils (pattern ComposeAST, pattern PFixAst) +import Plutarch.Pretty.Internal.Types ( + PrettyMonad, + PrettyState (PrettyState, ps'nameMap, ps'names), + builtinFunAtRef, + memorizeName, + ) + +smartName :: Term DeBruijn uni DefaultFun () -> PrettyMonad s Text +smartName uplc = do + PrettyState {ps'nameMap} <- get + case uplc of + Force _ (Force _ (Builtin _ b)) -> pure $ forcedPrefix <> Txt.pack (show b) + Force _ (Builtin _ b) -> pure $ forcedPrefix <> Txt.pack (show b) + PFixAst -> pure "fix" + ComposeAST + (Builtin () PLC.SndPair) + (Builtin () PLC.UnConstrData) -> pure "unDataSum" + ComposeAST + (Var () (DeBruijn (builtinFunAtRef ps'nameMap -> Just PLC.SndPair))) + (Builtin () PLC.UnConstrData) -> pure "unDataSum" + _ -> freshVarName + +freshVarName :: PrettyMonad s Text +freshVarName = do + stGen <- ask + PrettyState {ps'names} <- get + let existingNames = Set.union ps'names keywords + nameTailLen <- lift . lift $ randomRM (0 :: Int, 7) stGen + beginChar <- chooseChar starterChars + newName <- fmap (Txt.pack . (beginChar :)) . for [0 .. nameTailLen] . const $ chooseChar chars + if Set.member newName existingNames + then freshVarName + else modify' (memorizeName newName) $> newName + where + chooseChar x = do + stGen <- ask + chosenIx <- lift . lift $ uniformRM (0, Txt.length x - 1) stGen + pure $ Txt.index x chosenIx + starterChars = Txt.pack ['a' .. 'z'] + chars = Txt.append starterChars . Txt.pack $ ['A' .. 'Z'] ++ ['0' .. '9'] ++ ['_', '\''] diff --git a/Plutarch/Pretty/Internal/TermUtils.hs b/Plutarch/Pretty/Internal/TermUtils.hs new file mode 100644 index 000000000..397ab9818 --- /dev/null +++ b/Plutarch/Pretty/Internal/TermUtils.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Plutarch.Pretty.Internal.TermUtils ( + unwrapLamAbs, + unwrapBindings, + unwrapApply, + incrVar, + pattern PFixAst, + pattern ComposeAST, + pattern IfThenElseLikeAST, +) where + +import UntypedPlutusCore ( + DeBruijn (DeBruijn), + Index, + Term (Apply, Delay, Force, LamAbs, Var), + ) + +unwrapLamAbs :: Index -> Term name uni fun ann -> (Index, Term name uni fun ann) +unwrapLamAbs d (LamAbs _ _ t) = unwrapLamAbs (d + 1) t +unwrapLamAbs d a = (d, a) + +unwrapBindings :: [Term name uni fun ann] -> Term name uni fun ann -> ([Term name uni fun ann], Term name uni fun ann) +unwrapBindings l (Apply _ (LamAbs _ _ t) arg) = unwrapBindings (arg : l) t +unwrapBindings l a = (l, a) + +unwrapApply :: + [Term name uni fun ann] -> + Term name uni fun ann -> + ([Term name uni fun ann], Term name uni fun ann) +unwrapApply l (Apply _ t arg) = unwrapApply (arg : l) t +unwrapApply l arg = (l, arg) + +-- AST resulting from `pfix`. This is always constant. +pattern PFixAst :: Term name uni fun () +pattern PFixAst <- + LamAbs + () + _ + ( Apply + () + ( LamAbs + () + _ + ( Apply + () + (Var () _) + ( LamAbs + () + _ + ( Apply + () + ( Apply + () + (Var () _) + (Var () _) + ) + (Var () _) + ) + ) + ) + ) + ( LamAbs + () + _ + ( Apply + () + (Var () _) + ( LamAbs + () + _ + ( Apply + () + ( Apply + () + (Var () _) + (Var () _) + ) + (Var () _) + ) + ) + ) + ) + ) + +-- If `f` and `g` are Var references, their indices are incremented once since they are within a lambda. +pattern ComposeAST :: Term DeBruijn uni fun () -> Term DeBruijn uni fun () -> Term DeBruijn uni fun () +pattern ComposeAST f g <- LamAbs () _ (Apply () (incrVar -> f) (Apply () (incrVar -> g) (Var () (DeBruijn 1)))) + +{- This AST represents a typical if/then/else usage if and only if 'ifThenElseMaybe' is either the +builtin IfThenElse (forced once), or a reference to such. +-} +pattern IfThenElseLikeAST :: + Term name uni fun () -> + Term name uni fun () -> + Term name uni fun () -> + Term name uni fun () -> + Term name uni fun () +pattern IfThenElseLikeAST ifThenElseMaybe cond trueBranch falseBranch <- + Force + () + ( Apply + () + ( Apply + () + ( Apply + () + ifThenElseMaybe + cond + ) + (Delay () trueBranch) + ) + (Delay () falseBranch) + ) + +-- | Increment the debruijn index of a 'Var', leave any other AST node unchanged. +incrVar :: Term DeBruijn uni fun () -> Term DeBruijn uni fun () +incrVar (Var () (DeBruijn n)) = Var () . DeBruijn $ n - 1 +incrVar n = n diff --git a/Plutarch/Pretty/Internal/Types.hs b/Plutarch/Pretty/Internal/Types.hs new file mode 100644 index 000000000..e069849ae --- /dev/null +++ b/Plutarch/Pretty/Internal/Types.hs @@ -0,0 +1,102 @@ +module Plutarch.Pretty.Internal.Types ( + PrettyCursor (..), + PrettyState (..), + PrettyMonad, + forkState, + normalizeCursor, + specializeCursor, + memorizeName, + insertName, + insertBindings, + builtinFunAtRef, + nameOfRef, +) where + +import Control.Monad.Reader (ReaderT, (<=<)) +import Control.Monad.ST (ST) +import Control.Monad.State (MonadState (get, put), StateT) +import Data.List (find) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as Txt +import System.Random.Stateful (STGenM, StdGen) + +import qualified PlutusCore as PLC +import UntypedPlutusCore (DefaultFun, Index) + +import Plutarch.Pretty.Internal.Config (forcedPrefix) + +{- | Notifies the prettifier what "state" the cursor currently is, so it can decide +whether or not to wrap the target expression in parens. + +Normal indicates no parens wrapping is necessary, even for complex expressions. + +Special indicates complex expressions should be wrapped in parens. + +Usually, "Special" just hints at one of three states: + +1. Applying - The expression is being applied like a function. +2. Applied - The expression is being applied as a function argument. +3. Unary arg - The expression is being used as an argument to a high arity unary operator (~ and !). +-} +data PrettyCursor = Normal | Special + deriving stock (Bounded, Enum, Eq, Show) + +data PrettyState = PrettyState + { ps'nameMap :: Map Index Text + , ps'names :: Set Text + , ps'cursor :: PrettyCursor + } + +type PrettyMonad s = ReaderT (STGenM StdGen s) (StateT PrettyState (ST s)) + +forkState :: MonadState s m => m b -> m b +forkState x = get >>= (\s -> x <* put s) + +normalizeCursor :: PrettyState -> PrettyState +normalizeCursor x = x {ps'cursor = Normal} + +specializeCursor :: PrettyState -> PrettyState +specializeCursor x = x {ps'cursor = Special} + +memorizeName :: Text -> PrettyState -> PrettyState +memorizeName n x@PrettyState {ps'names} = x {ps'names = Set.insert n ps'names} + +-- | Insert a fresh binding onto the name map, i.e a name at index 0 - incrementing all other indices. +insertName :: Text -> PrettyState -> PrettyState +insertName name x@PrettyState {ps'nameMap} = + x + { ps'nameMap = Map.mapKeys (+ 1) ps'nameMap <> Map.singleton 0 name + } + +insertBindings :: [Text] -> PrettyState -> PrettyState +insertBindings names prst@PrettyState {ps'nameMap} = + prst + { ps'nameMap = + Map.mapKeys (+ nameCount) ps'nameMap + <> foldMap (uncurry Map.singleton) (zip [0 .. (nameCount - 1)] names) + } + where + nameCount = fromIntegral $ length names + +builtinFunAtRef :: Map Index Text -> Index -> Maybe DefaultFun +builtinFunAtRef nameMap = builtinFunFromName <=< flip nameOfRef nameMap + +nameOfRef :: Index -> Map Index Text -> Maybe Text +nameOfRef ix = Map.lookup (ix - 1) + +builtinFunFromName :: Text -> Maybe DefaultFun +builtinFunFromName res = + if Txt.take prefixLen res == forcedPrefix + then helper $ Txt.drop prefixLen res + else helper res + where + prefixLen = Txt.length forcedPrefix + helper s = find (\e -> showText e == s) builtinFunNames + builtinFunNames = [minBound .. maxBound :: PLC.DefaultFun] + +showText :: Show a => a -> Text +showText = Txt.pack . show diff --git a/Plutarch/Rational.hs b/Plutarch/Rational.hs index 2d6049d93..2531d90a0 100644 --- a/Plutarch/Rational.hs +++ b/Plutarch/Rational.hs @@ -1,19 +1,26 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + module Plutarch.Rational ( - PRational (..), + PRational (PRational), preduce, pnumerator, pdenominator, - pfromInteger, + Plutarch.Rational.pfromInteger, pround, ptruncate, pproperFraction, + PFractional (..), ) where import Data.Ratio (denominator, numerator) -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) +import GHC.Generics (Generic) import Plutarch ( - PlutusType (..), + DPTStrat, + DerivePlutusType, + PType, + PlutusType, + PlutusTypeScott, Term, pcon, pfix, @@ -21,46 +28,48 @@ import Plutarch ( plam, plet, pmatch, + pto, + runTermCont, (#), (#$), type (:-->), ) -import Plutarch.Bool (PEq (..), POrd (..), pif) +import Plutarch.Bool (PEq, POrd, PPartialOrd, pif, (#<), (#<=), (#==)) import Plutarch.Builtin ( PAsData, PBuiltinList, PData, - PIsData (..), + PIsData, pasInt, pasList, + pdata, + pdataImpl, pforgetData, + pfromDataImpl, ) -import Plutarch.Integer (PInteger, PIntegral (pdiv, pmod)) -import Plutarch.List (PListLike (pcons, phead, pnil, ptail), pmap) -import Plutarch.Pair (PPair (..)) -import Plutarch.Unsafe (punsafeCoerce) - -data PRational s - = PRational (Term s PInteger) (Term s PInteger) - deriving stock (GHC.Generic) - deriving anyclass (Generic, PlutusType) +import Plutarch.Integer (PInteger, pdiv, pmod) +import Plutarch.Lift (pconstant) +import Plutarch.List (pcons, phead, pnil, ptail) +import Plutarch.Num (PNum, pabs, pfromInteger, pnegate, psignum, (#*), (#+), (#-)) +import Plutarch.Pair (PPair (PPair)) +import Plutarch.Positive (PPositive, ptryPositive) +import Plutarch.Show (PShow, pshow, pshow') +import Plutarch.TermCont (tcont, unTermCont) +import Plutarch.Trace (ptraceError) +import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'), ptryFrom) +import Plutarch.Unsafe (punsafeCoerce, punsafeDowncast) -instance PIsData PRational where - pfromData x' = phoistAcyclic (plam $ \x -> pListToRat #$ pmap # pasInt #$ pasList # pforgetData x) # x' - pdata x' = - phoistAcyclic - ( plam $ \x -> - (punsafeCoerce :: Term _ (PAsData (PBuiltinList (PAsData PInteger))) -> Term _ (PAsData PRational)) $ - pdata $ pRatToList # x - ) - # x' +class PFractional (a :: PType) where + (#/) :: Term s a -> Term s a -> Term s a + precip :: Term s (a :--> a) + pfromRational :: Term s (PRational :--> a) -pRatToList :: Term s (PRational :--> PBuiltinList (PAsData PInteger)) -pRatToList = plam $ \x -> pmatch x $ \(PRational a b) -> - pcons # pdata a #$ pcons # pdata b #$ punsafeCoerce (pnil :: Term s (PBuiltinList PData)) +data PRational s + = PRational (Term s PInteger) (Term s PPositive) + deriving stock (Generic) + deriving anyclass (PlutusType) -pListToRat :: Term s (PBuiltinList PInteger :--> PRational) -pListToRat = plam $ \x -> pcon $ PRational (phead # x) (phead #$ ptail # x) +instance DerivePlutusType PRational where type DPTStrat _ = PlutusTypeScott instance PEq PRational where l' #== r' = @@ -68,139 +77,192 @@ instance PEq PRational where ( plam $ \l r -> pmatch l $ \(PRational ln ld) -> pmatch r $ \(PRational rn rd) -> - rd * ln #== rn * ld + pto rd * ln #== rn * pto ld ) # l' # r' -instance POrd PRational where +instance (PNum a, PFractional a) => Fractional (Term s a) where + (/) = (#/) + recip x = precip # x + fromRational x = + pfromRational #$ pcon $ + PRational + (pconstant $ numerator x) + (punsafeDowncast . pconstant $ denominator x) + +instance PShow PRational where + pshow' _ x = + pshowRat # x + where + pshowRat = phoistAcyclic $ + plam $ \n -> pmatch n $ \(PRational x y) -> + pshow x <> "/" <> pshow (pto y) + +instance PIsData PRational where + pfromDataImpl x' = phoistAcyclic (plam $ \x -> plistToRat #$ pasList # pforgetData x) # x' + where + plistToRat :: Term s (PBuiltinList PData :--> PRational) + plistToRat = plam $ \x -> + pcon $ + PRational (pasInt #$ phead # x) + . punsafeDowncast + $ pasInt #$ phead #$ ptail # x + pdataImpl x' = + phoistAcyclic + ( plam $ \x -> unTermCont $ do + PRational a b <- tcont $ pmatch x + let res :: Term _ (PBuiltinList (PAsData PInteger)) + res = pcons # pdata a #$ pcons # pdata (pto b) #$ pnil + pure $ pdataImpl res + ) + # x' + +newtype Flip f a b = Flip (f b a) deriving stock (Generic) + +-- | NOTE: This instance produces a verified 'PPositive' as the excess output. +instance PTryFrom PData (PAsData PRational) where + type PTryFromExcess PData (PAsData PRational) = Flip Term PPositive + ptryFrom' opq = runTermCont $ do + (_, ld) <- tcont $ ptryFrom @(PAsData (PBuiltinList PData)) opq + ratTail <- tcont . plet $ ptail # ld + tcont $ \f -> pif (ptail # ratTail #== pnil) (f ()) $ ptraceError "ptryFrom(PRational): data list length should be 2" + (_, denm) <- tcont $ ptryFrom @(PAsData PInteger) $ phead # ratTail + res <- tcont . plet $ ptryPositive # denm + pure (punsafeCoerce opq, res) + +instance PPartialOrd PRational where l' #<= r' = phoistAcyclic - ( plam $ \l r -> - pmatch l $ \(PRational ln ld) -> - pmatch r $ \(PRational rn rd) -> - rd * ln #<= rn * ld + ( plam $ \l r -> unTermCont $ do + PRational ln ld <- tcont $ pmatch l + PRational rn rd <- tcont $ pmatch r + pure $ pto rd * ln #<= rn * pto ld ) # l' # r' l' #< r' = phoistAcyclic - ( plam $ \l r -> - pmatch l $ \(PRational ln ld) -> - pmatch r $ \(PRational rn rd) -> - rd * ln #< rn * ld + ( plam $ \l r -> unTermCont $ do + PRational ln ld <- tcont $ pmatch l + PRational rn rd <- tcont $ pmatch r + pure $ pto rd * ln #< rn * pto ld ) # l' # r' -instance Num (Term s PRational) where - x' + y' = +instance POrd PRational + +instance PNum PRational where + x' #+ y' = phoistAcyclic - ( plam $ \x y -> - preduce #$ pmatch x $ - \(PRational xn xd) -> - pmatch y $ \(PRational yn yd) -> - pcon $ PRational (xn * yd + yn * xd) (xd * yd) + ( plam $ \x y -> unTermCont $ do + PRational xn xd' <- tcont $ pmatch x + PRational yn yd' <- tcont $ pmatch y + xd <- tcont $ plet xd' + yd <- tcont $ plet yd' + pure $ + preduce + #$ pcon + $ PRational (xn * pto yd + yn * pto xd) $ + punsafeDowncast $ pto xd * pto yd ) # x' # y' - x' - y' = + -- TODO (Optimize): Could this be optimized with an impl in terms of `#+`. + x' #- y' = phoistAcyclic - ( plam $ \x y -> - preduce - #$ pmatch x - $ \(PRational xn xd) -> - pmatch y $ \(PRational yn yd) -> - pcon $ PRational (xn * yd - yn * xd) (xd * yd) + ( plam $ \x y -> unTermCont $ do + PRational xn xd' <- tcont $ pmatch x + PRational yn yd' <- tcont $ pmatch y + xd <- tcont $ plet xd' + yd <- tcont $ plet yd' + pure $ + preduce + #$ pcon + $ PRational (xn * pto yd - yn * pto xd) $ + punsafeDowncast $ pto xd * pto yd ) # x' # y' - x' * y' = + x' #* y' = phoistAcyclic - ( plam $ \x y -> - preduce - #$ pmatch x - $ \(PRational xn xd) -> - pmatch y $ \(PRational yn yd) -> - pcon $ PRational (xn * yn) (xd * yd) + ( plam $ \x y -> unTermCont $ do + PRational xn xd <- tcont $ pmatch x + PRational yn yd <- tcont $ pmatch y + pure $ + preduce + #$ pcon + $ PRational (xn * yn) $ + punsafeDowncast $ pto xd * pto yd ) # x' # y' - negate x' = - phoistAcyclic - ( plam $ \x -> - pmatch x $ \(PRational xn xd) -> - pcon $ PRational (negate xn) xd - ) - # x' + pnegate = + phoistAcyclic $ + plam $ \x -> + pmatch x $ \(PRational xn xd) -> + pcon $ PRational (negate xn) xd - abs x' = - phoistAcyclic - ( plam $ \x -> - pmatch x $ \(PRational xn xd) -> - pcon $ PRational (abs xn) (abs xd) - ) - # x' + pabs = + phoistAcyclic $ + plam $ \x -> + pmatch x $ \(PRational xn xd) -> + pcon $ PRational (abs xn) (abs xd) - signum x'' = - phoistAcyclic - ( plam $ \x' -> plet x' $ \x -> - pif - (x #== 0) - 0 - $ pif - (x #< 0) - (-1) - 1 - ) - # x'' + psignum = + phoistAcyclic $ + plam $ \x' -> plet x' $ \x -> + pif + (x #== 0) + 0 + $ pif + (x #< 0) + (-1) + 1 - fromInteger n = pcon $ PRational (fromInteger n) 1 + pfromInteger n = pcon $ PRational (fromInteger n) 1 -instance Fractional (Term s PRational) where - recip x' = - phoistAcyclic - ( plam $ \x -> - pmatch x $ \(PRational xn xd) -> - pcon (PRational xd xn) - ) - # x' +instance PFractional PRational where + precip = + phoistAcyclic $ + plam $ \x -> + pmatch x $ \(PRational xn xd) -> + pcon $ PRational (pto xd) $ ptryPositive # xn - x' / y' = + -- TODO (Optimize): Could this be optimized with an impl in terms of `#*`. + x' #/ y' = phoistAcyclic - ( plam $ \x y -> - preduce - #$ pmatch x - $ \(PRational xn xd) -> - pmatch y $ \(PRational yn yd) -> - pcon (PRational (xn * yd) (xd * yn)) + ( plam $ \x y -> unTermCont $ do + PRational xn xd <- tcont $ pmatch x + PRational yn yd <- tcont $ pmatch y + denm <- tcont . plet $ ptryPositive #$ pto xd * yn + pure $ preduce #$ pcon $ PRational (xn * pto yd) denm ) # x' # y' - fromRational r = - pcon $ PRational (fromInteger $ numerator r) (fromInteger $ denominator r) + pfromRational = phoistAcyclic $ plam id preduce :: Term s (PRational :--> PRational) preduce = phoistAcyclic $ - plam $ \x -> - pmatch x $ \(PRational xn xd) -> - plet (pgcd # xn # xd) $ \r -> - plet (signum xd) $ \s -> - pcon $ PRational (s * pdiv # xn # r) (s * pdiv # xd # r) + plam $ \x -> unTermCont $ do + PRational xn xd' <- tcont $ pmatch x + xd <- tcont . plet $ pto xd' + r <- tcont . plet $ pgcd # xn # xd + s <- tcont . plet $ psignum # xd + pure . pcon $ PRational (s * pdiv # xn # r) $ punsafeDowncast $ s * pdiv # xd # r pgcd :: Term s (PInteger :--> PInteger :--> PInteger) pgcd = phoistAcyclic $ - plam $ \x' y' -> - plet (abs x') $ \x -> - plet (abs y') $ \y -> - plet (pmax # x # y) $ \a -> - plet (pmin # x # y) $ \b -> - pgcd' # a # b + plam $ \x' y' -> unTermCont $ do + x <- tcont . plet $ pabs # x' + y <- tcont . plet $ pabs # y' + pure $ pgcd' # (pmax # x # y) #$ pmin # x # y -- assumes inputs are non negative and a >= b pgcd' :: Term s (PInteger :--> PInteger :--> PInteger) @@ -221,7 +283,7 @@ pmax = phoistAcyclic $ plam $ \a b -> pif (a #<= b) b a pnumerator :: Term s (PRational :--> PInteger) pnumerator = phoistAcyclic $ plam $ \x -> pmatch x $ \(PRational n _) -> n -pdenominator :: Term s (PRational :--> PInteger) +pdenominator :: Term s (PRational :--> PPositive) pdenominator = phoistAcyclic $ plam $ \x -> pmatch x $ \(PRational _ d) -> d pfromInteger :: Term s (PInteger :--> PRational) @@ -229,34 +291,37 @@ pfromInteger = phoistAcyclic $ plam $ \n -> pcon $ PRational n 1 pround :: Term s (PRational :--> PInteger) pround = phoistAcyclic $ - plam $ \x -> - pmatch x $ \(PRational a b) -> - plet (pdiv # a # b) $ \base -> - plet (pmod # a # b) $ \rem -> - base - + pif - (pmod # b # 2 #== 1) - (pif (pdiv # b # 2 #< rem) 1 0) - ( pif - (pdiv # b # 2 #== rem) - (pmod # base # 2) - (pif (rem #< pdiv # b # 2) 0 1) - ) - --- (pdiv # b # 2 + pmod # b # 2 #<= pmod # a # b) 1 0 + plam $ \x -> unTermCont $ do + PRational a' b' <- tcont $ pmatch x + a <- tcont $ plet a' + b <- tcont $ plet b' + base <- tcont . plet $ pdiv # a # pto b + rem <- tcont . plet $ pmod # a # pto b + let result = + pif + (pmod # pto b # 2 #== 1) + (pif (pdiv # pto b # 2 #< rem) 1 0) + $ pif + (pdiv # pto b # 2 #== rem) + (pmod # base # 2) + (pif (rem #< pdiv # pto b # 2) 0 1) + pure $ base + result ptruncate :: Term s (PRational :--> PInteger) ptruncate = phoistAcyclic $ - plam $ \x -> - pmatch x $ \(PRational a b) -> - plet (pdiv # a # b) $ \q -> - pif - (0 #<= a) - q - (q + pif (pmod # a # b #== 0) 0 1) + plam $ \x -> unTermCont $ do + PRational a' b' <- tcont $ pmatch x + a <- tcont $ plet a' + b <- tcont $ plet b' + q <- tcont . plet $ pdiv # a # pto b + pure $ + pif + (0 #<= a) + q + (q + pif (pmod # a # pto b #== 0) 0 1) pproperFraction :: Term s (PRational :--> PPair PInteger PRational) pproperFraction = phoistAcyclic $ plam $ \x -> plet (ptruncate # x) $ \q -> - pcon $ PPair q (x - pfromInteger # q) + pcon $ PPair q (x - Plutarch.Rational.pfromInteger # q) diff --git a/Plutarch/Rec.hs b/Plutarch/Rec.hs deleted file mode 100644 index f89d7a6a8..000000000 --- a/Plutarch/Rec.hs +++ /dev/null @@ -1,244 +0,0 @@ -{-# LANGUAGE DefaultSignatures #-} - -module Plutarch.Rec ( - DataReader (DataReader, readData), - DataWriter (DataWriter, writeData), - PRecord (PRecord, getRecord), - ScottEncoded, - ScottEncoding, - RecordFromData (fieldFoci, fieldListFoci), - field, - fieldFromData, - letrec, - pletrec, - rcon, - recordDataFromFieldWriters, - recordFromFieldReaders, - rmatch, -) where - -import Control.Monad.Trans.State.Lazy (State, evalState, get, put) -import Data.Functor.Compose (Compose (Compose, getCompose)) -import Data.Kind (Type) -import Data.Monoid (Dual (Dual, getDual), Endo (Endo, appEndo), Sum (Sum, getSum)) -import Numeric.Natural (Natural) -import Plutarch ( - PlutusType (PInner, pcon', pmatch'), - pcon, - phoistAcyclic, - plam, - plet, - pmatch, - (#), - (:-->), - ) -import Plutarch.Bool (pif, (#==)) -import Plutarch.Builtin (PAsData, PBuiltinList, PData, pasConstr, pforgetData, pfstBuiltin, psndBuiltin) -import Plutarch.Integer (PInteger) -import Plutarch.Internal ( - PType, - RawTerm (RApply, RLamAbs, RVar), - Term (Term, asRawTerm), - TermResult (TermResult, getDeps, getTerm), - mapTerm, - ) -import Plutarch.List (pcons, phead, pnil, ptail) -import Plutarch.Trace (ptraceError) -import Plutarch.Unsafe (punsafeBuiltin, punsafeCoerce) -import qualified PlutusCore as PLC -import qualified Rank2 - -newtype PRecord r s = PRecord {getRecord :: r (Term s)} - -type family ScottEncoded (r :: ((PType) -> Type) -> Type) (a :: PType) :: PType -newtype ScottArgument r s t = ScottArgument {getScott :: Term s (ScottEncoded r t)} -type ScottEncoding r t = ScottEncoded r t :--> t - -instance (Rank2.Distributive r, Rank2.Traversable r) => PlutusType (PRecord r) where - type PInner (PRecord r) t = ScottEncoding r t - pcon' :: forall s t. PRecord r s -> Term s (ScottEncoding r t) - pcon' (PRecord r) = rcon r - pmatch' :: forall s t. (Term s (ScottEncoding r t)) -> (PRecord r s -> Term s t) -> Term s t - pmatch' p f = rmatch p (f . PRecord) - --- | Convert a Haskell record value to a Scott-encoded record. -rcon :: forall r s t. Rank2.Foldable r => r (Term s) -> Term s (ScottEncoding r t) -rcon r = plam (\f -> punsafeCoerce $ appEndo (getDual $ Rank2.foldMap (Dual . Endo . applyField) r) f) - where - applyField x f = punsafeCoerce f # x - --- | Match a Scott-encoded record using a function that takes a Haskell record value. -rmatch :: - forall r s t. - (Rank2.Distributive r, Rank2.Traversable r) => - (Term s (ScottEncoding r t)) -> - (r (Term s) -> Term s t) -> - Term s t -rmatch p f = p # arg - where - arg :: Term s (ScottEncoded r t) - arg = Term (\i -> TermResult (RLamAbs (fieldCount (initial @r) - 1) $ rawArg i) []) - rawArg :: Natural -> RawTerm - rawArg depth = getTerm $ asRawTerm (f $ variables depth) $ depth + fieldCount (initial @r) - --- | Wrapped recursive let construct, tying into knot the recursive equations specified in the record fields. -pletrec :: forall r s. (Rank2.Distributive r, Rank2.Traversable r) => (r (Term s) -> r (Term s)) -> Term s (PRecord r) -pletrec = punsafeCoerce . letrec - --- | Recursive let construct, tying into knot the recursive equations specified in the record fields. -letrec :: - forall r s t. - (Rank2.Distributive r, Rank2.Traversable r) => - (r (Term s) -> r (Term s)) -> - Term s (ScottEncoding r t) -letrec r = Term term - where - term n = TermResult {getTerm = RApply rfix [RLamAbs 1 $ RApply (RVar 0) $ rawTerms], getDeps = deps} - where - (Dual rawTerms, deps) = Rank2.foldMap (rawResult . ($ n) . asRawTerm) (r selfReferring) - rawResult TermResult {getTerm, getDeps} = (Dual [getTerm], getDeps) - selfReferring = Rank2.fmap fromRecord accessors - fromRecord :: ScottArgument r s a -> Term s a - fromRecord (ScottArgument (Term access)) = - Term $ \depth -> mapTerm (\field -> RApply (RVar $ fieldCount (initial @r) + depth - 1) [field]) (access 0) - --- | Converts a Haskell field function to a Scott-encoded record field accessor. -field :: - forall r s t. - (Rank2.Distributive r, Rank2.Traversable r) => - (r (ScottArgument r s) -> ScottArgument r s t) -> - Term s (ScottEncoded r t) -field f = getScott (f accessors) - --- | Provides a record of function terms that access each field out of a Scott-encoded record. -accessors :: forall r s. (Rank2.Distributive r, Rank2.Traversable r) => r (ScottArgument r s) -accessors = abstract Rank2.<$> variables 0 - where - abstract :: Term s a -> ScottArgument r s a - abstract (Term t) = ScottArgument (phoistAcyclic $ Term $ mapTerm (RLamAbs $ depth - 1) . t . (depth +)) - depth = fieldCount (initial @r) - -{- | A record of terms that each accesses a different variable in scope, - outside in following the field order. --} -variables :: forall r s. (Rank2.Distributive r, Rank2.Traversable r) => Natural -> r (Term s) -variables baseDepth = Rank2.cotraverse var id - where - var :: (r (Term s) -> Term s a) -> Term s a - var ref = ref ordered - ordered :: r (Term s) - ordered = evalState (Rank2.traverse next $ initial @r) 0 - next :: f a -> State Natural (Term s a) - next _ = do - i <- get - let i' = succ i - seq i' (put i') - return $ - Term $ - \depth -> - TermResult - { getTerm = RVar (depth - baseDepth - i') - , getDeps = [] - } - -newtype DataReader s a = DataReader {readData :: Term s (PAsData a) -> Term s a} -newtype DataWriter s a = DataWriter {writeData :: Term s a -> Term s (PAsData a)} -newtype FocusFromData s a b = FocusFromData {getFocus :: Term s (PAsData a :--> PAsData b)} -newtype FocusFromDataList s a = FocusFromDataList {getItem :: Term s (PBuiltinList PData) -> Term s (PAsData a)} - -{- | Converts a record of field DataReaders to a DataReader of the whole - record. If you only need a single field or two, use `fieldFromData` - instead. --} -recordFromFieldReaders :: - forall r s. - (Rank2.Apply r, RecordFromData r) => - r (DataReader s) -> - DataReader s (PRecord r) -recordFromFieldReaders reader = DataReader $ verifySoleConstructor readRecord - where - readRecord :: Term s (PBuiltinList PData) -> Term s (PRecord r) - readRecord dat = pcon $ PRecord $ Rank2.liftA2 (flip readData . getCompose) (fields dat) reader - fields :: Term s (PBuiltinList PData) -> r (Compose (Term s) PAsData) - fields bis = (\f -> Compose $ getItem f bis) Rank2.<$> fieldListFoci - -recordDataFromFieldWriters :: - forall r s. - (Rank2.Apply r, RecordFromData r) => - r (DataWriter s) -> - DataWriter s (PRecord r) -recordDataFromFieldWriters writer = DataWriter (`pmatch` writeRecord) - where - writeRecord :: PRecord r s -> Term s (PAsData (PRecord r)) - writeRecord (PRecord r) = - punsafeBuiltin PLC.ConstrData # (0 :: Term s PInteger) - # appEndo (Rank2.foldMap (Endo . consField) (Rank2.liftA2 writeField writer r)) pnil - consField :: Compose (Term s) PAsData a -> Term s (PBuiltinList PData) -> Term s (PBuiltinList PData) - consField (Compose h) t = pcons # pforgetData h # t - writeField :: DataWriter s a -> Term s a -> Compose (Term s) PAsData a - writeField w r = Compose (writeData w r) - -{- | Converts a Haskell field function to a function term that extracts the 'Data' encoding of the field from the - encoding of the whole record. If you need to access most of the record fields, it's more efficient to decode the - entire record at once with `recordFromFieldReaders`. --} -fieldFromData :: - RecordFromData r => - (r (FocusFromData s (PRecord r)) -> FocusFromData s (PRecord r) t) -> - Term s (PAsData (PRecord r) :--> PAsData t) -fieldFromData f = getFocus (f fieldFoci) - -{- | Instances of this class must know how to focus on individual fields of - the data-encoded record. If the declared order of the record fields doesn't - match the encoding order, you must override the method defaults. --} -class (Rank2.Distributive r, Rank2.Traversable r) => RecordFromData r where - -- | Given the encoding of the whole record, every field focuses on its own encoding. - fieldFoci :: r (FocusFromData s (PRecord r)) - - -- | Given the encoding of the list of all fields, every field focuses on its own encoding. - fieldListFoci :: r (FocusFromDataList s) - - fieldFoci = Rank2.cotraverse focus id - where - focus :: (r (FocusFromData s (PRecord r)) -> FocusFromData s (PRecord r) a) -> FocusFromData s (PRecord r) a - focus ref = ref foci - foci :: r (FocusFromData s (PRecord r)) - foci = fieldsFromRecord Rank2.<$> fieldListFoci - fieldsFromRecord :: FocusFromDataList s a -> FocusFromData s (PRecord r) a - fieldsFromRecord (FocusFromDataList f) = FocusFromData $ plam $ verifySoleConstructor f - fieldListFoci = Rank2.cotraverse focus id - where - focus :: (r (FocusFromDataList s) -> FocusFromDataList s a) -> FocusFromDataList s a - focus ref = ref foci - foci :: r (FocusFromDataList s) - foci = evalState (Rank2.traverse next $ initial @r) id - next :: f a -> State (Term s (PBuiltinList PData) -> Term s (PBuiltinList PData)) (FocusFromDataList s a) - next _ = do - rest <- get - put ((ptail #) . rest) - return $ FocusFromDataList (punsafeCoerce . (phead #) . rest) - -verifySoleConstructor :: (Term s (PBuiltinList PData) -> Term s a) -> (Term s (PAsData (PRecord r)) -> Term s a) -verifySoleConstructor f d = - plet (pasConstr # pforgetData d) $ \constr -> - pif - (pfstBuiltin # constr #== 0) - (f $ psndBuiltin # constr) - (ptraceError "verifySoleConstructor failed") - -initial :: Rank2.Distributive r => r (Compose Maybe (Term s)) -initial = Rank2.distribute Nothing - -fieldCount :: Rank2.Foldable r => r f -> Natural -fieldCount = getSum . Rank2.foldMap (const $ Sum 1) - --- | The raw Y-combinator term -rfix :: RawTerm --- The simplest variant of the Y combinator hangs the interpreter, so we use an eta-expanded version instead. --- rfix = RLamAbs 0 $ RApply (RLamAbs 0 $ RApply (RVar 1) [RApply (RVar 0) [RVar 0]]) [RLamAbs 0 $ RApply (RVar 1) [RApply (RVar 0) [RVar 0]]] -rfix = - RLamAbs 0 $ - RApply - (RLamAbs 0 $ RApply (RVar 1) [RLamAbs 0 $ RApply (RVar 1) [RVar 0, RVar 1]]) - [RLamAbs 0 $ RApply (RVar 1) [RLamAbs 0 $ RApply (RVar 1) [RVar 0, RVar 1]]] diff --git a/Plutarch/Rec/TH.hs b/Plutarch/Rec/TH.hs deleted file mode 100644 index 5d65f7ae7..000000000 --- a/Plutarch/Rec/TH.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Plutarch.Rec.TH (deriveAll, deriveScottEncoded) where - -import Language.Haskell.TH (Q) -import qualified Language.Haskell.TH as TH -import Plutarch ((:-->)) -import Plutarch.Rec (PRecord, ScottEncoded) -import qualified Rank2.TH - --- | Use as a TH splice for all necessary @instance@ declarations. -deriveAll :: TH.Name -> Q [TH.Dec] -deriveAll name = (<>) <$> deriveScottEncoded name <*> Rank2.TH.deriveAll name - --- | Use as a TH splice for @type instance ScottEncoded@ declarations. -deriveScottEncoded :: TH.Name -> Q [TH.Dec] -deriveScottEncoded name = do - con <- reifyConstructor name - a <- TH.newName "a" - let qa = pure (TH.VarT a) - [d|type instance ScottEncoded $(pure $ TH.ConT name) $qa = $(genScottEncoded con qa)|] - -genScottEncoded :: TH.Con -> Q TH.Type -> Q TH.Type -genScottEncoded (TH.InfixC (_, left) _name (_, right)) result = argType left (argType right result) -genScottEncoded (TH.NormalC _name fields) result = foldr argType result (snd <$> fields) -genScottEncoded (TH.RecC _name fields) result = foldr argType result (fieldType <$> fields) - where - fieldType (_, _, t) = t -genScottEncoded _ _ = error "Can't encode GADTs" - -argType :: TH.Type -> Q TH.Type -> Q TH.Type -argType (TH.AppT (TH.VarT _) t) result = [t|$(bare t) :--> $result|] -argType (TH.AppT t (TH.VarT _)) result = [t|PRecord $(bare t) :--> $result|] -argType _ _ = error "Expected an HKD field type of form (f FieldType)" - -bare :: TH.Type -> Q TH.Type -bare (TH.SigT t _) = bare t -bare t = pure t - -reifyConstructor :: TH.Name -> Q TH.Con -reifyConstructor ty = do - (TH.TyConI tyCon) <- TH.reify ty - case tyCon of - TH.DataD _ _nm _tyVars _kind [c] _ -> return c - TH.NewtypeD _ _nm _tyVars _kind c _ -> return c - _ -> fail "Expected a single-constructor data or newtype" diff --git a/Plutarch/Reducible.hs b/Plutarch/Reducible.hs new file mode 100644 index 000000000..ce5c54e7a --- /dev/null +++ b/Plutarch/Reducible.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE UndecidableInstances #-} + +-- FIXME: This should be its own package as it's not related to Plutarch at all. +module Plutarch.Reducible (Reduce, NoReduce (..), reduce) where + +import Data.Coerce (Coercible, coerce) +import Data.Kind (Type) +import GHC.Generics (C1, D1, Rec0, Rep, S1, pattern MetaData) +import Plutarch.Internal (Term) + +newtype NoReduce a = NoReduce a + +type family GReduce (def :: Type) (rep :: Type -> Type) :: Type where +-- newtype + GReduce _ (D1 ( 'MetaData _ _ _ 'True) (C1 _ (S1 _ (Rec0 (x :: Type))))) = Reduce x +-- data + GReduce def _ = def + +{- | This class provides a work-around for partially applying + type families of kind @a@, where @a@ is either 'Type' or + @b -> c@ where @c@ satisfies the same constraint. + + Given a type family @F : A -> Type@, you can make the following + @ + type F' :: A -> Type + newtype F' (a :: A) = F' (NoReduce (F a)) deriving stock Generic + @ + It is then true that @forall a. Reduce (F' a) ~ F a@. +-} +type family Reduce (x :: Type) :: Type where + Reduce (NoReduce a) = a + Reduce (Term s a) = Term s a -- FIXME remove + Reduce (a -> b) = a -> b + Reduce x = GReduce x (Rep x) + +reduce :: Coercible a (Reduce a) => a -> Reduce a +reduce = coerce diff --git a/Plutarch/Show.hs b/Plutarch/Show.hs new file mode 100644 index 000000000..68aa6ff6e --- /dev/null +++ b/Plutarch/Show.hs @@ -0,0 +1,211 @@ +module Plutarch.Show ( + PShow (pshow'), + pshow, +) where + +import Data.Char (intToDigit) +import Data.List.NonEmpty (NonEmpty ((:|))) +import qualified Data.List.NonEmpty as NE +import Data.Semigroup (sconcat) +import Data.String (IsString (fromString)) +import qualified Data.Text as T +import Generics.SOP ( + All, + All2, + ConstructorName, + K (K), + NP, + NS, + Proxy (Proxy), + SOP (SOP), + constructorInfo, + constructorName, + hcmap, + hcollapse, + hindex, + hmap, + ) +import Generics.SOP.GGP (gdatatypeInfo) +import Plutarch.Bool (PBool, PEq, pif, (#<), (#==)) +import Plutarch.ByteString (PByteString, pconsBS, pindexBS, plengthBS, psliceBS) +import Plutarch.Integer (PInteger, PIntegral (pquot, prem)) +import Plutarch.Internal ( + Term, + perror, + phoistAcyclic, + plet, + (:-->), + ) +import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom) +import Plutarch.Internal.Other ( + pfix, + ) +import Plutarch.Internal.PLam (plam, (#), (#$)) +import Plutarch.Internal.PlutusType (PlutusType, pmatch) +import Plutarch.Lift (pconstant) +import Plutarch.String (PString, pdecodeUtf8, pencodeUtf8) + +class PShow t where + -- | Return the string representation of a Plutarch value + -- + -- If the wrap argument is True, optionally wrap the output in `(..)` if it + -- represents multiple parameters. + pshow' :: Bool -> Term s t -> Term s PString + default pshow' :: (PGeneric t, PlutusType t, All2 PShow (PCode t)) => Bool -> Term s t -> Term s PString + pshow' wrap x = gpshow wrap # x + +-- | Return the string representation of a Plutarch value +pshow :: PShow a => Term s a -> Term s PString +pshow = pshow' False + +instance PShow PString where + pshow' _ x = pshowStr # x + where + pshowStr :: Term s (PString :--> PString) + pshowStr = phoistAcyclic $ + plam $ \s -> + "\"" <> (pdecodeUtf8 #$ pshowUtf8Bytes #$ pencodeUtf8 # s) <> "\"" + pshowUtf8Bytes :: Term s (PByteString :--> PByteString) + pshowUtf8Bytes = phoistAcyclic $ + pfix #$ plam $ \self bs -> + pelimBS # bs + # bs + #$ plam + $ \x xs -> + -- Non-ascii byte sequence will not use bytes < 128. + -- So we are safe to rewrite the lower byte values. + -- https://en.wikipedia.org/wiki/UTF-8#Encoding + let doubleQuote :: Term _ PInteger = 34 -- `"` + escapeSlash :: Term _ PInteger = 92 -- `\` + rec = pconsBS # x #$ self # xs + in pif + (x #== doubleQuote) + (pconsBS # escapeSlash # rec) + rec + +instance PShow PBool where + pshow' _ x = pshowBool # x + where + pshowBool :: Term s (PBool :--> PString) + pshowBool = phoistAcyclic $ + plam $ \x -> + -- Delegate to Haskell's Show instance + pmatch x $ pconstant @PString . T.pack . show + +instance PShow PInteger where + pshow' _ x = pshowInt # x + where + pshowInt :: Term s (PInteger :--> PString) + pshowInt = phoistAcyclic $ + pfix #$ plam $ \self n -> + let sign = pif (n #< 0) "-" "" + in sign + <> ( plet (pquot # abs n # 10) $ \q -> + plet (prem # abs n # 10) $ \r -> + pif + (q #== 0) + (pshowDigit # r) + ( plet (self # q) $ \prefix -> + prefix <> pshowDigit # r + ) + ) + pshowDigit :: Term s (PInteger :--> PString) + pshowDigit = phoistAcyclic $ + plam $ \digit -> + pcase perror digit $ + flip fmap [0 .. 9] $ \(x :: Integer) -> + (pconstant x, pconstant (T.pack . show $ x)) + +instance PShow PByteString where + pshow' _ x = showByteString # x + where + showByteString :: Term s (PByteString :--> PString) + showByteString = phoistAcyclic $ + plam $ \bs -> + "0x" <> showByteString' # bs + showByteString' :: Term s (PByteString :--> PString) + showByteString' = phoistAcyclic $ + pfix #$ plam $ \self bs -> + pelimBS # bs + # (pconstant @PString "") + #$ plam + $ \x xs -> showByte # x <> self # xs + showByte :: Term s (PInteger :--> PString) + showByte = phoistAcyclic $ + plam $ \n -> + plet (pquot # n # 16) $ \a -> + plet (prem # n # 16) $ \b -> + showNibble # a <> showNibble # b + showNibble :: Term s (PInteger :--> PString) + showNibble = phoistAcyclic $ + plam $ \n -> + pcase perror n $ + flip fmap [0 .. 15] $ \(x :: Int) -> + ( pconstant $ toInteger x + , pconstant @PString $ T.pack $ intToDigit x : [] + ) + +-- | Case matching on bytestring, as if a list. +pelimBS :: + Term + s + ( PByteString + :--> a -- If bytestring is empty + :--> (PInteger :--> PByteString :--> a) -- If bytestring is non-empty + :--> a + ) +pelimBS = phoistAcyclic $ + plam $ \bs z f -> + plet (plengthBS # bs) $ \n -> + pif (n #== 0) z $ + plet (pindexBS # bs # 0) $ \x -> + plet (psliceBS # 1 # (n - 1) # bs) $ \xs -> + f # x # xs + +pcase :: PEq a => Term s b -> Term s a -> [(Term s a, Term s b)] -> Term s b +pcase otherwise x = \case + [] -> otherwise + ((x', r) : cs) -> pif (x #== x') r $ pcase otherwise x cs + +-- | Generic version of `pshow` +gpshow :: + forall a s. + (PGeneric a, PlutusType a, All2 PShow (PCode a)) => + Bool -> + Term s (a :--> PString) +gpshow wrap = + let constructorNames :: [ConstructorName] = + hcollapse $ hmap (K . constructorName) $ constructorInfo $ gdatatypeInfo (Proxy @(a s)) + in phoistAcyclic $ + plam $ \x -> + pmatch x $ \x' -> + productGroup wrap " " $ gpshow' constructorNames (gpfrom x') + +-- | Like `gpshow`, but returns the individual parameters list +gpshow' :: + forall a s. + All2 PShow a => + [ConstructorName] -> + SOP (Term s) a -> + NonEmpty (Term s PString) +gpshow' constructorNames (SOP x) = + let cName = constructorNames !! hindex x + in pconstant @PString (T.pack cName) :| showSum x + where + showSum :: NS (NP (Term s)) a -> [Term s PString] + showSum = + hcollapse . hcmap (Proxy @(All PShow)) showProd + showProd :: All PShow xs => NP (Term s) xs -> K [Term s PString] xs + showProd = + K . hcollapse . hcmap (Proxy @PShow) showTerm + showTerm :: forall b. PShow b => Term s b -> K (Term s PString) b + showTerm = + K . pshow' True + +-- | Group parameters list, preparing for final PShow output +productGroup :: (Monoid a, IsString a) => Bool -> a -> NonEmpty a -> a +productGroup wrap sep = \case + x :| [] -> x + xs -> + let xs' = sconcat $ NE.intersperse sep xs + in if wrap then fromString "(" <> xs' <> fromString ")" else xs' diff --git a/Plutarch/String.hs b/Plutarch/String.hs index 06f5949fb..5648fa69b 100644 --- a/Plutarch/String.hs +++ b/Plutarch/String.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -6,16 +7,17 @@ module Plutarch.String (PString, pfromText, pencodeUtf8, pdecodeUtf8) where import Data.String (IsString, fromString) import Data.Text (Text) import qualified Data.Text as Txt +import GHC.Generics (Generic) import Plutarch.Bool (PEq, (#==)) import Plutarch.ByteString (PByteString) -import Plutarch.Internal.Other ( - Term, - (#), - type (:-->), - ) +import Plutarch.Internal (Term, (:-->)) +import Plutarch.Internal.Newtype (PlutusTypeNewtype) +import Plutarch.Internal.Other (POpaque) +import Plutarch.Internal.PLam ((#)) +import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType) import Plutarch.Lift ( DerivePConstantDirect (DerivePConstantDirect), - PConstant, + PConstantDecl, PLifted, PUnsafeLiftDecl, pconstant, @@ -24,10 +26,14 @@ import Plutarch.Unsafe (punsafeBuiltin) import qualified PlutusCore as PLC -- | Plutus 'BuiltinString' values -data PString s +data PString s = PString (Term s POpaque) + deriving stock (Generic) + deriving anyclass (PlutusType) + +instance DerivePlutusType PString where type DPTStrat _ = PlutusTypeNewtype instance PUnsafeLiftDecl PString where type PLifted PString = Text -deriving via (DerivePConstantDirect Text PString) instance (PConstant Text) +deriving via (DerivePConstantDirect Text PString) instance PConstantDecl Text {-# DEPRECATED pfromText "Use `pconstant` instead." #-} diff --git a/Plutarch/TermCont.hs b/Plutarch/TermCont.hs index c446c7b08..38cddd850 100644 --- a/Plutarch/TermCont.hs +++ b/Plutarch/TermCont.hs @@ -10,7 +10,18 @@ module Plutarch.TermCont ( import Data.Kind (Type) import Data.String (fromString) -import Plutarch.Internal (Dig, PType, S, Term (Term), asRawTerm, getTerm, hashRawTerm) +import Plutarch.Internal ( + Dig, + PType, + S, + Term (Term), + asRawTerm, + getTerm, + hashRawTerm, + pgetConfig, + tracingMode, + pattern DetTracing, + ) import Plutarch.Trace (ptraceError) newtype TermCont :: forall (r :: PType). S -> Type -> Type where @@ -38,12 +49,14 @@ instance Monad (TermCont s) where instance MonadFail (TermCont s) where fail s = TermCont $ \_ -> - ptraceError $ fromString s + pgetConfig \c -> case tracingMode c of + DetTracing -> ptraceError "Pattern matching failure in TermCont" + _ -> ptraceError $ fromString s tcont :: ((a -> Term s r) -> Term s r) -> TermCont @r s a tcont = TermCont hashOpenTerm :: Term s a -> TermCont s Dig -hashOpenTerm x = TermCont $ \f -> Term $ \i -> - let inner = f $ hashRawTerm . getTerm $ asRawTerm x i - in asRawTerm inner i +hashOpenTerm x = TermCont $ \f -> Term $ \i -> do + y <- asRawTerm x i + asRawTerm (f . hashRawTerm . getTerm $ y) i diff --git a/Plutarch/Trace.hs b/Plutarch/Trace.hs index 10cdbea3a..5d3a351ef 100644 --- a/Plutarch/Trace.hs +++ b/Plutarch/Trace.hs @@ -1,59 +1,62 @@ {-# LANGUAGE CPP #-} -module Plutarch.Trace (ptrace, ptraceIfTrue, ptraceIfFalse, ptraceError) where +module Plutarch.Trace ( + ptrace, + ptraceShowId, + ptraceIfTrue, + ptraceIfFalse, + ptraceError, +) where --- CPP support isn't great in fourmolu. -{- ORMOLU_DISABLE -} - -import Plutarch.Internal.Other (Term, perror) -#ifdef Development -import Plutarch.Internal.Other (type (:-->), (#), phoistAcyclic, plet, pforce, pdelay) -#endif -#ifdef Development import Plutarch.Bool (PBool, pif) -#else -import Plutarch.Bool (PBool) -#endif +import Plutarch.Internal ( + Term, + pdelay, + perror, + pforce, + pgetConfig, + phoistAcyclic, + plet, + tracingMode, + pattern NoTracing, + type (:-->), + ) +import Plutarch.Internal.PLam ((#)) +import Plutarch.Show (PShow, pshow) import Plutarch.String (PString) -#ifdef Development import Plutarch.Unsafe (punsafeBuiltin) import qualified PlutusCore as PLC -#endif -#ifdef Development ptrace' :: Term s (PString :--> a :--> a) ptrace' = phoistAcyclic $ pforce $ punsafeBuiltin PLC.Trace -#endif -- | Trace the given message before evaluating the argument. ptrace :: Term s PString -> Term s a -> Term s a -#ifdef Development -ptrace s a = pforce $ ptrace' # s # pdelay a -#else -ptrace _ a = a -#endif +ptrace s a = pgetConfig \c -> case tracingMode c of + NoTracing -> a + _ -> pforce $ ptrace' # s # pdelay a + +-- | Like Haskell's `traceShowId` but for Plutarch +ptraceShowId :: PShow a => Term s a -> Term s a +ptraceShowId a = pgetConfig \c -> case tracingMode c of + NoTracing -> a + _ -> ptrace (pshow a) a -- | Trace the given message and terminate evaluation with a 'perror'. ptraceError :: Term s PString -> Term s a -#ifdef Development -ptraceError s = pforce $ ptrace' # s # pdelay perror -#else -ptraceError _ = perror -#endif +ptraceError s = pgetConfig \c -> case tracingMode c of + NoTracing -> perror + _ -> pforce $ ptrace' # s # pdelay perror -- | Trace the given message if the argument evaluates to true. ptraceIfTrue :: Term s PString -> Term s PBool -> Term s PBool -#ifdef Development -ptraceIfTrue s a' = plet a' $ \a -> pif a (ptrace' # s # a) a -#else -ptraceIfTrue _ a = a -#endif +ptraceIfTrue s a' = pgetConfig \c -> case tracingMode c of + NoTracing -> a' + _ -> plet a' $ \a -> pif a (ptrace' # s # a) a -- | Trace the given message if the argument evaluates to False. ptraceIfFalse :: Term s PString -> Term s PBool -> Term s PBool -#ifdef Development -ptraceIfFalse s a' = plet a' $ \a -> pif a a (ptrace' # s # a) -#else -ptraceIfFalse _ a = a -#endif +ptraceIfFalse s a' = pgetConfig \c -> case tracingMode c of + NoTracing -> a' + _ -> plet a' $ \a -> pif a a (ptrace' # s # a) diff --git a/Plutarch/TryFrom.hs b/Plutarch/TryFrom.hs new file mode 100644 index 000000000..d2ee1b87c --- /dev/null +++ b/Plutarch/TryFrom.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module Plutarch.TryFrom ( + PTryFrom (..), + ptryFrom, + PSubtype, + PSubtype', + pupcast, + pupcastF, + pdowncastF, +) where + +import Data.Kind (Constraint) +import Data.Proxy (Proxy (Proxy)) + +import Plutarch.Internal (PType, Term, punsafeCoerce) +import Plutarch.Internal.PlutusType (PContravariant, PCovariant, PInner) +import Plutarch.Internal.Witness (witness) + +import Plutarch.Reducible (Reduce) + +type family Helper (a :: PType) (b :: PType) (bi :: PType) :: Bool where + Helper _ b b = 'False + Helper a _ bi = PSubtype' a bi + +type family PSubtype' (a :: PType) (b :: PType) :: Bool where + PSubtype' a a = 'True + PSubtype' a b = Helper a b (PInner b) + +{- | @PSubtype a b@ constitutes a subtyping relation between @a@ and @b@. + This concretely means that `\(x :: Term s b) -> punsafeCoerce x :: Term s a` + is legal and sound. + + You can not make an instance for this yourself. + You must use the 'PInner' type family of 'PlutusType' to get this instance. + + Caveat: Only @PInner a POpaque@ is considered unfortunately, as otherwise + getting GHC to figure out the relation with multiple supertypes is quite hard. + + Subtyping is transitive. +-} +type family PSubtype (a :: PType) (b :: PType) :: Constraint where + PSubtype a b = PSubtype' a b ~ 'True + +{- | +@PTryFrom a b@ represents a subtyping relationship between @a@ and @b@, +and a way to go from @a@ to @b@. +Laws: +- @(punsafeCoerce . fst) <$> tcont (ptryFrom x) ≡ pure x@ +-} +class PSubtype a b => PTryFrom (a :: PType) (b :: PType) where + type PTryFromExcess a b :: PType + type PTryFromExcess a b = PTryFromExcess a (PInner b) + ptryFrom' :: forall s r. Term s a -> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r) -> Term s r + default ptryFrom' :: forall s r. (PTryFrom a (PInner b), PTryFromExcess a b ~ PTryFromExcess a (PInner b)) => Term s a -> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r) -> Term s r + ptryFrom' opq f = ptryFrom @(PInner b) @a opq \(inn, exc) -> f (punsafeCoerce inn, exc) + +ptryFrom :: forall b a s r. PTryFrom a b => Term s a -> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r) -> Term s r +ptryFrom = ptryFrom' + +pupcast :: forall a b s. PSubtype a b => Term s b -> Term s a +pupcast = let _ = witness (Proxy @(PSubtype a b)) in punsafeCoerce + +pupcastF :: forall a b (p :: PType -> PType) s. (PSubtype a b, PCovariant p) => Proxy p -> Term s (p b) -> Term s (p a) +pupcastF _ = + let _ = witness (Proxy @(PSubtype a b)) + _ = witness (Proxy @(PCovariant p)) + in punsafeCoerce + +pdowncastF :: forall a b (p :: PType -> PType) s. (PSubtype a b, PContravariant p) => Proxy p -> Term s (p a) -> Term s (p b) +pdowncastF _ = + let _ = witness (Proxy @(PSubtype a b)) + _ = witness (Proxy @(PContravariant p)) + in punsafeCoerce diff --git a/Plutarch/Unit.hs b/Plutarch/Unit.hs index 8b5f2df36..26a1e1892 100644 --- a/Plutarch/Unit.hs +++ b/Plutarch/Unit.hs @@ -1,36 +1,45 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Plutarch.Unit (PUnit (..)) where -import Plutarch (PlutusType (PInner, pcon', pmatch'), Term, pcon) -import Plutarch.Bool (PBool (PFalse, PTrue), PEq, POrd, (#<), (#<=), (#==)) +import Plutarch (Term, pcon, plet) +import Plutarch.Bool (PBool (PFalse, PTrue), PEq, POrd, PPartialOrd, (#<), (#<=), (#==)) +import Plutarch.Internal.PlutusType (PInner, PlutusType, pcon', pmatch') import Plutarch.Lift ( DerivePConstantDirect (DerivePConstantDirect), - PConstant, + PConstantDecl, PLifted, PUnsafeLiftDecl, pconstant, ) +import Plutarch.Show (PShow (pshow')) data PUnit s = PUnit + instance PUnsafeLiftDecl PUnit where type PLifted PUnit = () -deriving via (DerivePConstantDirect () PUnit) instance (PConstant ()) +deriving via (DerivePConstantDirect () PUnit) instance PConstantDecl () instance PlutusType PUnit where - type PInner PUnit _ = PUnit + type PInner PUnit = PUnit pcon' PUnit = pconstant () - pmatch' _ f = f PUnit + pmatch' x f = plet x \_ -> f PUnit instance PEq PUnit where - _ #== _ = pcon PTrue + x #== y = plet x \_ -> plet y \_ -> pcon PTrue + +instance PPartialOrd PUnit where + x #<= y = plet x \_ -> plet y \_ -> pcon PTrue + x #< y = plet x \_ -> plet y \_ -> pcon PFalse -instance POrd PUnit where - _ #<= _ = pcon PTrue - _ #< _ = pcon PFalse +instance POrd PUnit instance Semigroup (Term s PUnit) where - _ <> _ = pcon PUnit + x <> y = plet x \_ -> plet y \_ -> pcon PUnit instance Monoid (Term s PUnit) where mempty = pcon PUnit + +instance PShow PUnit where + pshow' _ x = plet x \_ -> "()" diff --git a/Plutarch/Unsafe.hs b/Plutarch/Unsafe.hs index e59a399b6..487527958 100644 --- a/Plutarch/Unsafe.hs +++ b/Plutarch/Unsafe.hs @@ -1,25 +1,17 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} - module Plutarch.Unsafe ( PI.punsafeBuiltin, PI.punsafeCoerce, PI.punsafeConstant, - punsafeFrom, - punsafeFromOpaque, + punsafeDowncast, ) where +import Plutarch.Internal (Term) import qualified Plutarch.Internal as PI -import Plutarch.Internal.Other (PInner, POpaque, Term) - -{- | - Unsafely coerce from an Opaque term to another type. --} -punsafeFromOpaque :: Term s POpaque -> Term s a -punsafeFromOpaque = PI.punsafeCoerce +import Plutarch.Internal.PlutusType (PInner) {- | Unsafely coerce from the 'PInner' representation of a Term, assuming that the value is a safe construction of the Term. -} -punsafeFrom :: (forall b. Term s (PInner a b)) -> Term s a -punsafeFrom x = PI.punsafeCoerce x +punsafeDowncast :: Term s (PInner a) -> Term s a +punsafeDowncast x = PI.punsafeCoerce x diff --git a/README.md b/README.md index 03338621c..a7c7a3c02 100644 --- a/README.md +++ b/README.md @@ -26,21 +26,9 @@ More benchmarks, with reproducible code, soon to follow. * Add this repo as a source repository package to your `cabal.project`. * Add the `plutarch` package as a dependency to your cabal file. -This package takes in a flag, `development`, that defaults to false. It's used to turn on "development mode". Following is a list of effects and their variations based on whether or not development mode is on. - -| On | Off | -| -- | --- | -| Tracing functions from `Plutarch.Trace` log given message to the trace log. | Tracing functions from `Plutarch.Trace` do not log. They merely return their argument. | - -You can turn on development mode by passing in the `development` flag in your `cabal.project` file: -```hs -package plutarch - flags: +development -``` - # Benchmarks -See the [`plutarch-benchmark`](./plutarch-benchmark) library for how to benchmark plutarch, and benchmarking your own scripts. +See the [`plutarch-test`](./plutarch-test) for testing and golden files containing benchmarks and UPLCs. # Usage Read the [Plutarch guide](./docs/README.md) to get started! @@ -48,6 +36,10 @@ Read the [Plutarch guide](./docs/README.md) to get started! # Contributing Contributions are more than welcome! Alongside the [User guide](#usage) above, you may also find the [Developers' guide](./docs/DEVGUIDE.md) useful for understanding the codebase. +## Developer communication channels + +We're in the Plutonomicon Discord: https://discord.gg/722KnTC8jF + # License ``` diff --git a/bin/format b/bin/format index 94c92da65..24b0d552a 100755 --- a/bin/format +++ b/bin/format @@ -2,6 +2,6 @@ set -xe -find -type f -name '*.hs' ! -path '*/dist-newstyle/*' | xargs fourmolu -o-XTypeApplications -o-XQualifiedDo -o-XOverloadedRecordDot -m inplace +find -type f -name '*.hs' ! -path '*/dist-newstyle/*' ! -path '*/tmp/*' | xargs fourmolu -o-XTypeApplications -o-XQualifiedDo -o-XOverloadedRecordDot -o-XNondecreasingIndentation -o-XPatternSynonyms -m inplace find -type f -name '*.cabal' | xargs cabal-fmt -i nixpkgs-fmt *.nix diff --git a/bin/ghcid b/bin/ghcid new file mode 100755 index 000000000..a8ce4a979 --- /dev/null +++ b/bin/ghcid @@ -0,0 +1,24 @@ +#!/bin/sh + +set -xe + +if [[ $1 == "" ]] +then + echo "Running ghcid on plutarch" + ghcid +elif [[ $1 == "extra" ]] +then + echo "Running ghcid on plutarch-extra" + ghcid -c 'cabal repl plutarch-extra:lib:plutarch-extra' +elif [[ $1 == "test:dev" ]] +then + echo "Running ghcid on plutarch-test in development mode" + ghcid -c 'cabal repl plutarch-test:exe:plutarch-test -f development --builddir=dist-ghc9-dev' -T Main.main +elif [[ $1 == "test" ]] +then + echo "Running ghcid on plutarch-test in non-development mode" + ghcid -c 'cabal repl plutarch-test:exe:plutarch-test' -T Main.main +else + echo "Invalid argument" + exit 2 +fi diff --git a/cabal.project b/cabal.project index 147f5f2e2..436b95495 100644 --- a/cabal.project +++ b/cabal.project @@ -3,7 +3,3 @@ packages: ./plutarch-* benchmarks: true - --- Enabling the flag here allows TraceSpec.hs and such tests to actually test --- the `ptrace` family of functions. --- flags: +development \ No newline at end of file diff --git a/ci.nix b/ci.nix deleted file mode 100644 index 1f71eca89..000000000 --- a/ci.nix +++ /dev/null @@ -1,3 +0,0 @@ -if builtins?getFlake -then (builtins.getFlake (toString ./.)).ciNix -else (import ./flake-compat.nix).defaultNix.ciNix diff --git a/docs/DEVGUIDE.md b/docs/DEVGUIDE.md index c121a32d4..d238b682b 100644 --- a/docs/DEVGUIDE.md +++ b/docs/DEVGUIDE.md @@ -17,6 +17,7 @@ Looking to contribute to Plutarch? Looking for functionalities that are not curr - [Lower Level Examples](#lower-level-examples) - [Extracting `txInfoInputs` from `ScriptContext` manually (UNTYPED)](#extracting-txinfoinputs-from-scriptcontext-manually-untyped) - [Useful Links](#useful-links) +- [How to build docs](#how-to-build-docs) @@ -58,7 +59,7 @@ Parts of the [Pluto guide](https://github.com/Plutonomicon/pluto/blob/main/GUIDE ## Plutus Core constants (UNSAFE) -> **NOTE**: The following information is almost never necessary with the existence of `pconstant`. Refer to [constant building](./Introduction/Plutarch%20Terms/Plutarch%20Constants.md) and [`PConstant` and `PLift`](./Typeclasses/PConstant%20and%20PLift.md) section of the Plutarch user guide. +> **NOTE**: The following information is almost never necessary with the existence of `pconstant`. Refer to [constant building](./Introduction/Plutarch%20Terms/Plutarch%20Constants.md) and [`PConstant`/`PLift`](./Typeclasses/PConstant%20and%20PLift.md) section of the Plutarch user guide. Often, you will need to build a Plutus core constant. You can do this using `Some` and `ValueOf`. Here's how `pcon PTrue` creates a Plutarch term that actually evaluates to a Plutus core constant representing a boolean: @@ -289,3 +290,23 @@ There's just one element in `txInfoInputs` in this example, and there it is. Of - [Plutus builtin functions and types](https://playground.plutus.iohkdev.io/doc/haddock//plutus-tx/html/PlutusTx-Builtins-Internal.html) - [Plutus Core builtin function identifiers, aka `DefaultFun`](https://playground.plutus.iohkdev.io/doc/haddock/plutus-core/html/PlutusCore.html#t:DefaultFun) - [Plutus Core types, aka `DefaultUni`](https://playground.plutus.iohkdev.io/doc/haddock/plutus-core/html/PlutusCore.html#t:DefaultUni) + +# How to build docs + +To run the docs locally from the Git working copy (useful when editing them), + +```sh-session +nix run .#docs +``` + +To build the static HTML site, + +```sh-session +nix build .#website +``` + +To run the docs directly without cloning the Git repo, + +```sh-session +nix run github:Plutonomicon/plutarch#website +``` diff --git a/docs/Introduction/Plutarch Types.md b/docs/Introduction/Plutarch Types.md index 1656b54a6..f454581c1 100644 --- a/docs/Introduction/Plutarch Types.md +++ b/docs/Introduction/Plutarch Types.md @@ -2,7 +2,7 @@ When this guide uses the term "Plutarch Type" we explicitly talk about a type of _kind_ `PType`. We will refer to _" types of kind `PType` "_ simply as `PType`s. We explicitly qualify when referring to the _kind_ `PType`. -> Note to beginners: Plutarch uses a language extension called `DataKinds`. This means that there are kinds beyond `Type` (aka `*`). We refer the read to \[[3](./../Concepts.md#references)] for an extended beginner-level introduction to these concepts if desired. +> Note to beginners: Plutarch uses a language extension called `DataKinds`. This means that there are kinds beyond `Type` (aka `*`). We refer the read to \[[3](./../Introduction.md#references)] for an extended beginner-level introduction to these concepts if desired. `PType` is defined as `type PType = S -> Type`; that is, it is a _kind synonym_ for `S -> Type` (where `S` and `Type` are themselves kinds). This synonym is important to keep in mind because when querying the kind of something like `PBool` in, say, GHCi, we will _not_ see `PType` as the kind. Instead, we get diff --git a/docs/README.md b/docs/README.md index b08ec35fb..141a9ac04 100644 --- a/docs/README.md +++ b/docs/README.md @@ -53,6 +53,7 @@ The [Usage section](./Usage.md) fills in the gaps left by the previous. It illus - [Conditionals](./Usage/Conditionals.md) - [Recursion](./Usage/Recursion.md) +- [Using the Plutarch Prelude](./Usage/Prelude%20mixin.md) - [Do syntax with `TermCont`](./Usage/Do%20syntax%20with%20TermCont.md) - [Do syntax with `QualifiedDo` and `Plutarch.Monadic`](./Usage/Do%20syntax%20with%20QualifiedDo.md) - [Deriving typeclasses for `newtype`s](./Usage/Deriving%20for%20newtypes.md) @@ -61,6 +62,7 @@ The [Usage section](./Usage.md) fills in the gaps left by the previous. It illus - [Tracing](./Usage/Tracing.md) - [Raising errors](./Usage/Raising%20errors.md) - [Unsafe functions](./Usage/Unsafe%20functions.md) +- [Interoperability with PlutusTx](./Usage/FFI.md) ## Concepts @@ -94,6 +96,10 @@ The [Typeclasses section](./Typeclasses.md) discusses the primary typeclasses re - [Alternatives to `OverloadedRecordDot`](./Typeclasses/PIsDataRepr%20and%20PDataFields.md#alternatives-to-overloadedrecorddot) - [All about constructing data values](./Typeclasses/PIsDataRepr%20and%20PDataFields.md#all-about-constructing-data-values) - [Implementing `PIsDataRepr` and friends](./Typeclasses/PIsDataRepr%20and%20PDataFields.md#implementing-pisdatarepr-and-friends) +- [`PTryFrom`](./Typeclasses/PTryFrom.md) + - [Laws](./Typeclasses/PTryFrom.md#laws) + - [`PTryFromExcess`](./Typeclasses/PTryFrom.md#ptryfromexcess) + - [Recovering only partially](./Typeclasses/PTryFrom.md#recovering-only-partially) ## Working with Types @@ -137,6 +143,7 @@ Outside of the fundamental user guide, there are rules of thumb and general guid - [Prefer statically building constants whenever possible](./Tricks/Prefer%20statically%20building%20constants.md) - [Figuring out the representation of a Plutarch type](./Tricks/Representation%20of%20Plutarch%20type.md) - [Prefer pattern matching on the result of `pmatch` immediately](./Tricks/Prefer%20matching%20on%20pmatch%20result%20immediately.md) +- [Working with bound fields yielded by `pletFields`](./Tricks/Working%20with%20bound%20fields.md) # Common Issues and Troubleshooting @@ -145,11 +152,11 @@ Due to the highly abstracted nature of Plutarch and its utilization of advanced - [No instance for `PUnsafeLiftDecl a`](./Troubleshooting.md#no-instance-for-punsafeliftdecl-a) - [Couldn't match representation of type: ... arising from the 'deriving' clause](./Troubleshooting.md#couldnt-match-representation-of-type--arising-from-the-deriving-clause) - [Infinite loop / Infinite AST](./Troubleshooting.md#infinite-loop--infinite-ast) -- [Couldn't match type `Plutarch.DataRepr.Internal.PUnLabel ...` arising from a use of `pfield` (or `hrecField`, or `pletFields`)](./Troubleshooting.md#couldnt-match-type-plutarchdatareprinternalpunlabel--arising-from-a-use-of-pfield-or-hrecfield-or-pletfields) +- [Couldn't match type `Plutarch.DataRepr.Internal.PUnLabel ...` arising from a use of `pfield` (or `getField`, or `pletFields`)](./Troubleshooting.md#couldnt-match-type-plutarchdatareprinternalpunlabel--arising-from-a-use-of-pfield-or-getField-or-pletfields) - [Expected a type, but "fieldName" has kind `GHC.Types.Symbol`](./Troubleshooting.md#expected-a-type-but-fieldname-has-kind-ghctypessymbol) - [Lifting `PAsData`](./Troubleshooting.md#lifting-pasdata) - [Couldn't match type `PLifted (PConstanted Foo)` with `Foo`](./Troubleshooting.md#couldnt-match-type-plifted-pconstanted-foo-with-foo) -- [Type match errors when using `pfield`/`hrecField` (or `OverloadedRecordDot` to access field)](./Troubleshooting.md#type-match-errors-when-using-pfieldhrecfield-or-overloadedrecorddot-to-access-field) +- [Type match errors when using `pfield`/`getField` (or `OverloadedRecordDot` to access field)](./Troubleshooting.md#type-match-errors-when-using-pfieldgetField-or-overloadedrecorddot-to-access-field) # Useful Links diff --git a/docs/Run.md b/docs/Run.md index e78231b83..57b97a5a4 100644 --- a/docs/Run.md +++ b/docs/Run.md @@ -82,29 +82,45 @@ You can compile a Plutarch term using `compile` (from `Plutarch` module), making I often use these helper functions to test Plutarch quickly: ```haskell -import Data.Text (Text) -import Plutarch.Evaluate (evaluateScript) -import Plutarch (ClosedTerm, compile) -import Plutus.V1.Ledger.Api (ExBudget) -import Plutus.V1.Ledger.Scripts (Script (unScript), ScriptError, applyArguments) +module Eval (evalT, evalSerialize, evalWithArgsT, evalWithArgsT') where + +import qualified Codec.CBOR.Write as Write +import Codec.Serialise (Serialise, encode) +import Data.Bifunctor (first) +import qualified Data.ByteString.Base16 as Base16 +import Data.Default (def) +import Data.Text (Text, pack) +import qualified Data.Text.Encoding as TE +import Plutarch (ClosedTerm, compile, defaultConfig) +import Plutarch.Evaluate (evalScript) +import PlutusLedgerApi.V1 (Data, ExBudget) +import PlutusLedgerApi.V1.Scripts (Script (unScript), applyArguments) import UntypedPlutusCore (DeBruijn, DefaultFun, DefaultUni, Program) -import PlutusTx (Data) -eval :: ClosedTerm a -> Either ScriptError (ExBudget, [Text], Program DeBruijn DefaultUni DefaultFun ()) -eval x = fmap (\(a, b, s) -> (a, b, unScript s)) . evaluateScript $ compile x - -evalWithArgs :: ClosedTerm a -> [Data] -> Either ScriptError (ExBudget, [Text], Program DeBruijn DefaultUni DefaultFun ()) -evalWithArgs x args = fmap (\(a, b, s) -> (a, b, unScript s)) . evaluateScript . flip applyArguments args $ compile x +evalSerialize :: ClosedTerm a -> Either Text Text +evalSerialize x = encodeSerialise . (\(a, _, _) -> a) <$> evalT x + where + encodeSerialise :: Serialise a => a -> Text + encodeSerialise = TE.decodeUtf8 . Base16.encode . Write.toStrictByteString . encode + +evalT :: ClosedTerm a -> Either Text (Script, ExBudget, [Text]) +evalT x = evalWithArgsT x [] + +evalWithArgsT :: ClosedTerm a -> [Data] -> Either Text (Script, ExBudget, [Text]) +evalWithArgsT x args = do + cmp <- compile def x + let (escr, budg, trc) = evalScript $ applyArguments cmp args + scr <- first (pack . show) escr + pure (scr, budg, trc) + +evalWithArgsT' :: ClosedTerm a -> [Data] -> Either Text (Program DeBruijn DefaultUni DefaultFun (), ExBudget, [Text]) +evalWithArgsT' x args = + (\(res, budg, trcs) -> (unScript res, budg, trcs)) + <$> evalWithArgsT x args ``` -The fields in the result triple correspond to execution budget (how much memory and CPU units were used), trace log, and script result - respectively. Often you're only interested in the script result, in that case you can use: - -```haskell -evalT :: ClosedTerm a -> Either ScriptError (Program DeBruijn DefaultUni DefaultFun ()) -evalT x = fmap (\(_, _, s) -> unScript s) . evaluateScript $ compile x - -evalWithArgsT :: ClosedTerm a -> [Data] -> Either ScriptError (Program DeBruijn DefaultUni DefaultFun ()) -evalWithArgsT x args = fmap (\(_, _, s) -> unScript s) . evaluateScript . flip applyArguments args $ compile x -``` +The fields in the result triple correspond to script result, execution budget (how much memory and CPU units were used), and trace log - respectively. +Of course if you're only interested in the result of the script evaluation, you can just ignore the exbudget and tracelog just like `evalSerialize` does. +`evalSerialize` is a function that you can use to quickly obtain a serialized script. > Note: You can pretty much ignore the UPLC types involved here. All it really means is that the result is a "UPLC program". When it's printed, it's pretty legible - especially for debugging purposes. Although not necessary to use Plutarch, you may find the [Plutonomicon UPLC guide](https://github.com/Plutonomicon/plutonomicon/blob/main/uplc.md) useful. diff --git a/docs/Tricks.md b/docs/Tricks.md index 89af470f2..2afabf2cd 100644 --- a/docs/Tricks.md +++ b/docs/Tricks.md @@ -13,3 +13,4 @@ This document discusses various rules of thumb and general trivia, aiming to mak - [Prefer statically building constants whenever possible](./Tricks/Prefer%20statically%20building%20constants.md) - [Figuring out the representation of a Plutarch type](./Tricks/Representation%20of%20Plutarch%20type.md) - [Prefer pattern matching on the result of `pmatch` immediately](./Tricks/Prefer%20matching%20on%20pmatch%20result%20immediately.md) +- [Working with bound fields yielded by `pletFields`](./Tricks/Working%20with%20bound%20fields.md) diff --git a/docs/Tricks/Don't duplicate work.md b/docs/Tricks/Don't duplicate work.md index 6b7fb61e1..8294c4cdd 100644 --- a/docs/Tricks/Don't duplicate work.md +++ b/docs/Tricks/Don't duplicate work.md @@ -118,7 +118,7 @@ In general, `plet`ing something back-to-back several times will be optimized to You should also `plet` local bindings! In particular, if you applied a function (Plutarch level or Haskell level) to obtain a value, then bound that value to a variable e.g. with `let` or `where`, then avoid using it multiple times. The binding will simply get inlined as the function application - and it'll keep getting re-evaluated. You should `plet` it first! -This also applies to field accesses using `OverloadedRecordDot`. When you do `ctx.purpose`, it really gets translated to `hrecField @"purpose" ctx`, which is a function call! If you use the field multiple times, `plet` it first. +This also applies to field accesses using `OverloadedRecordDot`. When you do `ctx.purpose`, it really gets translated to `getField @"purpose" ctx`, which is a function call! If you use the field multiple times, `plet` it first. Another slightly obscure case can be observed in scott encoded types. When you build a scott encoded type using `pcon` - the Plutarch terms you use as fields are simply inlined within the scott encoded type. As such, `pcon $ PPair ` ends up like: diff --git a/docs/Tricks/Working with bound fields.md b/docs/Tricks/Working with bound fields.md new file mode 100644 index 000000000..99f2b1f12 --- /dev/null +++ b/docs/Tricks/Working with bound fields.md @@ -0,0 +1,77 @@ +# Working with bound fields yielded by `pletFields` + +You may have noticed that `pletFields` actually returns a Haskell level heterogenous list, with all the interesting fields "bound" to it. Only the fields you actually use from these bindings are extracted and put into the resulting script. Therefore, you _only pay for what you use_. + +```hs +pletFields :: + forall fs a s b ps bs. + ( PDataFields a + , ps ~ (PFields a) + , bs ~ (Bindings ps fs) + , BindFields ps bs + ) => + Term s a -> + (HRecOf a fs s -> Term s b) -> + Term s b +``` + +The real juice of that massive type is the `HRecOf`, which is a utility type alias you can use in functions that operate on the return value of `pletFields`: + +```hs +import qualified GHC.Generics as GHC +import Generics.SOP + +import Plutarch.Prelude +import Plutarch.DataRepr + +newtype PFooType s = PFooType (Term s (PDataRecord '["frst" ':= PInteger, "scnd" ':= PBool, "thrd" ':= PString])) + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData, PDataFields, PEq) + via PIsDataReprInstances PFooType + +foo :: HRecOf PFooType '["scnd", "frst"] s -> Term s PInteger +foo h = pif (getField @"scnd" h) (getField @"frst" h) 0 +``` + +This is very useful for single use functions that you use as "branches" in your validators - they work more like macros or templates rather than real functions. For example, you might have different branches for different constructors of a redeemer, but all branches end up needing to do common field extraction. You could abstract it out using: + +```hs +firstRedmCheck :: HRecOf PTxInfo '["inputs", "outputs", "mint", "datums"] s -> TermCont s (Term s PUnit) +firstRedmCheck info = do + -- Do checks with info fields here. + pure $ pconstant () + +secondRedmCheck : HRecOf PTxInfo '["inputs", "outputs", "mint", "datums"] s -> TermCont s (Term s PUnit) +secondRedmCheck info = do + -- Do checks with info fields here. + pure $ pconstant () + +coreValidator = plam $ \_ redm ctx' -> unTermCont $ do + ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx' + info <- tcont $ pletFields @'["inputs", "outputs", "mint", "datums"] $ getField @"txInfo" ctx + pmatchC redm >>= \case + FirstRedm _ -> firstRedmCheck info + SecondRedm _ -> secondRedmCheck info +``` + +Without it, you may have to fallback to deconstructing `info` with `pletFields` in every single branch. + +However, this is rather _nominal_. What if you don't need the exact same fields in all branches? Let's go back to the example with `foo` and `FooType`. What if someone has: + +```hs +fooTypeHrec <- tcont $ pletFields @'["frst", "scnd", "thrd"] fooTypeValue +foo fooTypeHrec +-- uh oh +``` + +The type required by `foo` should _morally_ work just fine with `fooTypeHrec`, but it won't! What we really want, is some sort of row polymorphism. This is where the `PMemberFields` type from `Plutarch.DataRepr` comes in: + +```hs +foo :: PMemberFields PFooType '["scnd", "frst"] s as => HRec as -> Term s PInteger +foo h = pif (getField @"scnd" h) (getField @"frst" h) 0 +``` + +Now `foo` merely requires the `HRec` to have the `"scnd"` and `"frst"` fields from `PFooType`, more fields are allowed just fine! diff --git a/docs/Tricks/makeIsDataIndexed, Haskell ADTs, and PIsDataRepr.md b/docs/Tricks/makeIsDataIndexed, Haskell ADTs, and PIsDataRepr.md index 27f7b4dc7..badaa4608 100644 --- a/docs/Tricks/makeIsDataIndexed, Haskell ADTs, and PIsDataRepr.md +++ b/docs/Tricks/makeIsDataIndexed, Haskell ADTs, and PIsDataRepr.md @@ -44,7 +44,7 @@ newtype PTxInfo (s :: S) , "wdrl" ':= PBuiltinList (PAsData (PTuple PStakingCredential PInteger)) , "validRange" ':= PPOSIXTimeRange , "signatories" ':= PBuiltinList (PAsData PPubKeyHash) - , "data" ':= PBuiltinList (PAsData (PTuple PDatumHash PDatum)) + , "datums" ':= PBuiltinList (PAsData (PTuple PDatumHash PDatum)) , "id" ':= PTxId ] ) diff --git a/docs/Troubleshooting.md b/docs/Troubleshooting.md index 1a055555c..27084fb61 100644 --- a/docs/Troubleshooting.md +++ b/docs/Troubleshooting.md @@ -6,11 +6,11 @@ - [No instance for `PUnsafeLiftDecl a`](#no-instance-for-punsafeliftdecl-a) - [Couldn't match representation of type: ... arising from the 'deriving' clause](#couldnt-match-representation-of-type--arising-from-the-deriving-clause) - [Infinite loop / Infinite AST](#infinite-loop--infinite-ast) -- [Couldn't match type `Plutarch.DataRepr.Internal.PUnLabel ...` arising from a use of `pfield` (or `hrecField`, or `pletFields`)](#couldnt-match-type-plutarchdatareprinternalpunlabel--arising-from-a-use-of-pfield-or-hrecfield-or-pletfields) +- [Couldn't match type `Plutarch.DataRepr.Internal.PUnLabel ...` arising from a use of `pfield` (or `getField`, or `pletFields`)](#couldnt-match-type-plutarchdatareprinternalpunlabel--arising-from-a-use-of-pfield-or-getfield-or-pletfields) - [Expected a type, but "fieldName" has kind `GHC.Types.Symbol`](#expected-a-type-but-fieldname-has-kind-ghctypessymbol) - [Lifting `PAsData`](#lifting-pasdata) - [Couldn't match type `PLifted (PConstanted Foo)` with `Foo`](#couldnt-match-type-plifted-pconstanted-foo-with-foo) -- [Type match errors when using `pfield`/`hrecField` (or `OverloadedRecordDot` to access field)](#type-match-errors-when-using-pfieldhrecfield-or-overloadedrecorddot-to-access-field) +- [Type match errors when using `pfield`/`getField` (or `OverloadedRecordDot` to access field)](#type-match-errors-when-using-pfieldgetfield-or-overloadedrecorddot-to-access-field) @@ -44,15 +44,15 @@ f = phoistAcyclic $ plam $ \n -> The issue here is that the AST is infinitely large. Plutarch will try to traverse this AST and will in the process not terminate, as there is no end to it. In these cases, consider using `pfix`. -Relevant issue: [#19](https://github.com/Plutonomicon/plutarch/issues/19) +Relevant issue: [\#19](https://github.com/Plutonomicon/plutarch/issues/19) -# Couldn't match type `Plutarch.DataRepr.Internal.PUnLabel ...` arising from a use of `pfield` (or `hrecField`, or `pletFields`) +# Couldn't match type `Plutarch.DataRepr.Internal.PUnLabel ...` arising from a use of `pfield` (or `getField`, or `pletFields`) -You might get some weird errors when using `pfield`/`hrecField`/`pletFields` like the above. Don't be scared! It just means that the type application you used is incorrect. Specifically, the type application names a non-existent field. Re-check the field name string you used in the type application for typos! +You might get some weird errors when using `pfield`/`getField`/`pletFields` like the above. Don't be scared! It just means that the type application you used is incorrect. Specifically, the type application names a non-existent field. Re-check the field name string you used in the type application for typos! # Expected a type, but "fieldName" has kind `GHC.Types.Symbol` -This just means the argument of a type application wasn't correctly promoted. Most likely arising from a usage of `pletFields`. In the case of `pfield` and `hrecField`, the argument of type application should have kind `Symbol`. A simple string literal representing the field name should work in this case. In the case of `pletFields`, the argument of type application should have kind `[Symbol]` - a type level list of types with kind `Symbol`. When you use a singleton list here, like `["foo"]` - it's actually parsed as a _regular_ list (like `[a]`). A regular list, of course, has kind `Type`. +This just means the argument of a type application wasn't correctly promoted. Most likely arising from a usage of `pletFields`. In the case of `pfield` and `getField`, the argument of type application should have kind `Symbol`. A simple string literal representing the field name should work in this case. In the case of `pletFields`, the argument of type application should have kind `[Symbol]` - a type level list of types with kind `Symbol`. When you use a singleton list here, like `["foo"]` - it's actually parsed as a _regular_ list (like `[a]`). A regular list, of course, has kind `Type`. All you need to do, is put a `'` (quote) infront of the list, like so- `@'["foo"]`. This will promote the `[a]` to the type level. @@ -68,12 +68,12 @@ Orphan instances! Specifically, in order for those type family applications to f This happens often with Plutarch ledger API types. If you didn't import `Plutarch.Api.V1.Contexts` (or some other module that imports it), and you're using `pconstant` on a `ScriptContext` - you'll get an error like this. The `PConstant` instance for `ScriptContext` hasn't been imported - so GHC has no idea what `PConstanted ScriptContext` is! -Relevant issue: [#252](https://github.com/Plutonomicon/plutarch/issues/252) +Relevant issue: [\#252](https://github.com/Plutonomicon/plutarch/issues/252) -# Type match errors when using `pfield`/`hrecField` (or `OverloadedRecordDot` to access field) +# Type match errors when using `pfield`/`getField` (or `OverloadedRecordDot` to access field) You might get nonsensical "Couldn't match type" errors when extracting fields. This has to do with GHC incorrectly inferring the return type. Field extraction is meant to be polymorphic in its return type in the sense that it might either return a `Term s (PAsData p)` term, or simply a `Term s p` (automatic `pfromData`). Unfortunately, sometimes this polymorphism makes it harder for GHC to infer the types. -You can fix this by providing an explicit type annotation on _the result_ of `pfield` or `hrecField` (or `OverloadedRecordDot` for field access). Otherwise, you can also explicitly use `pfromData` on the result. +You can fix this by providing an explicit type annotation on _the result_ of `pfield` or `getField` (or `OverloadedRecordDot` for field access). Otherwise, you can also explicitly use `pfromData` on the result. -Relevant issue: [#275](https://github.com/Plutonomicon/plutarch/issues/275) +Relevant issue: [\#275](https://github.com/Plutonomicon/plutarch/issues/275) diff --git a/docs/Typeclasses.md b/docs/Typeclasses.md index 627ac970b..97c9e528f 100644 --- a/docs/Typeclasses.md +++ b/docs/Typeclasses.md @@ -18,3 +18,7 @@ This section describes the primary typeclasses used in Plutarch. - [Alternatives to `OverloadedRecordDot`](./Typeclasses/PIsDataRepr%20and%20PDataFields.md#alternatives-to-overloadedrecorddot) - [All about constructing data values](./Typeclasses/PIsDataRepr%20and%20PDataFields.md#all-about-constructing-data-values) - [Implementing `PIsDataRepr` and friends](./Typeclasses/PIsDataRepr%20and%20PDataFields.md#implementing-pisdatarepr-and-friends) +- [`PTryFrom`](./Typeclasses/PTryFrom.md) + - [Laws](./Typeclasses/PTryFrom.md#laws) + - [`PTryFromExcess`](./Typeclasses/PTryFrom.md#ptryfromexcess) + - [Recovering only partially](./Typeclasses/PTryFrom.md#recovering-only-partially) diff --git a/docs/Typeclasses/PConstant and PLift.md b/docs/Typeclasses/PConstant and PLift.md index 9569ea5b2..d2af3625f 100644 --- a/docs/Typeclasses/PConstant and PLift.md +++ b/docs/Typeclasses/PConstant and PLift.md @@ -65,13 +65,15 @@ This comes in three flavors: Ex: `PScriptPurpose` is represented as a `Data` value. It is synonymous to `ScriptPurpose` from the Plutus ledger api. -Whichever path you need to go down, there is one common part- implementing `PLift`, or rather `PUnsafeLiftDecl`. See, `PLift` is actually just a type synonym to `PUnsafeLiftDecl`. Essentially an empty typeclass with an associated type family that provides insight on the relationship between a Plutarch type and its Haskell synonym. +Whichever path you need to go down, there is one common part- implementing `PLift`, or rather `PUnsafeLiftDecl`. See, `PLift` is actually just a type synonym to `PUnsafeLiftDecl` (with a bit more machinery). Essentially an empty typeclass with an associated type family that provides insight on the relationship between a Plutarch type and its Haskell synonym. ```hs instance PUnsafeLiftDecl YourPlutarchType where type PLifted YourPlutarchType = YourHaskellType ``` +In fact, `PConstant` is _also_ a type synonym. The actual typeclass you'll be implementing is `PConstantDecl`. + You're tasked with assigning the correct Haskell synonym to your Plutarch type, and what an important task it is! Recall that `pconstant`'s argument type will depend on your assignment here. In particular: `pconstant :: YourHaskellType -> YourPlutarchType`. Some examples: @@ -97,10 +99,10 @@ Now, let's get to implementing `PConstant` for the Haskell synonym, via the thre ```hs {-# LANGUAGE UndecidableInstances #-} -import Plutarch.Lift (DerivePConstantDirect (DerivePConstantDirect)) +import Plutarch.Lift (DerivePConstantDirect (DerivePConstantDirect), PConstantDecl, PUnsafeLiftDecl) import Plutarch.Prelude -deriving via (DerivePConstantDirect Integer PInteger) instance (PConstant Integer) +deriving via (DerivePConstantDirect Integer PInteger) instance PConstantDecl Integer ``` `DerivePConstantDirect` takes in two type parameters: @@ -113,7 +115,7 @@ Pretty simple! Let's check out `DerivePConstantViaNewtype` now: ```hs {-# LANGUAGE UndecidableInstances #-} -import Plutarch.Lift (DerivePConstantViaNewtype (DerivePConstantViaNewtype)) +import Plutarch.Lift (DerivePConstantViaNewtype (DerivePConstantViaNewtype), PConstantDecl, PUnsafeLiftDecl) import Plutarch.Prelude import qualified Plutus.V1.Ledger.Api as Plutus @@ -122,7 +124,8 @@ newtype PValidatorHash (s :: S) = PValidatorHash (Term s PByteString) ... -deriving via (DerivePConstantViaNewtype Plutus.ValidatorHash PValidatorHash PByteString) instance (PConstant Plutus.ValidatorHash) +deriving via (DerivePConstantViaNewtype Plutus.ValidatorHash PValidatorHash PByteString) + instance PConstantDecl Plutus.ValidatorHash ``` `DerivePConstantViaNewtype` takes in three type parameters: @@ -140,6 +143,7 @@ Finally, we have `DerivePConstantViaData` for `Data` values: {-# LANGUAGE UndecidableInstances #-} import Plutarch.DataRepr (DerivePConstantViaData (DerivePConstantViaData)) +import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl) import Plutarch.Prelude import qualified Plutus.V1.Ledger.Api as Plutus @@ -152,7 +156,8 @@ data PScriptPurpose (s :: S) ... -deriving via (DerivePConstantViaData Plutus.ScriptPurpose PScriptPurpose) instance (PConstant Plutus.ScriptPurpose) +deriving via (DerivePConstantViaData Plutus.ScriptPurpose PScriptPurpose) + instance PConstantDecl Plutus.ScriptPurpose ``` `DerivePConstantViaData` takes in two type parameters: @@ -163,25 +168,23 @@ deriving via (DerivePConstantViaData Plutus.ScriptPurpose PScriptPurpose) instan ## Implementing `PConstant` & `PLift` for types with type variables (generic types) -If your Plutarch type and its Haskell synonym are generic types (e.g. `PMaybeData a`) - the implementation gets a tad more difficult. In particular, you need to constrain the generic type variables to be able to use the derivers. +If your Plutarch type and its Haskell synonym are generic types (e.g. `PMaybeData a`) - the implementation gets a tad more difficult. In particular, you need to constrain the generic type variables to also have the relevant instance. The constraints observed when implementing `PLift`: - Each type variable must also have a `PLift` instance. -- For each type variable `a`: `a ~ PConstanted (PLifted a)` -- Depending on the data declaration, your type variable `PLifted a`, for each `a`, might also need [`FromData`](https://playground.plutus.iohkdev.io/doc/haddock/plutus-tx/html/PlutusTx.html#t:FromData) and [`ToData`](https://playground.plutus.iohkdev.io/doc/haddock/plutus-tx/html/PlutusTx.html#t:ToData) instances. The constraints observed when implementing `PConstant`: - Each type variable must also have a `PConstant` instance. -- For each type variable `a`: `a ~ PLifted (PConstanted a)` -- Depending on the data declaration, each type variable `a` might also need [`FromData`](https://playground.plutus.iohkdev.io/doc/haddock/plutus-tx/html/PlutusTx.html#t:FromData) and [`ToData`](https://playground.plutus.iohkdev.io/doc/haddock/plutus-tx/html/PlutusTx.html#t:ToData) instances. + +If you're using `DerivePConstantViaData`, you should use the `PLiftData` and `PConstantData` constraints instead respectively. Here's how you'd set up all this for `PMaybeData a`: ```hs import Plutarch.DataRepr (DerivePConstantViaData (DerivePConstantViaData)) -import Plutarch.Lift (PUnsafeLiftDecl) +import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl) import Plutarch.Prelude import PlutusTx (FromData, ToData) @@ -190,14 +193,7 @@ data PMaybeData a (s :: S) = PDJust (Term s (PDataRecord '["_0" ':= a])) | PDNothing (Term s (PDataRecord '[])) -instance - ( PLift p - , p ~ PConstanted (PLifted p) - , FromData (PLifted p) - , ToData (PLifted p) - ) => - PUnsafeLiftDecl (PMaybeData p) - where +instance PLiftData p => PUnsafeLiftDecl (PMaybeData p) where type PLifted (PMaybeData p) = Maybe (PLifted p) deriving via @@ -205,13 +201,5 @@ deriving via (Maybe h) (PMaybeData (PConstanted h)) ) - instance - ( PConstant h - , h ~ PLifted (PConstanted h) - , FromData h - , ToData h - ) => - PConstant (Maybe h) + instance PConstantData h => PConstantDecl (Maybe h) ``` - -Relevant issue: [#286](https://github.com/Plutonomicon/plutarch/issues/286) diff --git a/docs/Typeclasses/PEq and POrd.md b/docs/Typeclasses/PEq and POrd.md index 4e9718266..f0322c945 100644 --- a/docs/Typeclasses/PEq and POrd.md +++ b/docs/Typeclasses/PEq and POrd.md @@ -32,3 +32,47 @@ pif (1 #< 7) "indeed" "what" ``` evaluates to `"indeed"` - of type `Term s PString`. + +For scott encoded types, you can easily derive `PEq` via generic deriving: + +```hs +import qualified GHC.Generics as GHC +import Generics.SOP + +import Plutarch.Prelude + +data PMaybe a s + = PNothing + | PJust (Term s a) + deriving stock (GHC.Generic) + deriving anyclass (Generic, PlutusType, PEq) +``` + +For data encoded types, you can derive `PEq` and `POrd` via `PIsDataReprInstances`: + +```hs +import qualified GHC.Generics as GHC +import Generics.SOP + +import Plutarch.Prelude +import Plutarch.DataRepr + +newtype PTriplet a s + = PTriplet + ( Term + s + ( PDataRecord + '[ "x" ':= a + , "y" ':= a + , "z" ':= a + ] + ) + ) + deriving stock (GHC.Generic) + deriving anyclass (Generic, PIsDataRepr) + deriving + (PlutusType, PIsData, PEq, POrd) + via (PIsDataReprInstances (PTriplet a)) +``` + +> Aside: `PEq` derivation for data encoded types uses "Data equality". It simply ensures the structure (as represented through [data encoding](../Concepts/Data%20and%20Scott%20encoding.md#data-encoding)) of both values are _exactly_ the same. It does not take into account any custom `PEq` instances for the individual fields within. diff --git a/docs/Typeclasses/PIsDataRepr and PDataFields.md b/docs/Typeclasses/PIsDataRepr and PDataFields.md index a4ee8cd6b..407ef1c93 100644 --- a/docs/Typeclasses/PIsDataRepr and PDataFields.md +++ b/docs/Typeclasses/PIsDataRepr and PDataFields.md @@ -16,7 +16,7 @@ import qualified Plutarch.Monadic as P foo :: Term s (PScriptContext :--> PString) foo = plam $ \ctx -> P.do - purpose <- pmatch pfield @"purpose" # ctx + purpose <- pmatch $ pfield @"purpose" # ctx case purpose of PMinting _ -> "It's minting!" PSpending _ -> "It's spending!" @@ -115,7 +115,7 @@ Once a type has a `PDataFields` instance, field extraction can be done with thes - `pletFields` - `pfield` -- `hrecField` (when not using `OverloadedRecordDot` or [record dot preprocessor](https://hackage.haskell.org/package/record-dot-preprocessor)) +- `getField` (when not using `OverloadedRecordDot` or [record dot preprocessor](https://hackage.haskell.org/package/record-dot-preprocessor)) Each has its own purpose. However, `pletFields` is arguably the most general purpose and most efficient. Whenever you need to extract several fields from the same variable, you should use `pletFields`: @@ -157,15 +157,15 @@ You can then access the fields on this `HRec` using `OverloadedRecordDot`. Next up is `pfield`. You should _only ever_ use this if you just want one field from a variable and no more. Its usage is simply `pfield @"fieldName" # variable`. You can, however, also use `pletFields` in this case (e.g. `pletFields @'["fieldName"] variable`). `pletFields` with a singular field has the same efficiency as `pfield`! -Finally, `hrecField` is merely there to supplement the lack of record dot syntax. See: [Alternative to `OverloadedRecordDot`](#alternatives-to-overloadedrecorddot). +Finally, `getField` is merely there to supplement the lack of record dot syntax. See: [Alternative to `OverloadedRecordDot`](#alternatives-to-overloadedrecorddot). -> Note: An important thing to realize is that `pfield` and `hrecField` (or overloaded record dot on `HRec`) are _return type polymorphic_. They can return both `PAsData Foo` or `Foo` terms, depending on the surrounding context. This is very useful in the case of `pmatch`, as `pmatch` doesn't work on `PAsData` terms. So you can simply write `pmatch $ pfield ...` and `pfield` will correctly choose to _unwrap_ the `PAsData` term. +> Note: An important thing to realize is that `pfield` and `getField` (or overloaded record dot on `HRec`) are _return type polymorphic_. They can return both `PAsData Foo` or `Foo` terms, depending on the surrounding context. This is very useful in the case of `pmatch`, as `pmatch` doesn't work on `PAsData` terms. So you can simply write `pmatch $ pfield ...` and `pfield` will correctly choose to _unwrap_ the `PAsData` term. ### Alternatives to `OverloadedRecordDot` If `OverloadedRecordDot` is not available, you can also try using the [record dot preprocessor plugin](https://hackage.haskell.org/package/record-dot-preprocessor). -If you don't want to use either, you can simply use `hrecField`. In fact, `ctx.purpose` above just translates to `hrecField @"purpose" ctx`. Nothing magical there! +If you don't want to use either, you can simply use `getField`. In fact, `ctx.purpose` above just translates to `getField @"purpose" ctx`. Nothing magical there! ## All about constructing data values @@ -247,13 +247,18 @@ Thus, you can use `PBuiltinList (PAsData PInteger)` as a field type, but not `PB > In this case, `PFourWheeler` is at the 0th index, `PTwoWheeler` is at the 1st index, and `PImmovableBox` is at the 3rd index. Thus, the corresponding `makeIsDataIndexed` usage should be: > > ```hs -> PlutusTx.makeIsDataIndexed ''FourWheeler [('FourWheeler,0),('TwoWheeler,1),('ImmovableBox,2)] +> PlutusTx.makeIsDataIndexed ''PVehicle [('FourWheeler,0),('TwoWheeler,1),('ImmovableBox,2)] > ``` > > Also see: [Isomorphism between Haskell ADTs and `PIsDataRepr`](./../Tricks/makeIsDataIndexed,%20Haskell%20ADTs,%20and%20PIsDataRepr.md) And you'd simply derive `PIsDataRepr` using generics. However, you **must** also derive `PIsData` and `PlutusType` using `PIsDataReprInstances`. For single constructor data types, you should also derive `PDataFields`. +Furthermore, you can also derive the following typeclasses via `PIsDataReprInstances`: + +- [`PEq`](./PEq%20and%20POrd.md) +- [`POrd`](./PEq%20and%20POrd.md) + Combine all that, and you have: ```hs diff --git a/docs/Typeclasses/PTryFrom.md b/docs/Typeclasses/PTryFrom.md new file mode 100644 index 000000000..2fd29798e --- /dev/null +++ b/docs/Typeclasses/PTryFrom.md @@ -0,0 +1,81 @@ +# `PTryFrom` + +```haskell +class PTryFrom (a :: PType) (b :: PType) where + type PTryFromExcess a b :: PType + ptryFrom :: forall s r. Term s a -> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r) -> Term s r +``` + +`PTryFrom` is a typeclass to prove equality between a type that in some way can't be trusted about its representation and another type that we want the untrusted type to be represented as. +`PTryFrom` proves the structure of the untrusted type and recovers it as the trusted, type which hence also carries more information. + +A good example is getting a `PData` from a redeemer and wanting to prove that it is of a certain kind, e.g. a `PAsData (PBuiltinList (PAsData PInteger))`. We could do this with: + +```haskell +recoverListFromPData opq = unTermCont $ fst <$> ptryFromData @(PAsData (PBuiltinList (PAsData PInteger)) opq +``` + +As you can see, it uses the utility function `ptryFromData @b`, which does the same as `ptryFrom @PData @b`. + +## Laws + +- the operation `ptryFrom` mustn't change the representation of the underlying data +- the operation `ptryFrom` must always prove the integrity of the whole target type + - example: + `ptryFrom @PData @(PAsData (PBuiltinList PData))` ssucceeds iff the underlying representation is a `BuiltinList` containing any `PData` +- all conversions are fallible, this happens if the representation doesn't match the expected type. +- the operation `ptryFrom @a @b` proves equality between the less expressive `PType` `a` and the more expressive `PType` `b`, hence the first + element of the resulting Tuple must always be wrapped in `PAsData` if the origin type was `PData` (see law 1) +- the result type `b` must always be safer than the origin type `a`, i.e. it must carry more information + +## `PTryFromExcess` + +An important note is, that `PTryFrom` carries a type `PTryFromExcess` which safes data that arose as "excess" during the act of verifying. For `PData (PAsData PSomething)` instances this most times +carries a `PSomething`, i.e. the type that has been proven equality for but without `PAsData` wrapper. In cases where this type is not useful, the excess type is just an empty `HRec`. + +In case of the recovered type being a record or anything that contains a record, the excess type is more interesting: +It contains an `HRec`, that has all the fields that have been recoverd and all *their* excess stored. If you recover a `PAsData (PDataRecord xs)` from `PData`, there is another field under the accessor `"unwrapped"` that contains the unwrapped record, which representation wise is just a `PBuiltinList +PData`, of course. + +Generally, when recovering a `PDataRecord`, the procedure is as follows + +```haskell +untrustedRecord :: Term s PData +untrustedRecord = + let rec :: Term s (PAsData (PDataRecord '["_0" ':= (PDataRecord '["_1" ':= PInteger])])) + rec = pdata $ pdcons # (pdata $ pdcons # pdata (pconstant 42) # pdnil) # pdnil + in pforgetData rec + +-- obviously, `untrustedRecord` would be what we get from our untrusted party + +theField :: Term s PInteger +theField = unTermCont $ do + (_, exc) <- tcont (ptryFromData @(PAsData (PDataRecord '["_0" ':= (PDataRecord '["_1" ':= PInteger])])) untrustedRecord) + pure $ exc._0._1 +``` + +Because the record excess stores the field already in its unwrapped form, you don't have to `pfromData` it again. + +If you don't use `OverloadedRecordDot`, there is an equivalent function `getExcessField` that does the same and works with type applications. + +## Recovering only partially + +In case we don't want to verify the whole structure but rather part of it (this can be a reasonable decision to lower the fees), we can just leave the part of the data that is not to be +verified a `PData` which serves as the base case: + +```haskell +recoverListPartially = ptryFrom @PData @(PAsData (PBuiltinList PData)) +``` + +This is especially important with something like `PDataSum` which simply cannot store the excess types over the barrier of `pmatch` because obviously, +you don't know the type of the excess before actually matching on it. The solution would be to recover an equivalent `PDataSum` whose constructors +contain `PData` and after having matched on those, recover the underlying record or whatever field you're interested in. If you're not interested +in the excess, you could of course also just recover the whole Sum without issue, in this case it won't be more expensive. + +Please be aware, that nuances can already make a performance difference, e.g. +- recovering `ptryFromData @(PAsData (PBuiltinList PData))` is cheaper than `ptryFromData @(PAsData (PBuiltinList (PAsData PDAta)))` because the latter + maps over no-ops, whereas the former just asserts that the `PData` indeed contains a `PBuiltinList`. +- If you only, say, need the head of a list, first recovering a `PAsData (PBuiltinList PData)` (don't forget to use the excess instead of using + `pfromData`), *then* using head and after that recovering the field in there will be cheaper than recovering the whole list with the target type and + using head on that. + diff --git a/docs/Usage.md b/docs/Usage.md index 231806d28..26383377a 100644 --- a/docs/Usage.md +++ b/docs/Usage.md @@ -4,6 +4,7 @@ This section describes various core Plutarch usage concepts. - [Conditionals](./Usage/Conditionals.md) - [Recursion](./Usage/Recursion.md) +- [Using the Plutarch Prelude](./Usage/Prelude%20mixin.md) - [Do syntax with `TermCont`](./Usage/Do%20syntax%20with%20TermCont.md) - [Do syntax with `QualifiedDo` and `Plutarch.Monadic`](./Usage/Do%20syntax%20with%20QualifiedDo.md) - [Deriving typeclasses for `newtype`s](./Usage/Deriving%20for%20newtypes.md) diff --git a/docs/Usage/Deriving with generics.md b/docs/Usage/Deriving with generics.md index bc02ca3d4..49694721b 100644 --- a/docs/Usage/Deriving with generics.md +++ b/docs/Usage/Deriving with generics.md @@ -22,3 +22,4 @@ Currently, generic deriving supports the following typeclasses: - [`PlutusType`](./../Typeclasses/PlutusType,%20PCon,%20and%20PMatch.md#implementing-plutustype-for-your-own-types-scott-encoding) (Scott encoding only) - [`PIsDataRepr`](./../Typeclasses/PIsDataRepr%20and%20PDataFields.md#implementing-pisdatarepr-and-friends) +- [`PEq`](./../Typeclasses/PEq%20and%20POrd.md) diff --git a/docs/Usage/FFI.md b/docs/Usage/FFI.md new file mode 100644 index 000000000..4e6e113c4 --- /dev/null +++ b/docs/Usage/FFI.md @@ -0,0 +1,93 @@ +# Interoperability with PlutusTx + +If you already have a codebase built using PlutusTx, you can choose to +re-write only its critical parts in Plutarch and to call them from +PlutusTx. The function to use is `Plutarch.FFI.foreignExport`: + +```haskell +doubleInPlutarch :: Term s (PInteger :--> PInteger) +doubleInPlutarch = plam (2 *) + +doubleExported :: PlutusTx.CompiledCode (Integer -> Integer) +doubleExported = foreignExport doubleInPlutarch + +doubleUseInPlutusTx :: PlutusTx.CompiledCode Integer +doubleUseInPlutusTx = doubleExported `PlutusTx.applyCode` PlutusTx.liftCode 21 +``` + +Alternatively, you may go in the opposite direction and call an existing +PlutusTx function from Plutarch using `Plutarch.FFI.foreignImport`: + +```haskell +doubleInPlutusTx :: CompiledCode (Integer -> Integer) +doubleInPlutusTx = $$(PlutusTx.compile [||(2 *) :: Integer -> Integer||]) + +doubleImported :: Term s (PInteger :--> PInteger) +doubleImported = foreignImport doubleInPlutusTx + +doubleUseInPlutarch :: Term s PInteger +doubleUseInPlutarch = doubleImported # 21 +``` + +Note how Plutarch type `PInteger :--> PInteger` corresponds to Haskell +function type `Integer -> Integer`. If the types didn't corespond, the +`foreignExport` and `foreignImport` applications wouldn't compile. The +following table shows the correspondence between the two universes of types: + +| Plutarch | Haskell | +| -------------- | ------------------- | +| `pa :--> pb` | `a -> b` | +| `PTxList pa` | `[a]` | +| `PTxMaybe pa` | `Maybe a` | +| `PInteger` | `Integer` | +| `PBool` | `BuiltinBool` | +| `PString` | `BuiltinString` | +| `PByteString` | `BuiltinByteString` | +| `PBuiltinData` | `Data` | +| `PUnit` | `BuiltinUnit` | +| `PDelayed pa` | `Delayed a` | + +## User-defined types + +When it comes to user-defined types, you have a choice of passing their values +encoded as `Data` or directly. In the latter case, you'll have to declare your +type twice with two kinds: as a Haskell `Type` and as a Plutarch +`PType`. Futhermore, both types must be instances of `SOP.Generic`, as in this +example: + +```haskell +data SampleRecord = SampleRecord + { sampleBool :: BuiltinBool + , sampleInt :: Integer + , sampleString :: BuiltinString + } + deriving stock (Generic) + deriving anyclass (SOP.Generic) + +data PSampleRecord (s :: S) = PSampleRecord + { psampleBool :: Term s PBool + , psampleInt :: Term s PInteger + , psampleString :: Term s PString + } + deriving stock (Generic) + deriving anyclass (SOP.Generic, PlutusType) +``` + +With these two declarations in place, the preceding table can gain another +row: + +| Plutarch | Haskell | +| ----------------------- | -------------------- | +| `PDelayed PSampleRecord` | `SampleRecord` | + +The reason for `PDelayed` above is a slight difference in Scott encodings of +data types between Plutarch and PlutusTx. It means you'll need to apply +`pdelay` to a `PSampleRecord` value before passing it through FFI to Haskell, +and `pforce` after passing it in the opposite direction. + +This technique can be used for most data types, but it doesn't cover recursive +types (such as lists) nor data types with nullary constructors (such as +`Maybe`). To interface with these two common Haskell types, use `PTxMaybe` and +`PTxList` types from `Plutarch.FFI`. The module also exports the means to +convert between these special purpose types and the regular Plutarch `PMaybe` +and `PList`. diff --git a/docs/Usage/Prelude mixin.md b/docs/Usage/Prelude mixin.md new file mode 100644 index 000000000..abcca065d --- /dev/null +++ b/docs/Usage/Prelude mixin.md @@ -0,0 +1,12 @@ +# Using the Plutarch Prelude + +Plutarch exports a Prelude (`Plutarch.Prelude`) that contains the most commonly used Plutarch functions, types and constructors. + +The Plutarch Prelude `Plutarch.Prelude` has no overlap with `base` Prelude, which is the reason why you can use both of them together +without trouble. If you want to avoid importing `Plutarch.Prelude` in each of your modules, add the following to your `*.cabal` file: + +```haskell +mixins: + base hiding (Prelude) + , plutarch-preludes (PPrelude as Prelude) +``` diff --git a/docs/index.md b/docs/index.md new file mode 100644 index 000000000..5a320541b --- /dev/null +++ b/docs/index.md @@ -0,0 +1,3 @@ +# Plutarch Guide + +See [[README]] diff --git a/docs/index.yaml b/docs/index.yaml new file mode 100644 index 000000000..964c3f6f5 --- /dev/null +++ b/docs/index.yaml @@ -0,0 +1,14 @@ +# Emanote settings +# +# For list of possible settings and their defaults, see: +# https://github.com/srid/emanote/blob/master/default/index.yaml + +template: + # Change this to 'pretty' to use URLs without .html suffix. + urlStrategy: direct + theme: green + +page: + siteTitle: Plutarch Guide + headHtml: | + diff --git a/examples/Examples/ConstrData.hs b/examples/Examples/ConstrData.hs deleted file mode 100644 index 5913600ba..000000000 --- a/examples/Examples/ConstrData.hs +++ /dev/null @@ -1,134 +0,0 @@ -{-# LANGUAGE UndecidableInstances #-} - -module Examples.ConstrData (tests) where - -import Data.String (fromString) -import qualified GHC.Generics as GHC -import Generics.SOP - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase) - -import Utils - -import Plutarch.Api.V1 -import Plutarch.DataRepr (PDataFields, PIsDataReprInstances (PIsDataReprInstances)) -import Plutarch.Prelude -import Plutarch.Unsafe (punsafeCoerce) - -import Plutus.V1.Ledger.Api -import qualified PlutusTx - -{- | - We can defined a data-type using PDataRecord, with labeled fields. - - With an appropriate instance of 'PIsDataRepr', we can automatically - derive 'PDataFields'. --} -newtype Triplet (a :: PType) (s :: S) - = Triplet - ( Term - s - ( PDataRecord - '[ "x" ':= a - , "y" ':= a - , "z" ':= a - ] - ) - ) - deriving stock (GHC.Generic) - deriving anyclass (Generic, PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via (PIsDataReprInstances (Triplet a)) - -data PVehicle (s :: S) - = PFourWheeler (Term s (PDataRecord '["_0" ':= PInteger, "_1" ':= PInteger, "_2" ':= PInteger, "_3" ':= PInteger])) - | PTwoWheeler (Term s (PDataRecord '["_0" ':= PInteger, "_1" ':= PInteger])) - | PImmovableBox (Term s (PDataRecord '[])) - deriving stock (GHC.Generic) - deriving anyclass (Generic, PIsDataRepr) - deriving - (PlutusType, PIsData) - via PIsDataReprInstances PVehicle - -data PEnumType (s :: S) - = PA (Term s (PDataRecord '[])) - | PB (Term s (PDataRecord '[])) - deriving stock (GHC.Generic) - deriving anyclass (Generic, PIsDataRepr) - deriving - (PlutusType, PIsData) - via PIsDataReprInstances PEnumType - -tests :: HasTester => TestTree -tests = - testGroup - "Data construction tests" - [ testCase "Sum of products construction" $ do - pcon - ( PFourWheeler $ - pdcons - # pconstantData 2 #$ pdcons - # pconstantData 5 #$ pdcons - # pconstantData 42 #$ pdcons - # pconstantData 0 - # pdnil - ) - `equal` punsafeCoerce - (pconstant $ PlutusTx.Constr 0 [PlutusTx.I 2, PlutusTx.I 5, PlutusTx.I 42, PlutusTx.I 0]) - pcon (PTwoWheeler $ pdcons # pconstantData 5 #$ pdcons # pconstantData 0 # pdnil) - `equal` punsafeCoerce - (pconstant $ PlutusTx.Constr 1 [PlutusTx.I 5, PlutusTx.I 0]) - pcon (PImmovableBox pdnil) - `equal` punsafeCoerce - (pconstant $ PlutusTx.Constr 2 []) - , testCase "Product construction" $ do - pcon - ( Triplet $ - pdcons - # pconstantData @PCurrencySymbol "ab" #$ pdcons - # pconstantData "41" #$ pdcons - # pconstantData "0e" - # pdnil - ) - `equal` punsafeCoerce - ( pconstant $ - PlutusTx.Constr - 0 - [ PlutusTx.toData @CurrencySymbol "ab" - , PlutusTx.toData @CurrencySymbol "41" - , PlutusTx.toData @CurrencySymbol "0e" - ] - ) - let minting = Minting "" - spending = Spending $ TxOutRef "ab" 0 - rewarding = Rewarding . StakingHash $ PubKeyCredential "da" - pcon - ( Triplet $ - pdcons - # pconstantData minting #$ pdcons - # pconstantData spending #$ pdcons - # pconstantData rewarding - # pdnil - ) - `equal` punsafeCoerce - ( pconstant $ - PlutusTx.Constr - 0 - [PlutusTx.toData minting, PlutusTx.toData spending, PlutusTx.toData rewarding] - ) - , testCase "Enumerable sum type construction" $ do - pcon (PA pdnil) `equal` punsafeCoerce (pconstant $ PlutusTx.Constr 0 []) - pcon (PB pdnil) `equal` punsafeCoerce (pconstant $ PlutusTx.Constr 1 []) - , testCase "Relation between pconstant and pcon" $ do - let valHash = "01" - addr = Address (ScriptCredential $ fromString valHash) Nothing - pscriptCredential :: Term s PCredential - pscriptCredential = - pcon $ - PScriptCredential $ - pdcons # pdata (pcon $ PValidatorHash $ phexByteStr valHash) # pdnil - pconstant addr - `equal` pcon (PAddress $ pdcons # pdata pscriptCredential #$ pdcons # pdata (pcon $ PDNothing pdnil) # pdnil) - ] diff --git a/examples/Examples/LetRec.hs b/examples/Examples/LetRec.hs deleted file mode 100644 index 3a839f2cc..000000000 --- a/examples/Examples/LetRec.hs +++ /dev/null @@ -1,410 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} - -module Examples.LetRec (tests) where - -import Plutarch (pcon', pmatch', printTerm) -import Plutarch.Builtin (pasConstr, pforgetData) -import Plutarch.Prelude -import Plutarch.Rec ( - DataReader (DataReader, readData), - DataWriter (DataWriter, writeData), - PRecord (PRecord), - RecordFromData, - ScottEncoded, - ScottEncoding, - field, - fieldFromData, - letrec, - rcon, - recordDataFromFieldWriters, - recordFromFieldReaders, - rmatch, - ) -import Plutarch.Rec.TH (deriveAll) -import Plutarch.Unsafe (punsafeCoerce, punsafeFrom) -import qualified Rank2.TH -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase, (@?=)) -import Utils -import Prelude hiding (even, odd) - -data FlatOuterRecord f = FlatOuterRecord - { flatOuterBool :: f PBool - , flatInner1 :: SampleRecord f - , flatOuterInt :: f PInteger - , flatInner2 :: SampleRecord f - , flatOuterString :: f PString - } - -data ShallowOuterRecord f = ShallowOuterRecord - { shallowOuterBool :: f PBool - , shallowInner1 :: f (PRecord SampleRecord) - , shallowOuterInt :: f PInteger - , shallowInner2 :: f (PRecord SampleRecord) - , shallowOuterString :: f PString - } - -data SampleRecord f = SampleRecord - { sampleBool :: f PBool - , sampleInt :: f PInteger - , sampleString :: f PString - } - -data EvenOdd f = EvenOdd - { even :: f (PInteger :--> PBool) - , odd :: f (PInteger :--> PBool) - } - -type instance ScottEncoded EvenOdd a = (PInteger :--> PBool) :--> (PInteger :--> PBool) :--> a - -$(Rank2.TH.deriveAll ''EvenOdd) -$(deriveAll ''SampleRecord) -- also autoderives the @type instance ScottEncoded@ -$(deriveAll ''FlatOuterRecord) -$(deriveAll ''ShallowOuterRecord) -instance RecordFromData SampleRecord -instance RecordFromData FlatOuterRecord -instance RecordFromData ShallowOuterRecord - -instance PIsData (PRecord SampleRecord) where - pfromData = readData (recordFromFieldReaders sampleReader) - pdata = writeData (recordDataFromFieldWriters sampleWriter) - -instance PIsData (PRecord FlatOuterRecord) where - pfromData = readData (recordFromFieldReaders flatOuterReader) - pdata = writeData (recordDataFromFieldWriters flatOuterWriter) - -instance PIsData (PRecord ShallowOuterRecord) where - pfromData = readData (recordFromFieldReaders shallowOuterReader) - pdata = writeData (recordDataFromFieldWriters shallowOuterWriter) - -sampleReader :: SampleRecord (DataReader s) -sampleReader = - SampleRecord - { sampleBool = DataReader pfromData - , sampleInt = DataReader pfromData - , sampleString = DataReader $ \d -> pdecodeUtf8 #$ pfromData $ punsafeCoerce d - } - -sampleWriter :: SampleRecord (DataWriter s) -sampleWriter = - SampleRecord - { sampleBool = DataWriter pdata - , sampleInt = DataWriter pdata - , sampleString = DataWriter $ \s -> punsafeCoerce $ pdata $ pencodeUtf8 # s - } - -flatOuterReader :: FlatOuterRecord (DataReader s) -flatOuterReader = - FlatOuterRecord - { flatOuterBool = DataReader pfromData - , flatInner1 = sampleReader - , flatOuterInt = DataReader pfromData - , flatInner2 = sampleReader - , flatOuterString = DataReader $ \d -> pdecodeUtf8 #$ pfromData $ punsafeCoerce d - } - -flatOuterWriter :: FlatOuterRecord (DataWriter s) -flatOuterWriter = - FlatOuterRecord - { flatOuterBool = DataWriter pdata - , flatInner1 = sampleWriter - , flatOuterInt = DataWriter pdata - , flatInner2 = sampleWriter - , flatOuterString = DataWriter $ \s -> punsafeCoerce $ pdata $ pencodeUtf8 # s - } - -shallowOuterReader :: ShallowOuterRecord (DataReader s) -shallowOuterReader = - ShallowOuterRecord - { shallowOuterBool = DataReader pfromData - , shallowInner1 = DataReader pfromData - , shallowOuterInt = DataReader pfromData - , shallowInner2 = DataReader pfromData - , shallowOuterString = DataReader $ \d -> pdecodeUtf8 #$ pfromData $ punsafeCoerce d - } - -shallowOuterWriter :: ShallowOuterRecord (DataWriter s) -shallowOuterWriter = - ShallowOuterRecord - { shallowOuterBool = DataWriter pdata - , shallowInner1 = DataWriter pdata - , shallowOuterInt = DataWriter pdata - , shallowInner2 = DataWriter pdata - , shallowOuterString = DataWriter $ \s -> punsafeCoerce $ pdata $ pencodeUtf8 # s - } - -sampleFlatOuter :: Term (s :: S) (ScottEncoding FlatOuterRecord (t :: PType)) -sampleFlatOuter = rcon rawFlatOuter - -rawFlatOuter :: FlatOuterRecord (Term s) -rawFlatOuter = - FlatOuterRecord - { flatOuterBool = pcon PFalse - , flatInner1 = rawRecord - , flatOuterInt = 4 - , flatInner2 = rawRecord {sampleInt = 9} - , flatOuterString = "Hola, Mundo!" - } - -sampleShallowOuter :: Term (s :: S) (ScottEncoding ShallowOuterRecord (t :: PType)) -sampleShallowOuter = rcon rawShallowOuter - -rawShallowOuter :: ShallowOuterRecord (Term s) -rawShallowOuter = - ShallowOuterRecord - { shallowOuterBool = pcon PFalse - , shallowInner1 = pcon $ PRecord rawRecord - , shallowOuterInt = 4 - , shallowInner2 = pcon $ PRecord rawRecord {sampleInt = 9} - , shallowOuterString = "Hola, Mundo!" - } - -sampleRecord :: Term (s :: S) (ScottEncoding SampleRecord (t :: PType)) -sampleRecord = rcon rawRecord - -sampleRecord' :: Term (s :: S) (ScottEncoding SampleRecord (t :: PType)) -sampleRecord' = pcon' $ PRecord rawRecord - -sampleRecord'' :: Term (s :: S) (PRecord SampleRecord :: PType) -sampleRecord'' = pcon $ PRecord rawRecord - -rawRecord :: SampleRecord (Term s) -rawRecord = - SampleRecord - { sampleBool = pcon PFalse - , sampleInt = 6 - , sampleString = "Salut, Monde!" - } - -sampleRecur :: Term (s :: S) (ScottEncoding SampleRecord (t :: PType)) -sampleRecur = - letrec $ - const - SampleRecord - { sampleBool = pcon PTrue - , sampleInt = 12 - , sampleString = "Hello, World!" - } - -evenOdd :: Term (s :: S) (ScottEncoding EvenOdd (t :: PType)) -evenOdd = letrec evenOddRecursion - where - evenOddRecursion :: EvenOdd (Term s) -> EvenOdd (Term s) - evenOddRecursion EvenOdd {even, odd} = - EvenOdd - { even = plam $ \n -> pif (n #== 0) (pcon PTrue) (odd #$ n - 1) - , odd = plam $ \n -> pif (n #== 0) (pcon PFalse) (even #$ n - 1) - } - -sampleData :: Term s (PAsData (PRecord SampleRecord)) -sampleData = pdata (punsafeFrom sampleRecord) - -flatOuterData :: Term s (PAsData (PRecord FlatOuterRecord)) -flatOuterData = pdata (punsafeFrom sampleFlatOuter) - -shallowOuterData :: Term s (PAsData (PRecord ShallowOuterRecord)) -shallowOuterData = pdata (punsafeFrom sampleShallowOuter) - -tests :: HasTester => TestTree -tests = - testGroup - "Records" - [ testGroup - "Simple" - [ testCase "record construction with pcon" $ - printTerm sampleRecord'' - @?= "(program 1.0.0 (\\i0 -> i1 False 6 \"Salut, Monde!\"))" - , testCase "record construction with pcon'" $ - printTerm sampleRecord' - @?= "(program 1.0.0 (\\i0 -> i1 False 6 \"Salut, Monde!\"))" - , testCase "record construction with rcon" $ - printTerm sampleRecord - @?= "(program 1.0.0 (\\i0 -> i1 False 6 \"Salut, Monde!\"))" - , testCase "field access term" $ - printTerm (sampleRecord' # field sampleInt) - @?= "(program 1.0.0 ((\\i0 -> i1 False 6 \"Salut, Monde!\") (\\i0 -> \\i0 -> \\i0 -> i2)))" - , testGroup "field value" $ - [ testCase "direct access" $ - equal' (sampleRecord # field sampleInt) "(program 1.0.0 6)" - , testCase "pmatch" $ - equal' (pmatch sampleRecord'' $ \(PRecord r) -> sampleString r) "(program 1.0.0 \"Salut, Monde!\")" - , testCase "pmatch'" $ - equal' (pmatch' sampleRecord $ \(PRecord r) -> sampleString r) "(program 1.0.0 \"Salut, Monde!\")" - , testCase "rmatch" $ - equal' (rmatch sampleRecord $ \SampleRecord {sampleString = s} -> s) "(program 1.0.0 \"Salut, Monde!\")" - ] - , testCase "record reconstruction with pcon" $ - printTerm (pmatch' sampleRecord' (pcon @(PRecord SampleRecord))) - @?= "(program 1.0.0 ((\\i0 -> i1 False 6 \"Salut, Monde!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> i1 i4 i3 i2)))" - , testCase "reconstructed field access" $ - equal' (pto (pmatch' sampleRecord' (pcon @(PRecord SampleRecord))) # field sampleInt) "(program 1.0.0 6)" - ] - , testGroup - "Letrec" - [ testCase "record" $ (printTerm $ sampleRecur # field sampleInt) @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i2 (\\i0 -> i2 i2 i1)) (\\i0 -> i2 (\\i0 -> i2 i2 i1))) (\\i0 -> \\i0 -> i1 True 12 \"Hello, World!\") (\\i0 -> \\i0 -> \\i0 -> i2)))" - , testCase "record field" $ equal' (sampleRecur # field sampleInt) "(program 1.0.0 12)" - , testCase "even" $ (printTerm $ evenOdd # field even) @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> i2 (\\i0 -> i2 i2 i1)) (\\i0 -> i2 (\\i0 -> i2 i2 i1))) (\\i0 -> \\i0 -> i1 (\\i0 -> force (i4 (equalsInteger i1 0) (delay True) (delay (i3 (\\i0 -> \\i0 -> i1) (subtractInteger i1 1))))) (\\i0 -> force (i4 (equalsInteger i1 0) (delay False) (delay (i3 i5 (subtractInteger i1 1)))))) i2) (force ifThenElse)) (\\i0 -> \\i0 -> i2)))" - , testCase "even 4" $ equal' (evenOdd # field even # (4 :: Term s PInteger)) "(program 1.0.0 True)" - , testCase "even 5" $ equal' (evenOdd # field even # (5 :: Term s PInteger)) "(program 1.0.0 False)" - ] - , testGroup - "flat nested" - [ testCase "record construction with rcon" $ - printTerm (sampleFlatOuter) - @?= "(program 1.0.0 ((\\i0 -> \\i0 -> i1 False False 6 i2 4 False 9 i2 \"Hola, Mundo!\") \"Salut, Monde!\"))" - , testCase "nested field access" $ - printTerm (sampleFlatOuter # field (sampleInt . flatInner2)) - @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i1 False False 6 i2 4 False 9 i2 \"Hola, Mundo!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> i3)) \"Salut, Monde!\"))" - , testGroup "nested field value" $ - [ testCase "direct access" $ - equal' (sampleFlatOuter # field (sampleInt . flatInner2)) "(program 1.0.0 9)" - , testCase "pmatch" $ - equal' (pmatch (pcon $ PRecord rawFlatOuter) $ \(PRecord r) -> sampleInt $ flatInner2 r) "(program 1.0.0 9)" - , testCase "pmatch'" $ - equal' (pmatch' sampleFlatOuter $ \(PRecord r) -> sampleString $ flatInner2 r) "(program 1.0.0 \"Salut, Monde!\")" - , testCase "rmatch" $ - equal' (rmatch sampleFlatOuter $ \FlatOuterRecord {flatInner2 = SampleRecord {sampleString = s}} -> s) "(program 1.0.0 \"Salut, Monde!\")" - ] - , testCase "reconstruct with pcon" $ - printTerm (pmatch' sampleFlatOuter (pcon @(PRecord FlatOuterRecord))) - @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i1 False False 6 i2 4 False 9 i2 \"Hola, Mundo!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> i1 i10 i9 i8 i7 i6 i5 i4 i3 i2)) \"Salut, Monde!\"))" - , testCase "reconstruction nested field value" $ - equal' (pto (pmatch' sampleFlatOuter (pcon @(PRecord FlatOuterRecord))) # field (sampleInt . flatInner2)) "(program 1.0.0 9)" - , testCase "nested record access term" $ - printTerm - ( pmatch' (rcon rawFlatOuter) $ - \(PRecord FlatOuterRecord {flatInner1}) -> pcon $ PRecord flatInner1 - ) - @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i1 False False 6 i2 4 False 9 i2 \"Hola, Mundo!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> i1 i9 i8 i7)) \"Salut, Monde!\"))" - , testCase "nested match term" $ - printTerm - ( rmatch (rcon rawFlatOuter) $ \(FlatOuterRecord {flatInner2}) -> - rmatch (rcon flatInner2) $ \(SampleRecord {sampleString}) -> - sampleString - ) - @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i1 False False 6 i2 4 False 9 i2 \"Hola, Mundo!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> (\\i0 -> i1 i5 i4 i3) (\\i0 -> \\i0 -> \\i0 -> i1))) \"Salut, Monde!\"))" - , testCase "nested match value" $ - equal' - ( rmatch (rcon rawFlatOuter) $ \(FlatOuterRecord {flatInner2}) -> - rmatch (rcon flatInner2) $ \(SampleRecord {sampleString}) -> - sampleString - ) - "(program 1.0.0 \"Salut, Monde!\")" - ] - , testGroup - "shallow nested" - [ testCase "record construction with rcon" $ - printTerm (sampleShallowOuter) - @?= "(program 1.0.0 ((\\i0 -> \\i0 -> i1 False (\\i0 -> i1 False 6 i3) 4 (\\i0 -> i1 False 9 i3) \"Hola, Mundo!\") \"Salut, Monde!\"))" - , testCase "nested field access" $ - printTerm (pto (sampleShallowOuter # field shallowInner2) # field sampleInt) - @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i1 False (\\i0 -> i1 False 6 i3) 4 (\\i0 -> i1 False 9 i3) \"Hola, Mundo!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> i2) (\\i0 -> \\i0 -> \\i0 -> i2)) \"Salut, Monde!\"))" - , testGroup "nested field value" $ - [ testCase "direct access" $ - equal' (pto (sampleShallowOuter # field shallowInner2) # field sampleInt) "(program 1.0.0 9)" - , testCase "pmatch" $ - equal' (pmatch (pcon $ PRecord rawShallowOuter) $ \(PRecord r) -> pto (shallowInner2 r) # field sampleInt) "(program 1.0.0 9)" - , testCase "pmatch'" $ - equal' (pmatch' sampleShallowOuter $ \(PRecord r) -> pto (shallowInner2 r) # field sampleString) "(program 1.0.0 \"Salut, Monde!\")" - , testCase "rmatch" $ - equal' (rmatch sampleShallowOuter $ \ShallowOuterRecord {shallowInner2 = inner} -> pto inner # field sampleString) "(program 1.0.0 \"Salut, Monde!\")" - ] - , testCase "reconstruct with pcon" $ - printTerm (pmatch' sampleShallowOuter (pcon @(PRecord ShallowOuterRecord))) - @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i1 False (\\i0 -> i1 False 6 i3) 4 (\\i0 -> i1 False 9 i3) \"Hola, Mundo!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> i1 i6 i5 i4 i3 i2)) \"Salut, Monde!\"))" - , testCase "reconstruction nested field value" $ - equal' (pto (pto (pmatch' sampleShallowOuter (pcon @(PRecord ShallowOuterRecord))) # field shallowInner2) # field sampleInt) "(program 1.0.0 9)" - , testCase "nested record access term" $ - printTerm (pmatch' sampleShallowOuter $ \(PRecord ShallowOuterRecord {shallowInner1}) -> shallowInner1) - @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i1 False (\\i0 -> i1 False 6 i3) 4 (\\i0 -> i1 False 9 i3) \"Hola, Mundo!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> i4)) \"Salut, Monde!\"))" - , testCase "nested match term" $ - printTerm - ( pmatch' sampleShallowOuter $ \(PRecord ShallowOuterRecord {shallowInner2}) -> - pmatch shallowInner2 $ \(PRecord SampleRecord {sampleString}) -> - sampleString - ) - @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> i1 False (\\i0 -> i1 False 6 i3) 4 (\\i0 -> i1 False 9 i3) \"Hola, Mundo!\") (\\i0 -> \\i0 -> \\i0 -> \\i0 -> \\i0 -> i2 (\\i0 -> \\i0 -> \\i0 -> i1))) \"Salut, Monde!\"))" - , testCase "nested match value" $ - equal' - ( pmatch' sampleShallowOuter $ \(PRecord ShallowOuterRecord {shallowInner2}) -> - pmatch shallowInner2 $ \(PRecord SampleRecord {sampleString}) -> - sampleString - ) - "(program 1.0.0 \"Salut, Monde!\")" - ] - , testGroup - "Data" - [ testGroup - "pdata" - [ testCase "simple" $ printTerm sampleData @?= "(program 1.0.0 ((\\i0 -> i1 False 6 \"Salut, Monde!\") (\\i0 -> \\i0 -> \\i0 -> constrData 0 (force mkCons (constrData (force ifThenElse i3 1 0) [ ]) (force mkCons (iData i2) (force mkCons (bData (encodeUtf8 i1)) [ ]))))))" - , testCase "simple value deconstructed" $ equal' (pasConstr # pforgetData sampleData) "(program 1.0.0 (0, [#d87980, #06, #4d53616c75742c204d6f6e646521]))" - , testCase "flat data deconstructed" $ - equal' - (pasConstr # pforgetData flatOuterData) - "(program 1.0.0 ( 0\n, [ #d87980\n , #d87980\n , #06\n , #4d53616c75742c204d6f6e646521\n , #04\n , #d87980\n , #09\n , #4d53616c75742c204d6f6e646521\n , #4c486f6c612c204d756e646f21 ] ))" - , testCase "shallow data deconstructed" $ - equal' - (pasConstr # pforgetData shallowOuterData) - "(program 1.0.0 ( 0\n, [ #d87980\n , #d8799fd87980064d53616c75742c204d6f6e646521ff\n , #04\n , #d8799fd87980094d53616c75742c204d6f6e646521ff\n , #4c486f6c612c204d756e646f21 ] ))" - ] - , testGroup - "fieldFromData term" - [ testCase "simple record" $ - (printTerm $ plam $ \dat -> plam pfromData #$ fieldFromData sampleInt # dat) - @?= result_fieldFromDataTerm'simpleRecord - , testCase "flat nested" $ - (printTerm $ plam $ \dat -> plam pfromData #$ fieldFromData (sampleInt . flatInner2) # dat) - @?= result_fieldFromDataTerm'flatNested - , testCase "shallow nested" $ - ( printTerm $ - plam $ \dat -> pto (plam pfromData #$ fieldFromData shallowInner2 # dat) # field sampleInt - ) - @?= result_fieldFromDataTerm'shallowNested - ] - , testGroup - "fieldFromData value" - [ testCase "simple" $ equal' (fieldFromData sampleInt # sampleData) "(program 1.0.0 #06)" - , testCase "flat nested" $ equal' (fieldFromData (sampleInt . flatInner2) # flatOuterData) "(program 1.0.0 #09)" - , testCase "shallow nested" $ equal' (fieldFromData sampleInt #$ fieldFromData shallowInner2 #$ shallowOuterData) "(program 1.0.0 #09)" - ] - , testCase "pfromData term" $ - (printTerm $ plam $ \d -> punsafeCoerce (pfromData d :: Term _ (PRecord SampleRecord)) # field sampleInt) - @?= result_fieldFromDataValue'shallowNested - ] - ] - --- CPP support isn't great in fourmolu. -{- ORMOLU_DISABLE -} - -result_fieldFromDataTerm'simpleRecord :: String -result_fieldFromDataTerm'simpleRecord = -#ifdef Development - "(program 1.0.0 (\\i0 -> unIData ((\\i0 -> force (force ifThenElse (equalsInteger (force (force fstPair) i1) 0) (delay (force headList (force tailList (force (force sndPair) i1)))) (delay (force (force trace \"verifySoleConstructor failed\" (delay error)))))) (unConstrData i1))))" -#else - "(program 1.0.0 (\\i0 -> unIData ((\\i0 -> force (force ifThenElse (equalsInteger (force (force fstPair) i1) 0) (delay (force headList (force tailList (force (force sndPair) i1)))) (delay error))) (unConstrData i1))))" -#endif - -result_fieldFromDataTerm'flatNested :: String -result_fieldFromDataTerm'flatNested = -#ifdef Development - "(program 1.0.0 ((\\i0 -> \\i0 -> unIData ((\\i0 -> force (force ifThenElse (equalsInteger (force (force fstPair) i1) 0) (delay (force headList (i3 (i3 (i3 (i3 (i3 (i3 (force (force sndPair) i1))))))))) (delay (force (force trace \"verifySoleConstructor failed\" (delay error)))))) (unConstrData i1))) (force tailList)))" -#else - "(program 1.0.0 ((\\i0 -> \\i0 -> unIData ((\\i0 -> force (force ifThenElse (equalsInteger (force (force fstPair) i1) 0) (delay (force headList (i3 (i3 (i3 (i3 (i3 (i3 (force (force sndPair) i1))))))))) (delay error))) (unConstrData i1))) (force tailList)))" -#endif - -result_fieldFromDataTerm'shallowNested :: String -result_fieldFromDataTerm'shallowNested = -#ifdef Development - "(program 1.0.0 ((\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> \\i0 -> (\\i0 -> (\\i0 -> force (i4 (equalsInteger (i5 i1) 0) (delay (\\i0 -> i1 ((\\i0 -> equalsInteger (i7 (unConstrData i1)) 1) (i7 (i9 i2))) (unIData (i7 (i8 (i9 i2)))) (decodeUtf8 (unBData (i7 (i8 (i8 (i9 i2)))))))) (delay (force (i9 i10 (delay error)))))) (unConstrData i1)) ((\\i0 -> force (i3 (equalsInteger (i4 i1) 0) (delay (i5 (i6 (i6 (i6 (i7 i1)))))) (delay (force (i8 i9 (delay error)))))) (unConstrData i1)) (\\i0 -> \\i0 -> \\i0 -> i2)) (force ifThenElse)) (force (force fstPair))) (force headList)) (force tailList)) (force (force sndPair))) (force trace)) \"verifySoleConstructor failed\"))" -#else - "(program 1.0.0 ((\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> \\i0 -> (\\i0 -> (\\i0 -> force (i4 (equalsInteger (i5 i1) 0) (delay (\\i0 -> i1 ((\\i0 -> equalsInteger (i7 (unConstrData i1)) 1) (i7 (i9 i2))) (unIData (i7 (i8 (i9 i2)))) (decodeUtf8 (unBData (i7 (i8 (i8 (i9 i2)))))))) (delay error))) (unConstrData i1)) ((\\i0 -> force (i3 (equalsInteger (i4 i1) 0) (delay (i5 (i6 (i6 (i6 (i7 i1)))))) (delay error))) (unConstrData i1)) (\\i0 -> \\i0 -> \\i0 -> i2)) (force ifThenElse)) (force (force fstPair))) (force headList)) (force tailList)) (force (force sndPair))))" -#endif - -result_fieldFromDataValue'shallowNested :: String -result_fieldFromDataValue'shallowNested = -#ifdef Development - "(program 1.0.0 ((\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> \\i0 -> (\\i0 -> force (force ifThenElse (equalsInteger (i3 i1) 0) (delay (\\i0 -> i1 ((\\i0 -> equalsInteger (i5 (unConstrData i1)) 1) (i5 (i7 i2))) (unIData (i5 (i6 (i7 i2)))) (decodeUtf8 (unBData (i5 (i6 (i6 (i7 i2)))))))) (delay (force (force trace \"verifySoleConstructor failed\" (delay error)))))) (unConstrData i1) (\\i0 -> \\i0 -> \\i0 -> i2)) (force (force fstPair))) (force headList)) (force tailList)) (force (force sndPair))))" -#else - "(program 1.0.0 ((\\i0 -> (\\i0 -> (\\i0 -> (\\i0 -> \\i0 -> (\\i0 -> force (force ifThenElse (equalsInteger (i3 i1) 0) (delay (\\i0 -> i1 ((\\i0 -> equalsInteger (i5 (unConstrData i1)) 1) (i5 (i7 i2))) (unIData (i5 (i6 (i7 i2)))) (decodeUtf8 (unBData (i5 (i6 (i6 (i7 i2)))))))) (delay error))) (unConstrData i1) (\\i0 -> \\i0 -> \\i0 -> i2)) (force (force fstPair))) (force headList)) (force tailList)) (force (force sndPair))))" -#endif diff --git a/examples/Examples/Lift.hs b/examples/Examples/Lift.hs deleted file mode 100644 index 847923125..000000000 --- a/examples/Examples/Lift.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Examples.Lift (tests) where - -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (Assertion, testCase, (@?=)) - -import Utils - -import Plutarch (printTerm) -import Plutarch.Api.V1 () -import Plutarch.Lift (PLifted) -import Plutarch.Prelude -import Plutus.V1.Ledger.Api -import qualified PlutusTx - -testPConstantDataSan :: forall p. (HasTester, PIsData p, PLift p, PlutusTx.ToData (PLifted p)) => PLifted p -> Assertion -testPConstantDataSan x = pconstantData @p x `equal` pdata (pconstant @p x) - -tests :: HasTester => TestTree -tests = testGroup "pconstant/plift tests" [pconstantDataTests] - -pconstantDataTests :: HasTester => TestTree -pconstantDataTests = - testGroup - "pconstantData" - [ testCase "pconstantData ≡ pdata . pconstant" $ do - testPConstantDataSan False - testPConstantDataSan @PInteger 42 - testPConstantDataSan $ PubKeyHash "04" - testPConstantDataSan $ Minting "" - testPConstantDataSan $ TxOutRef "41" 12 - , testCase "pconstantData compiled output" $ do - printTerm (pconstantData @PInteger 42) @?= "(program 1.0.0 #182a)" - printTerm (pconstantData True) @?= "(program 1.0.0 #d87a80)" - printTerm (pconstantData $ PubKeyHash "04") @?= "(program 1.0.0 #423034)" - printTerm (pconstantData $ Minting "") @?= "(program 1.0.0 #d8799f40ff)" - printTerm (pconstantData $ TxOutRef "41" 12) @?= "(program 1.0.0 #d8799fd8799f4141ff0cff)" - ] diff --git a/examples/Main.hs b/examples/Main.hs deleted file mode 100644 index 8b3641b42..000000000 --- a/examples/Main.hs +++ /dev/null @@ -1,212 +0,0 @@ -{-# LANGUAGE ImplicitParams #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -module Main (main) where - -import Test.Tasty -import Test.Tasty.HUnit - -import qualified Data.Aeson as Aeson -import Data.Maybe (fromJust) -import GHC.IO.Encoding (setLocaleEncoding, utf8) -import Plutarch (POpaque, popaque, printTerm) -import Plutarch.Api.V1 (PScriptPurpose (PMinting)) -import Plutarch.Internal (punsafeConstantInternal) -import Plutarch.Prelude -import Plutarch.Unsafe (punsafeBuiltin) -import Plutus.V1.Ledger.Value (CurrencySymbol (CurrencySymbol)) -import Plutus.V2.Ledger.Contexts (ScriptPurpose (Minting)) -import qualified PlutusCore as PLC -import qualified PlutusTx - -import qualified Examples.ConstrData as ConstrData -import qualified Examples.LetRec as LetRec -import qualified Examples.Lift as Lift -import Utils - -import Data.Text (Text) - -main :: IO () -main = do - setLocaleEncoding utf8 - defaultMain $ testGroup "all tests" [standardTests] -- , shrinkTests ] - --- FIXME: Make the below impossible using run-time checks. --- loop :: Term (PInteger :--> PInteger) --- loop = plam $ \x -> loop # x --- loopHoisted :: Term (PInteger :--> PInteger) --- loopHoisted = phoistAcyclic $ plam $ \x -> loop # x - --- _shrinkTests :: TestTree --- _shrinkTests = testGroup "shrink tests" [let ?tester = shrinkTester in tests] - -standardTests :: TestTree -standardTests = testGroup "standard tests" [let ?tester = standardTester in tests] - -tests :: HasTester => TestTree -tests = - testGroup - "unit tests" - [ plutarchTests - , uplcTests - , LetRec.tests - , ConstrData.tests - , Lift.tests - ] - -plutarchTests :: HasTester => TestTree -plutarchTests = - testGroup - "plutarch tests" - [ testCase "1 + 2 == 3" $ equal (pconstant @PInteger $ 1 + 2) (pconstant @PInteger 3) - , testCase "fails: perror" $ fails perror - , testGroup - "PlutusType scott encoding " - [ testCase "PMaybe" $ do - let a = 42 :: Term s PInteger - let x = pmatch (pcon $ PJust a) $ \case - PJust x -> x - -- We expect this perror not to be evaluated eagerly when mx - -- is a PJust. - PNothing -> perror - printTerm x @?= "(program 1.0.0 ((\\i0 -> \\i0 -> i2 42) (\\i0 -> i1) (delay error)))" - , testCase "PPair" $ do - let a = 42 :: Term s PInteger - b = "Universe" :: Term s PString - let x = pmatch (pcon (PPair a b) :: Term s (PPair PInteger PString)) $ \(PPair _ y) -> y - printTerm x @?= "(program 1.0.0 ((\\i0 -> i1 42 \"Universe\") (\\i0 -> \\i0 -> i1)))" - ] - , testCase "pconstant \"abc\" == \"abc\"" $ do - pconstant @PString "abc" `equal` pconstant @PString "abc" - expect $ pconstant @PString "foo" #== "foo" - , testCase "ScriptPurpose literal" $ - let d :: ScriptPurpose - d = Minting dummyCurrency - f :: Term s PScriptPurpose - f = pconstant @PScriptPurpose d - in printTerm f @?= "(program 1.0.0 #d8799f58201111111111111111111111111111111111111111111111111111111111111111ff)" - , testCase "decode ScriptPurpose" $ - let d :: ScriptPurpose - d = Minting dummyCurrency - d' :: Term s PScriptPurpose - d' = pconstant @PScriptPurpose d - f :: Term s POpaque - f = pmatch d' $ \case - PMinting c -> popaque c - _ -> perror - in printTerm f @?= "(program 1.0.0 ((\\i0 -> (\\i0 -> (\\i0 -> force (force ifThenElse (equalsInteger 0 i2) (delay i1) (delay error))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData #d8799f58201111111111111111111111111111111111111111111111111111111111111111ff)))" - , testCase "error # 1 => error" $ - printTerm (perror # (1 :: Term s PInteger)) @?= "(program 1.0.0 error)" - , -- TODO: Port this to pluatrch-test - -- , testCase "fib error => error" $ - -- printTerm (fib # perror) @?= "(program 1.0.0 error)" - testCase "force (delay 0) => 0" $ - printTerm (pforce . pdelay $ (0 :: Term s PInteger)) @?= "(program 1.0.0 0)" - , testCase "delay (force (delay 0)) => delay 0" $ - printTerm (pdelay . pforce . pdelay $ (0 :: Term s PInteger)) @?= "(program 1.0.0 (delay 0))" - , testCase "id # 0 => 0" $ - printTerm ((plam $ \x -> x) # (0 :: Term s PInteger)) @?= "(program 1.0.0 0)" - , testCase "hoist id 0 => 0" $ - printTerm ((phoistAcyclic $ plam $ \x -> x) # (0 :: Term s PInteger)) @?= "(program 1.0.0 0)" - , testCase "hoist fstPair => fstPair" $ - printTerm (phoistAcyclic (punsafeBuiltin PLC.FstPair)) @?= "(program 1.0.0 fstPair)" - , testCase "throws: hoist error" $ throws $ phoistAcyclic perror - , testCase "PData equality" $ do - expect $ let dat = pconstant @PData (PlutusTx.List [PlutusTx.Constr 1 [PlutusTx.I 0]]) in dat #== dat - expect $ pnot #$ pconstant @PData (PlutusTx.Constr 0 []) #== pconstant @PData (PlutusTx.I 42) - , testCase "PAsData equality" $ do - expect $ let dat = pdata @PInteger 42 in dat #== dat - expect $ pnot #$ pdata (phexByteStr "12") #== pdata (phexByteStr "ab") - , testGroup - "η-reduction optimisations" - [ testCase "λx y. addInteger x y => addInteger" $ - printTerm (plam $ \x y -> (x :: Term _ PInteger) + y) @?= "(program 1.0.0 addInteger)" - , testCase "λx y. hoist (force mkCons) x y => force mkCons" $ - printTerm (plam $ \x y -> (pforce $ punsafeBuiltin PLC.MkCons) # x # y) @?= "(program 1.0.0 (force mkCons))" - , testCase "λx y. hoist mkCons x y => mkCons x y" $ - printTerm (plam $ \x y -> (punsafeBuiltin PLC.MkCons) # x # y) @?= "(program 1.0.0 (\\i0 -> \\i0 -> mkCons i2 i1))" - , testCase "λx y. hoist (λx y. x + y - y - x) x y => λx y. x + y - y - x" $ - printTerm (plam $ \x y -> (phoistAcyclic $ plam $ \(x :: Term _ PInteger) y -> x + y - y - x) # x # y) @?= "(program 1.0.0 (\\i0 -> \\i0 -> subtractInteger (subtractInteger (addInteger i2 i1) i1) i2))" - , testCase "λx y. x + x" $ - printTerm (plam $ \(x :: Term _ PInteger) (_ :: Term _ PInteger) -> x + x) @?= "(program 1.0.0 (\\i0 -> \\i0 -> addInteger i2 i2))" - , testCase "let x = addInteger in x 1 1" $ - printTerm (plet (punsafeBuiltin PLC.AddInteger) $ \x -> x # (1 :: Term _ PInteger) # (1 :: Term _ PInteger)) @?= "(program 1.0.0 (addInteger 1 1))" - , testCase "let x = 0 in x => 0" $ - printTerm (plet 0 $ \(x :: Term _ PInteger) -> x) @?= "(program 1.0.0 0)" - , testCase "let x = hoist (λx. x + x) in 0 => 0" $ - printTerm (plet (phoistAcyclic $ plam $ \(x :: Term _ PInteger) -> x + x) $ \_ -> (0 :: Term _ PInteger)) @?= "(program 1.0.0 0)" - , testCase "let x = hoist (λx. x + x) in x" $ - printTerm (plet (phoistAcyclic $ plam $ \(x :: Term _ PInteger) -> x + x) $ \x -> x) @?= "(program 1.0.0 (\\i0 -> addInteger i1 i1))" - , testCase "λx y. sha2_256 x y =>!" $ - printTerm ((plam $ \x y -> punsafeBuiltin PLC.Sha2_256 # x # y)) @?= "(program 1.0.0 (\\i0 -> \\i0 -> sha2_256 i2 i1))" - , testCase "let f = hoist (λx. x) in λx y. f x y => λx y. x y" $ - printTerm ((plam $ \x y -> (phoistAcyclic $ plam $ \x -> x) # x # y)) @?= "(program 1.0.0 (\\i0 -> \\i0 -> i2 i1))" - , testCase "let f = hoist (λx. x True) in λx y. f x y => λx y. (λz. z True) x y" $ - printTerm ((plam $ \x y -> ((phoistAcyclic $ plam $ \x -> x # pcon PTrue)) # x # y)) @?= "(program 1.0.0 (\\i0 -> \\i0 -> i2 True i1))" - , testCase "λy. (λx. x + x) y" $ - printTerm (plam $ \y -> (plam $ \(x :: Term _ PInteger) -> x + x) # y) @?= "(program 1.0.0 (\\i0 -> addInteger i1 i1))" - ] - , testGroup - "Lifting of constants" - [ testCase "plift on primitive types" $ do - plift (pcon PTrue) @?= True - plift (pcon PFalse) @?= False - , testCase "pconstant on primitive types" $ do - plift (pconstant @PBool False) @?= False - plift (pconstant @PBool True) @?= True - , testCase "plift on list and pair" $ do - plift (pconstant ([1, 2, 3] :: [Integer])) @?= [1, 2, 3] - plift (pconstant ("IOHK" :: Text, 42 :: Integer)) @?= ("IOHK", 42) - , testCase "plift on data" $ do - let d :: PlutusTx.Data - d = PlutusTx.toData @(Either Bool Bool) $ Right False - plift (pconstant d) @?= d - , testCase "plift on nested containers" $ do - -- List of pairs - let v1 = [("IOHK", 42), ("Plutus", 31)] :: [(Text, Integer)] - plift (pconstant v1) @?= v1 - -- List of pair of lists - let v2 = [("IOHK", [1, 2, 3]), ("Plutus", [9, 8, 7])] :: [(Text, [Integer])] - plift (pconstant v2) @?= v2 - ] - ] - --- | Tests for the behaviour of UPLC itself. -uplcTests :: HasTester => TestTree -uplcTests = - testGroup - "uplc tests" - [ testCase "2:[1]" $ - let l :: Term _ (PBuiltinList PInteger) = - punsafeConstantInternal . PLC.Some $ - PLC.ValueOf (PLC.DefaultUniApply PLC.DefaultUniProtoList PLC.DefaultUniInteger) [1] - l' :: Term _ (PBuiltinList PInteger) = - pforce (punsafeBuiltin PLC.MkCons) # (2 :: Term _ PInteger) # l - in equal' l' "(program 1.0.0 [2,1])" - , testCase "fails: True:[1]" $ - let l :: Term _ (PBuiltinList POpaque) = - punsafeConstantInternal . PLC.Some $ - PLC.ValueOf (PLC.DefaultUniApply PLC.DefaultUniProtoList PLC.DefaultUniInteger) [1] - l' :: Term _ (PBuiltinList POpaque) = - pforce (punsafeBuiltin PLC.MkCons) # pcon PTrue # l - in fails l' - , testCase "(2,1)" $ - let p :: Term _ (PBuiltinPair PInteger PInteger) = - punsafeConstantInternal . PLC.Some $ - PLC.ValueOf - ( PLC.DefaultUniApply - (PLC.DefaultUniApply PLC.DefaultUniProtoPair PLC.DefaultUniInteger) - PLC.DefaultUniInteger - ) - (1, 2) - in equal' p "(program 1.0.0 (1, 2))" - , testCase "fails: MkPair 1 2" $ - let p :: Term _ (PBuiltinPair PInteger PInteger) = - punsafeBuiltin PLC.MkPairData # (1 :: Term _ PInteger) # (2 :: Term _ PInteger) - in fails p - ] - -dummyCurrency :: CurrencySymbol -dummyCurrency = - CurrencySymbol . fromJust . Aeson.decode $ - "\"1111111111111111111111111111111111111111111111111111111111111111\"" diff --git a/examples/Utils.hs b/examples/Utils.hs deleted file mode 100644 index 761bdc7d9..000000000 --- a/examples/Utils.hs +++ /dev/null @@ -1,195 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE ImplicitParams #-} - -module Utils ( - HasTester, - standardTester, - eval, - equal, - equalBudgeted, - equal', - fails, - expect, - throws, - traces, - succeeds, -) where - -import Control.Exception (SomeException, try) -import Data.Text (Text) -import Plutarch (ClosedTerm, compile, printScript) -import Plutarch.Evaluate (evaluateBudgetedScript, evaluateScript) -import Plutarch.Prelude -import qualified Plutus.V1.Ledger.Scripts as Scripts -import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (ExBudget)) -import qualified PlutusCore.Evaluation.Machine.ExMemory as ExMemory - --- import Shrink (shrinkScript) -import Test.Tasty.HUnit - -newtype EvalImpl = EvalImpl {runEvalImpl :: forall (a :: PType). HasCallStack => ClosedTerm a -> IO Scripts.Script} -newtype EqualImpl = EqualImpl {runEqualImpl :: forall (a :: PType) (b :: PType). HasCallStack => ClosedTerm a -> ClosedTerm b -> Assertion} -newtype Equal'Impl = Equal'Impl {runEqual'Impl :: forall (a :: PType). HasCallStack => ClosedTerm a -> String -> Assertion} -newtype FailsImpl = FailsImpl {runFailsImpl :: forall (a :: PType). HasCallStack => ClosedTerm a -> Assertion} -newtype ExpectImpl = ExpectImpl {runExpectImpl :: HasCallStack => ClosedTerm PBool -> Assertion} -newtype ThrowsImpl = ThrowsImpl {runThrowsImpl :: forall (a :: PType). ClosedTerm a -> Assertion} -newtype TracesImpl = TracesImpl {runTracesImpl :: forall (a :: PType). ClosedTerm a -> [Text] -> Assertion} -newtype SucceedsImpl = SucceedsImpl {runSucceedsImpl :: ClosedTerm PUnit -> Assertion} - -data Tester = Tester - { evalImpl :: EvalImpl - , equalImpl :: EqualImpl - , equal'Impl :: Equal'Impl - , failsImpl :: FailsImpl - , expectImpl :: ExpectImpl - , throwsImpl :: ThrowsImpl - , tracesImpl :: TracesImpl - , succeedsImpl :: SucceedsImpl - } - -type HasTester = (?tester :: Tester) - -eval' :: HasCallStack => Scripts.Script -> IO Scripts.Script -eval' s = case evaluateScript s of - Left e -> assertFailure $ "Script evaluation failed: " <> show e - Right (_, _, x') -> pure x' - -standardTester :: Tester -standardTester = - Tester - { evalImpl = EvalImpl evalImpl - , equalImpl = EqualImpl equalImpl - , equal'Impl = Equal'Impl equal'Impl - , failsImpl = FailsImpl failsImpl - , expectImpl = ExpectImpl expectImpl - , throwsImpl = ThrowsImpl throwsImpl - , tracesImpl = TracesImpl tracesImpl - , succeedsImpl = SucceedsImpl succeedsImpl - } - where - evalImpl :: HasCallStack => ClosedTerm a -> IO Scripts.Script - evalImpl x = eval' $ compile x - - equalImpl :: HasCallStack => ClosedTerm a -> ClosedTerm b -> Assertion - equalImpl x y = do - x' <- evalImpl x - y' <- evalImpl y - printScript x' @?= printScript y' - - equal'Impl :: HasCallStack => ClosedTerm a -> String -> Assertion - equal'Impl x y = do - x' <- evalImpl x - printScript x' @?= y - - failsImpl :: HasCallStack => ClosedTerm a -> Assertion - failsImpl x = - case evaluateScript $ compile x of - Left (Scripts.EvaluationError _ _) -> mempty - Left (Scripts.EvaluationException _ _) -> mempty - Left e -> assertFailure $ "Script is malformed: " <> show e - Right (_, _, s) -> assertFailure $ "Script didn't err: " <> printScript s - - expectImpl :: HasCallStack => ClosedTerm PBool -> Assertion - expectImpl = equalImpl (pcon PTrue :: Term s PBool) - - throwsImpl :: HasCallStack => ClosedTerm a -> Assertion - throwsImpl x = - try @SomeException (putStrLn $ printScript $ compile x) >>= \case - Right _ -> assertFailure "Supposed to throw" - Left _ -> pure () - - tracesImpl :: HasCallStack => ClosedTerm a -> [Text] -> Assertion - tracesImpl x sl = - case evaluateScript $ compile x of - Left e -> assertFailure $ "Script evalImpluation failed: " <> show e - Right (_, traceLog, _) -> traceLog @?= sl - - succeedsImpl :: HasCallStack => ClosedTerm PUnit -> Assertion - succeedsImpl x = case evaluateScript $ compile x of - Left e -> assertFailure $ "Script evaluation failed: " <> show e - Right _ -> pure () - -{- -shrinkTester :: Tester -shrinkTester = - Tester - { evalImpl = EvalImpl evalImpl - , equalImpl = EqualImpl equalImpl - , equal'Impl = Equal'Impl equal'Impl - , failsImpl = FailsImpl failsImpl - , expectImpl = ExpectImpl expectImpl - , throwsImpl = ThrowsImpl throwsImpl - , tracesImpl = TracesImpl tracesImpl - } - where - evalImpl :: HasCallStack => ClosedTerm a -> IO Scripts.Script - evalImpl x = eval' . shrinkScript $ compile x - - equalImpl :: HasCallStack => ClosedTerm a -> ClosedTerm b -> Assertion - equalImpl x y = do - x' <- evalImpl x - y' <- evalImpl y - printScript x' @?= printScript y' - - equal'Impl :: HasCallStack => ClosedTerm a -> String -> Assertion - equal'Impl x y = do - x' <- let ?tester = standardTester in eval x - printScript x' @?= y - - failsImpl :: HasCallStack => ClosedTerm a -> Assertion - failsImpl x = - case evaluateScript . shrinkScript $ compile x of - Left (Scripts.EvaluationError _ _) -> mempty - Left (Scripts.EvaluationException _ _) -> mempty - Left e -> assertFailure $ "Script is malformed: " <> show e - Right (_, _, s) -> assertFailure $ "Script didn't err: " <> printScript s - - expectImpl :: HasCallStack => ClosedTerm PBool -> Assertion - expectImpl = equalImpl (pcon PTrue :: Term s PBool) - - throwsImpl :: HasCallStack => ClosedTerm a -> Assertion - throwsImpl x = - try @SomeException (putStrLn . printScript . shrinkScript $ compile x) >>= \case - Right _ -> assertFailure "Supposed to throw" - Left _ -> pure () - - tracesImpl :: HasCallStack => ClosedTerm a -> [Text] -> Assertion - tracesImpl x sl = - case evaluateScript . shrinkScript $ compile x of - Left e -> assertFailure $ "Script evalImpluation failed: " <> show e - Right (_, traceLog, _) -> traceLog @?= sl --} - -eval :: (HasCallStack, HasTester) => ClosedTerm a -> IO Scripts.Script -eval = runEvalImpl (evalImpl ?tester) -equal :: forall (a :: PType) (b :: PType). (HasCallStack, HasTester) => ClosedTerm a -> ClosedTerm b -> Assertion -equal x y = runEqualImpl (equalImpl ?tester) x y -equal' :: (HasCallStack, HasTester) => ClosedTerm a -> String -> Assertion -equal' = runEqual'Impl (equal'Impl ?tester) -fails :: (HasCallStack, HasTester) => ClosedTerm a -> Assertion -fails = runFailsImpl (failsImpl ?tester) -expect :: (HasCallStack, HasTester) => ClosedTerm PBool -> Assertion -expect = runExpectImpl (expectImpl ?tester) -throws :: (HasCallStack, HasTester) => ClosedTerm a -> Assertion -throws = runThrowsImpl (throwsImpl ?tester) -traces :: (HasCallStack, HasTester) => ClosedTerm a -> [Text] -> Assertion -traces = runTracesImpl (tracesImpl ?tester) -succeeds :: (HasCallStack, HasTester) => ClosedTerm PUnit -> Assertion -succeeds = runSucceedsImpl (succeedsImpl ?tester) - -evalBudgeted :: HasCallStack => ClosedTerm a -> IO Scripts.Script -evalBudgeted x = case evaluateBudgetedScript (ExBudget maxCPU maxMemory) $ compile x of - Left e -> assertFailure $ "Script evaluation failed: " <> show e - Right (_, _, x') -> pure x' - -maxCPU :: ExMemory.ExCPU -maxCPU = ExMemory.ExCPU 4000 - -maxMemory :: ExMemory.ExMemory -maxMemory = ExMemory.ExMemory 4000 - -equalBudgeted :: HasCallStack => ClosedTerm a -> ClosedTerm b -> Assertion -equalBudgeted x y = do - x' <- evalBudgeted x - y' <- evalBudgeted y - printScript x' @?= printScript y' diff --git a/flake.lock b/flake.lock index 04c436ddb..4cd7d19e9 100644 --- a/flake.lock +++ b/flake.lock @@ -16,47 +16,14 @@ "type": "github" } }, - "Shrinker": { - "flake": false, - "locked": { - "lastModified": 1642430208, - "narHash": "sha256-tfWyB7zCLzncwRpyl7eUOzuOBbg9KLu6sxSxRaFlOug=", - "owner": "Plutonomicon", - "repo": "Shrinker", - "rev": "0e60707996b876c7bd23a348f54545217ce2e556", - "type": "github" - }, - "original": { - "owner": "Plutonomicon", - "repo": "Shrinker", - "type": "github" - } - }, - "Win32-network": { - "flake": false, - "locked": { - "lastModified": 1636063162, - "narHash": "sha256-uvYEWalN62ETpH45/O7lNHo4rAIaJtYpLWdIcAkq3dA=", - "owner": "input-output-hk", - "repo": "Win32-network", - "rev": "2d1a01c7cbb9f68a1aefe2934aad6c70644ebfea", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "repo": "Win32-network", - "rev": "2d1a01c7cbb9f68a1aefe2934aad6c70644ebfea", - "type": "github" - } - }, "cabal-32": { "flake": false, "locked": { "lastModified": 1603716527, - "narHash": "sha256-sDbrmur9Zfp4mPKohCD8IDZfXJ0Tjxpmr2R+kg5PpSY=", + "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", "owner": "haskell", "repo": "cabal", - "rev": "94aaa8e4720081f9c75497e2735b90f6a819b08e", + "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", "type": "github" }, "original": { @@ -69,11 +36,11 @@ "cabal-34": { "flake": false, "locked": { - "lastModified": 1622475795, - "narHash": "sha256-chwTL304Cav+7p38d9mcb+egABWmxo2Aq+xgVBgEb/U=", + "lastModified": 1640353650, + "narHash": "sha256-N1t6M3/wqj90AEdRkeC8i923gQYUpzSr8b40qVOZ1Rk=", "owner": "haskell", "repo": "cabal", - "rev": "b086c1995cdd616fc8d91f46a21e905cc50a1049", + "rev": "942639c18c0cd8ec53e0a6f8d120091af35312cd", "type": "github" }, "original": { @@ -86,11 +53,11 @@ "cabal-36": { "flake": false, "locked": { - "lastModified": 1640163203, - "narHash": "sha256-TwDWP2CffT0j40W6zr0J1Qbu+oh3nsF1lUx9446qxZM=", + "lastModified": 1641652457, + "narHash": "sha256-BlFPKP4C4HRUJeAbdembX1Rms1LD380q9s0qVDeoAak=", "owner": "haskell", "repo": "cabal", - "rev": "ecf418050c1821f25e2e218f1be94c31e0465df1", + "rev": "f27667f8ec360c475027dcaee0138c937477b070", "type": "github" }, "original": { @@ -103,11 +70,11 @@ "cardano-base": { "flake": false, "locked": { - "lastModified": 1638456794, - "narHash": "sha256-0KAO6dWqupJzRyjWjAFLZrt0hA6pozeKsDv1Fnysib8=", + "lastModified": 1652788515, + "narHash": "sha256-l0KgomRi6YhEoOlFnBYEXhnZO2+PW68rhfUrbMXjhCQ=", "owner": "input-output-hk", "repo": "cardano-base", - "rev": "4fae3f0149fd8925be94707d3ae0e36c0d67bd58", + "rev": "631cb6cf1fa01ab346233b610a38b3b4cba6e6ab", "type": "github" }, "original": { @@ -136,17 +103,17 @@ "cardano-prelude": { "flake": false, "locked": { - "lastModified": 1641566029, - "narHash": "sha256-CylaHhO4zbZ1dEAv8yWp1swP1xys/s2Sbxg3a2pdnCI=", - "owner": "locallycompact", + "lastModified": 1653997332, + "narHash": "sha256-E+YSfUsvxdoOr7n7fz4xd7zb4z8XBRGNYOKipc2A1pw=", + "owner": "mlabs-haskell", "repo": "cardano-prelude", - "rev": "93f95047bb36a055bdd56fb0cafd887c072cdce2", + "rev": "713c7ae79a4d538fcd653c976a652913df1567b9", "type": "github" }, "original": { - "owner": "locallycompact", + "owner": "mlabs-haskell", "repo": "cardano-prelude", - "rev": "93f95047bb36a055bdd56fb0cafd887c072cdce2", + "rev": "713c7ae79a4d538fcd653c976a652913df1567b9", "type": "github" } }, @@ -182,133 +149,157 @@ "type": "github" } }, - "cryptonite": { - "flake": false, + "ema": { + "inputs": { + "flake-compat": "flake-compat", + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + }, "locked": { - "lastModified": 1639749289, - "narHash": "sha256-/KS2S0f9r4c/q+IUGwkFOY9jbZkyK3dl0xMpDbULeqc=", - "owner": "haskell-crypto", - "repo": "cryptonite", - "rev": "cec291d988f0f17828384f3358214ab9bf724a13", + "lastModified": 1653742730, + "narHash": "sha256-NyhjoMbm3h1aTskIU6jowNClSgA92bUcGcVNPfWNWgE=", + "owner": "srid", + "repo": "ema", + "rev": "50d9499db16b4e334776d8e8cffcd144c67f9fc4", "type": "github" }, "original": { - "owner": "haskell-crypto", - "repo": "cryptonite", - "rev": "cec291d988f0f17828384f3358214ab9bf724a13", + "owner": "srid", + "ref": "multisite", + "repo": "ema", "type": "github" } }, - "flake-compat": { - "flake": false, + "emanote": { + "inputs": { + "ema": "ema", + "flake-compat": [ + "emanote", + "ema", + "flake-compat" + ], + "flake-utils": [ + "emanote", + "ema", + "flake-utils" + ], + "heist": "heist", + "ixset-typed": "ixset-typed", + "nixpkgs": [ + "emanote", + "ema", + "nixpkgs" + ], + "pandoc-link-context": "pandoc-link-context", + "tailwind-haskell": "tailwind-haskell" + }, "locked": { - "lastModified": 1641205782, - "narHash": "sha256-4jY7RCWUoZ9cKD8co0/4tFARpWB+57+r1bLLvXNJliY=", - "owner": "edolstra", - "repo": "flake-compat", - "rev": "b7547d3eed6f32d06102ead8991ec52ab0a4f1a7", + "lastModified": 1653742875, + "narHash": "sha256-2IFMkA6/T0nCQHQcC8UhYWh8q8FQyGDBKfcDIhBJ3JM=", + "owner": "srid", + "repo": "emanote", + "rev": "ab5155ef400ce83a744362a4b953315d7ee6a8c3", "type": "github" }, "original": { - "owner": "edolstra", - "repo": "flake-compat", + "owner": "srid", + "ref": "master", + "repo": "emanote", "type": "github" } }, - "flake-compat-ci": { + "flake-compat": { + "flake": false, "locked": { - "lastModified": 1641672839, - "narHash": "sha256-Bdwv+DKeEMlRNPDpZxSz0sSrqQBvdKO5fZ8LmvrgCOU=", - "owner": "hercules-ci", - "repo": "flake-compat-ci", - "rev": "e832114bc18376c0f3fa13c19bf5ff253cc6570a", + "lastModified": 1650374568, + "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b4a34015c698c7793d592d66adbab377907a2be8", "type": "github" }, "original": { - "owner": "hercules-ci", - "repo": "flake-compat-ci", + "owner": "edolstra", + "repo": "flake-compat", "type": "github" } }, "flake-compat_2": { "flake": false, "locked": { - "lastModified": 1606424373, - "narHash": "sha256-oq8d4//CJOrVj+EcOaSXvMebvuTkmBJuT5tzlfewUnQ=", + "lastModified": 1641205782, + "narHash": "sha256-4jY7RCWUoZ9cKD8co0/4tFARpWB+57+r1bLLvXNJliY=", "owner": "edolstra", "repo": "flake-compat", - "rev": "99f1c2157fba4bfe6211a321fd0ee43199025dbf", + "rev": "b7547d3eed6f32d06102ead8991ec52ab0a4f1a7", "type": "github" }, "original": { "owner": "edolstra", - "ref": "master", "repo": "flake-compat", "type": "github" } }, - "flake-compat_3": { - "flake": false, + "flake-utils": { "locked": { - "lastModified": 1606424373, - "narHash": "sha256-oq8d4//CJOrVj+EcOaSXvMebvuTkmBJuT5tzlfewUnQ=", - "owner": "edolstra", - "repo": "flake-compat", - "rev": "99f1c2157fba4bfe6211a321fd0ee43199025dbf", + "lastModified": 1652776076, + "narHash": "sha256-gzTw/v1vj4dOVbpBSJX4J0DwUR6LIyXo7/SuuTJp1kM=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "04c1b180862888302ddfb2e3ad9eaa63afc60cf8", "type": "github" }, "original": { - "owner": "edolstra", - "repo": "flake-compat", + "owner": "numtide", + "ref": "v1.0.0", + "repo": "flake-utils", "type": "github" } }, - "flake-utils": { + "flake-utils_2": { "locked": { - "lastModified": 1623875721, - "narHash": "sha256-A8BU7bjS5GirpAUv4QA+QnJ4CceLHkcXdRp4xITDB0s=", + "lastModified": 1652776076, + "narHash": "sha256-gzTw/v1vj4dOVbpBSJX4J0DwUR6LIyXo7/SuuTJp1kM=", "owner": "numtide", "repo": "flake-utils", - "rev": "f7e004a55b120c02ecb6219596820fcd32ca8772", + "rev": "04c1b180862888302ddfb2e3ad9eaa63afc60cf8", "type": "github" }, "original": { "owner": "numtide", + "ref": "v1.0.0", "repo": "flake-utils", "type": "github" } }, - "flat": { - "flake": false, + "flake-utils_3": { "locked": { - "lastModified": 1641898475, - "narHash": "sha256-D7jJ4t0T1ZvXbO61r3HQj77hZ5hWF/P1L8X9+MnfD6c=", - "owner": "Quid2", - "repo": "flat", - "rev": "41a040c413351e021982bb78bd00f750628f8060", + "lastModified": 1644229661, + "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", "type": "github" }, "original": { - "owner": "Quid2", - "repo": "flat", - "rev": "41a040c413351e021982bb78bd00f750628f8060", + "owner": "numtide", + "repo": "flake-utils", "type": "github" } }, - "foundation": { + "flat": { "flake": false, "locked": { - "lastModified": 1635711016, - "narHash": "sha256-5TRuljpwt50DLjyFjiFj6quFncu8RT0d8/0jlzsenuc=", - "owner": "haskell-foundation", - "repo": "foundation", - "rev": "0bb195e1fea06d144dafc5af9a0ff79af0a5f4a0", + "lastModified": 1651403785, + "narHash": "sha256-g+jGep1IXdw4q01W67J6f6OODY91QzIlW1+Eu8pR+u0=", + "owner": "Quid2", + "repo": "flat", + "rev": "559617e058098b776b431e2a67346ad3adea2440", "type": "github" }, "original": { - "owner": "haskell-foundation", - "repo": "foundation", - "rev": "0bb195e1fea06d144dafc5af9a0ff79af0a5f4a0", + "owner": "Quid2", + "repo": "flat", "type": "github" } }, @@ -348,11 +339,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1642554756, - "narHash": "sha256-1+SN+z80HgKYshlCf8dRxwRojQzuwwsQ5uq14N/JP1Y=", + "lastModified": 1654046237, + "narHash": "sha256-FpM9zE+Q+WrvCiaZBCg5U1g0bYpiZOCxY8V3R5ydBu8=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "f9d5e67ca90926b244c0ad68815371d37582a149", + "rev": "eeae1790b9c6a880d96e4a7214fdf0a73bdd6fc0", "type": "github" }, "original": { @@ -364,11 +355,11 @@ "hackage-nix": { "flake": false, "locked": { - "lastModified": 1637291070, - "narHash": "sha256-hTX2Xo36i9MR6PNwA/89C8daKjxmx5ZS5lwR2Cbp8Yo=", + "lastModified": 1651108473, + "narHash": "sha256-zHGCnBdwKvrcYanjf3GARTWF8V2pyJl1QNONUNZSoc0=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "6ea4ad5f4a5e2303cd64974329ba90ccc410a012", + "rev": "dbab3b292c3400d028a2257e3acd2ac0249da774", "type": "github" }, "original": { @@ -380,11 +371,11 @@ "haskell-language-server": { "flake": false, "locked": { - "lastModified": 1642772345, - "narHash": "sha256-fjdNOcd0S35OAvMZu81/im32B7hSIimjs08VKQA58Mw=", + "lastModified": 1653778781, + "narHash": "sha256-oEVBaYRLjD4gC3vQuT0DCgmCSIeWSwGPVXXSKJDFUK0=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "f0bbc390b995953885506b755f4e4b5c6af618fb", + "rev": "8c47d6ce2a8409a285a3f4c3f0e10c25fb4dd848", "type": "github" }, "original": { @@ -396,16 +387,16 @@ "haskell-language-server_2": { "flake": false, "locked": { - "lastModified": 1638136578, - "narHash": "sha256-Reo9BQ12O+OX7tuRfaDPZPBpJW4jnxZetm63BxYncoM=", + "lastModified": 1650980856, + "narHash": "sha256-uiwsfh/K3IABZDYj7JUZNIAPRVqH6g/r8X6QKg8DrZE=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "745ef26f406dbdd5e4a538585f8519af9f1ccb09", + "rev": "b5a37f7fc360596899cb2945f363030f44156415", "type": "github" }, "original": { "owner": "haskell", - "ref": "1.5.1", + "ref": "1.7.0.0", "repo": "haskell-language-server", "type": "github" } @@ -417,14 +408,15 @@ "cabal-34": "cabal-34", "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", - "flake-utils": "flake-utils", + "flake-utils": "flake-utils_3", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", "hackage": "hackage", "hpc-coveralls": "hpc-coveralls", + "hydra": "hydra", "nix-tools": "nix-tools", "nixpkgs": [ "haskell-nix", - "nixpkgs-2111" + "nixpkgs-unstable" ], "nixpkgs-2003": "nixpkgs-2003", "nixpkgs-2105": "nixpkgs-2105", @@ -434,28 +426,51 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1642811877, - "narHash": "sha256-7YbbFF4ISWMcs5hHDfH7GkCSccvwEwhvKZ5D74Cuajo=", - "owner": "L-as", + "lastModified": 1654068838, + "narHash": "sha256-GHSufC21DSg8Lz2AzIg3DA9DPxGvLqxGFa/4ADoXRhU=", + "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "ac825b91c202947ec59b1a477003564cc018fcec", + "rev": "fa2fa131fe15e630c91ab4078d12eb32c41f934b", "type": "github" }, "original": { - "owner": "L-as", - "ref": "master", + "owner": "input-output-hk", "repo": "haskell.nix", "type": "github" } }, + "haskell-nix-extra-hackage": { + "inputs": { + "haskell-nix": [ + "haskell-nix" + ], + "nixpkgs": [ + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1655143375, + "narHash": "sha256-yU+HPLwGPf5IeLj9IBQ1zrPBTYEwvYbuMnADs4T8RLQ=", + "owner": "mlabs-haskell", + "repo": "haskell-nix-extra-hackage", + "rev": "03ee7afdc1ad982e059e3941db80f7a5b30a2757", + "type": "github" + }, + "original": { + "owner": "mlabs-haskell", + "ref": "separate-hackages", + "repo": "haskell-nix-extra-hackage", + "type": "github" + } + }, "haskell-nix_2": { "flake": false, "locked": { - "lastModified": 1629380841, - "narHash": "sha256-gWOWCfX7IgVSvMMYN6rBGK6EA0pk6pmYguXzMvGte+Q=", + "lastModified": 1651151636, + "narHash": "sha256-WdMP9IMB5kByT0zimDuCYZF/dinRB104H8iDTG/c1Eo=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "7215f083b37741446aa325b20c8ba9f9f76015eb", + "rev": "f707aa2e75c0d33473166abc61c0b43ac6e107c0", "type": "github" }, "original": { @@ -464,42 +479,33 @@ "type": "github" } }, - "hercules-ci-agent": { - "inputs": { - "flake-compat": "flake-compat_3", - "nix-darwin": "nix-darwin", - "nixos-20_09": "nixos-20_09", - "nixos-unstable": "nixos-unstable", - "pre-commit-hooks-nix": "pre-commit-hooks-nix" - }, + "heist": { + "flake": false, "locked": { - "lastModified": 1642766877, - "narHash": "sha256-EXvI+1cKZHWfAaRV1PrSrQe0knc4rg5vMF4qz6/5bkI=", - "owner": "hercules-ci", - "repo": "hercules-ci-agent", - "rev": "0aa916f487be7da03bc2a6dec2ac7149b05499c5", + "lastModified": 1653169917, + "narHash": "sha256-i52wi4nNC6ATx8gTtmpLnxQZEhKSM0LbpmSu57d5VqI=", + "owner": "srid", + "repo": "heist", + "rev": "75533cade1a0d9859ff487cbf6f22e98711248d3", "type": "github" }, "original": { - "owner": "hercules-ci", - "ref": "master", - "repo": "hercules-ci-agent", + "owner": "srid", + "ref": "emanote", + "repo": "heist", "type": "github" } }, "hercules-ci-effects": { "inputs": { - "flake-compat": "flake-compat_2", - "hercules-ci-agent": "hercules-ci-agent", - "nixpkgs": "nixpkgs_2", - "nixpkgs-nixops": "nixpkgs-nixops" + "nixpkgs": "nixpkgs_4" }, "locked": { - "lastModified": 1641914281, - "narHash": "sha256-3qJ6tDPkrsFqm4E74JROZlQbnKKLNTHV7QOD1LdcVqs=", + "lastModified": 1653841712, + "narHash": "sha256-XBF4i1MuIRAEbFpj3Z3fVaYxzNEsYapyENtw3vG+q1I=", "owner": "hercules-ci", "repo": "hercules-ci-effects", - "rev": "2e165352d92782e7ae149f4f1a9b3174f718a3af", + "rev": "e14d2131b7c81acca3904b584ac45fb72da64dd2", "type": "github" }, "original": { @@ -524,24 +530,46 @@ "type": "github" } }, - "hs-memory": { + "hydra": { + "inputs": { + "nix": "nix", + "nixpkgs": [ + "haskell-nix", + "hydra", + "nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1646878427, + "narHash": "sha256-KtbrofMtN8GlM7D+n90kixr7QpSlVmdN+vK5CA/aRzc=", + "owner": "NixOS", + "repo": "hydra", + "rev": "28b682b85b7efc5cf7974065792a1f22203a5927", + "type": "github" + }, + "original": { + "id": "hydra", + "type": "indirect" + } + }, + "iohk-nix": { "flake": false, "locked": { - "lastModified": 1636757734, - "narHash": "sha256-DIlt0NpFUx8IUeTcgZNBJWWfyNaKv5ZKYw1K9aLvxBs=", - "owner": "vincenthz", - "repo": "hs-memory", - "rev": "3cf661a8a9a8ac028df77daa88e8d65c55a3347a", + "lastModified": 1653579289, + "narHash": "sha256-wveDdPsgB/3nAGAdFaxrcgLEpdi0aJ5kEVNtI+YqVfo=", + "owner": "input-output-hk", + "repo": "iohk-nix", + "rev": "edb2d2df2ebe42bbdf03a0711115cf6213c9d366", "type": "github" }, "original": { - "owner": "vincenthz", - "repo": "hs-memory", - "rev": "3cf661a8a9a8ac028df77daa88e8d65c55a3347a", + "owner": "input-output-hk", + "repo": "iohk-nix", "type": "github" } }, - "iohk-nix": { + "iohk-nix_2": { "flake": false, "locked": { "lastModified": 1626953580, @@ -557,84 +585,89 @@ "type": "github" } }, - "nix-darwin": { - "inputs": { - "nixpkgs": "nixpkgs" - }, + "ixset-typed": { + "flake": false, "locked": { - "lastModified": 1622060422, - "narHash": "sha256-hPVlvrAyf6zL7tTx0lpK+tMxEfZeMiIZ/A2xaJ41WOY=", - "owner": "LnL7", - "repo": "nix-darwin", - "rev": "007d700e644ac588ad6668e6439950a5b6e2ff64", + "lastModified": 1652177108, + "narHash": "sha256-g0N1jiumsxHzfo9SGVR+q9awRvHEehSRaoW89LXCCnY=", + "owner": "well-typed", + "repo": "ixset-typed", + "rev": "244d3b72fd051b8d78f2d4edb6208269f29d85b7", "type": "github" }, "original": { - "owner": "LnL7", - "repo": "nix-darwin", + "owner": "well-typed", + "repo": "ixset-typed", "type": "github" } }, - "nix-tools": { + "lowdown-src": { "flake": false, "locked": { - "lastModified": 1636018067, - "narHash": "sha256-ng306fkuwr6V/malWtt3979iAC4yMVDDH2ViwYB6sQE=", - "owner": "input-output-hk", - "repo": "nix-tools", - "rev": "ed5bd7215292deba55d6ab7a4e8c21f8b1564dda", + "lastModified": 1633514407, + "narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=", + "owner": "kristapsdz", + "repo": "lowdown", + "rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8", "type": "github" }, "original": { - "owner": "input-output-hk", - "repo": "nix-tools", + "owner": "kristapsdz", + "repo": "lowdown", "type": "github" } }, - "nixos-20_09": { + "nix": { + "inputs": { + "lowdown-src": "lowdown-src", + "nixpkgs": "nixpkgs_3", + "nixpkgs-regression": "nixpkgs-regression" + }, "locked": { - "lastModified": 1623585158, - "narHash": "sha256-AjK7M1/six8IBPOI28nm7yC2k8mZIR2F9QrOwFYHAS0=", + "lastModified": 1643066034, + "narHash": "sha256-xEPeMcNJVOeZtoN+d+aRwolpW8mFSEQx76HTRdlhPhg=", "owner": "NixOS", - "repo": "nixpkgs", - "rev": "115dbbe82eb4ec8aabf959068286468a68e0b244", + "repo": "nix", + "rev": "a1cd7e58606a41fcf62bf8637804cf8306f17f62", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixos-20.09", - "repo": "nixpkgs", + "ref": "2.6.0", + "repo": "nix", "type": "github" } }, - "nixos-unstable": { + "nix-tools": { + "flake": false, "locked": { - "lastModified": 1630248577, - "narHash": "sha256-9d/yq96TTrnF7qjA6wPYk+rYjWAXwfUmwk3qewezSeg=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "8d8a28b47b7c41aeb4ad01a2bd8b7d26986c3512", + "lastModified": 1649424170, + "narHash": "sha256-XgKXWispvv5RCvZzPb+p7e6Hy3LMuRjafKMl7kXzxGw=", + "owner": "input-output-hk", + "repo": "nix-tools", + "rev": "e109c94016e3b6e0db7ed413c793e2d4bdb24aa7", "type": "github" }, "original": { - "owner": "NixOS", - "ref": "nixos-unstable", - "repo": "nixpkgs", + "owner": "input-output-hk", + "repo": "nix-tools", "type": "github" } }, "nixpkgs": { "locked": { - "lastModified": 1602411953, - "narHash": "sha256-gbupmxRpoQZqL5NBQCJN2GI5G7XDEHHHYKhVwEj5+Ps=", - "owner": "LnL7", + "lastModified": 1652885393, + "narHash": "sha256-YIgvvlk4iQ1Hi7KD9o5gsojc+ApB+jiH1d5stK8uXiw=", + "owner": "nixos", "repo": "nixpkgs", - "rev": "f780534ea2d0c12e62607ff254b6b45f46653f7a", + "rev": "48037fd90426e44e4bf03e6479e88a11453b9b66", "type": "github" }, "original": { - "id": "nixpkgs", - "type": "indirect" + "owner": "nixos", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" } }, "nixpkgs-2003": { @@ -655,11 +688,11 @@ }, "nixpkgs-2105": { "locked": { - "lastModified": 1640283157, - "narHash": "sha256-6Ddfop+rKE+Gl9Tjp9YIrkfoYPzb8F80ergdjcq3/MY=", + "lastModified": 1645296114, + "narHash": "sha256-y53N7TyIkXsjMpOG7RhvqJFGDacLs9HlyHeSTBioqYU=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "dde1557825c5644c869c5efc7448dc03722a8f09", + "rev": "530a53dcbc9437363471167a5e4762c5fcfa34a1", "type": "github" }, "original": { @@ -671,11 +704,11 @@ }, "nixpkgs-2111": { "locked": { - "lastModified": 1640283207, - "narHash": "sha256-SCwl7ZnCfMDsuSYvwIroiAlk7n33bW8HFfY8NvKhcPA=", + "lastModified": 1648744337, + "narHash": "sha256-bYe1dFJAXovjqiaPKrmAbSBEK5KUkgwVaZcTbSoJ7hg=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "64c7e3388bbd9206e437713351e814366e0c3284", + "rev": "0a58eebd8ec65ffdef2ce9562784123a73922052", "type": "github" }, "original": { @@ -685,29 +718,44 @@ "type": "github" } }, - "nixpkgs-nixops": { + "nixpkgs-latest": { "locked": { - "lastModified": 1630248577, - "narHash": "sha256-9d/yq96TTrnF7qjA6wPYk+rYjWAXwfUmwk3qewezSeg=", + "lastModified": 1653918805, + "narHash": "sha256-6ahwAnBNGgqSNSn/6RnsxrlFi+fkA+RyT6o/5S1915o=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "8d8a28b47b7c41aeb4ad01a2bd8b7d26986c3512", + "rev": "a0a69be4b5ee63f1b5e75887a406e9194012b492", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "8d8a28b47b7c41aeb4ad01a2bd8b7d26986c3512", + "rev": "a0a69be4b5ee63f1b5e75887a406e9194012b492", "type": "github" } }, + "nixpkgs-regression": { + "locked": { + "lastModified": 1643052045, + "narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2", + "type": "indirect" + } + }, "nixpkgs-unstable": { "locked": { - "lastModified": 1641285291, - "narHash": "sha256-KYaOBNGar3XWTxTsYPr9P6u74KAqNq0wobEC236U+0c=", + "lastModified": 1648219316, + "narHash": "sha256-Ctij+dOi0ZZIfX5eMhgwugfvB+WZSrvVNAyAuANOsnQ=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "0432195a4b8d68faaa7d3d4b355260a3120aeeae", + "rev": "30d3d79b7d3607d56546dd2a6b49e156ba0ec634", "type": "github" }, "original": { @@ -719,28 +767,57 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1633463774, - "narHash": "sha256-y3GjapcRzd42NgebQ4sx5GFJ53dYqNdF3UQu7/t6mUg=", - "owner": "hercules-ci", + "lastModified": 1653117584, + "narHash": "sha256-5uUrHeHBIaySBTrRExcCoW8fBBYVSDjDYDU5A6iOl+k=", + "owner": "NixOS", "repo": "nixpkgs", - "rev": "c70f908fd1f129aede2744d4385fae57d2e252b1", + "rev": "f4dfed73ee886b115a99e5b85fdfbeb683290d83", "type": "github" }, "original": { - "owner": "hercules-ci", - "ref": "init-nixops-hercules-ci", + "id": "nixpkgs", + "type": "indirect" + } + }, + "nixpkgs_3": { + "locked": { + "lastModified": 1632864508, + "narHash": "sha256-d127FIvGR41XbVRDPVvozUPQ/uRHbHwvfyKHwEt5xFM=", + "owner": "NixOS", "repo": "nixpkgs", + "rev": "82891b5e2c2359d7e58d08849e4c89511ab94234", "type": "github" + }, + "original": { + "id": "nixpkgs", + "ref": "nixos-21.05-small", + "type": "indirect" } }, - "nixpkgs_3": { + "nixpkgs_4": { + "locked": { + "lastModified": 1647297614, + "narHash": "sha256-ulGq3W5XsrBMU/u5k9d4oPy65pQTkunR4HKKtTq0RwY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "73ad5f9e147c0d2a2061f1d4bd91e05078dc0b58", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_5": { "flake": false, "locked": { - "lastModified": 1628785280, - "narHash": "sha256-2B5eMrEr6O8ff2aQNeVxTB+9WrGE80OB4+oM6T7fOcc=", + "lastModified": 1645493675, + "narHash": "sha256-9xundbZQbhFodsQRh6QMN1GeSXfo3y/5NL0CZcJULz0=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "6525bbc06a39f26750ad8ee0d40000ddfdc24acb", + "rev": "74b10859829153d5c5d50f7c77b86763759e8654", "type": "github" }, "original": { @@ -767,6 +844,23 @@ "type": "github" } }, + "pandoc-link-context": { + "flake": false, + "locked": { + "lastModified": 1653170888, + "narHash": "sha256-bA/Oj2pt3H2b4lqWqVBYo3Qhvhd01r4vM39+vLuPMtA=", + "owner": "srid", + "repo": "pandoc-link-context", + "rev": "c3a3de34b291b2bfec04387af65e0cc0822373c5", + "type": "github" + }, + "original": { + "owner": "srid", + "ref": "master", + "repo": "pandoc-link-context", + "type": "github" + } + }, "plutus": { "inputs": { "cardano-repo-tool": "cardano-repo-tool", @@ -774,44 +868,26 @@ "hackage-nix": "hackage-nix", "haskell-language-server": "haskell-language-server_2", "haskell-nix": "haskell-nix_2", - "iohk-nix": "iohk-nix", - "nixpkgs": "nixpkgs_3", - "pre-commit-hooks-nix": "pre-commit-hooks-nix_2", - "sphinxcontrib-haddock": "sphinxcontrib-haddock", - "stackage-nix": "stackage-nix" + "iohk-nix": "iohk-nix_2", + "nixpkgs": "nixpkgs_5", + "pre-commit-hooks-nix": "pre-commit-hooks-nix", + "sphinxcontrib-haddock": "sphinxcontrib-haddock" }, "locked": { - "lastModified": 1642004499, - "narHash": "sha256-LMAMixBJRYZ5wgINjp4rb8hifEGkXptX8Z5e2Ip8HeM=", - "owner": "L-as", + "lastModified": 1656595231, + "narHash": "sha256-3EBhSroECMOSP02qZGT0Zb3QHWibI/tYjdcaT5/YotY=", + "owner": "input-output-hk", "repo": "plutus", - "rev": "6cceda4793ee125dc700c63ff780593e387696b0", + "rev": "b39a526e983cb931d0cc49b7d073d6d43abd22b5", "type": "github" }, "original": { - "owner": "L-as", - "ref": "master", + "owner": "input-output-hk", "repo": "plutus", "type": "github" } }, "pre-commit-hooks-nix": { - "flake": false, - "locked": { - "lastModified": 1622650193, - "narHash": "sha256-qSzUpJDv04ajS9FXoCq6NjVF3qOt9IiGIiGh0P8amyw=", - "owner": "cachix", - "repo": "pre-commit-hooks.nix", - "rev": "0398f0649e0a741660ac5e8216760bae5cc78579", - "type": "github" - }, - "original": { - "owner": "cachix", - "repo": "pre-commit-hooks.nix", - "type": "github" - } - }, - "pre-commit-hooks-nix_2": { "flake": false, "locked": { "lastModified": 1624971177, @@ -830,60 +906,54 @@ "protolude": { "flake": false, "locked": { - "lastModified": 1637276813, - "narHash": "sha256-/mgR1Vyp1WYBjdkbwQycrf6lcmOgUFcYUZIMhVgYhdo=", + "lastModified": 1647139352, + "narHash": "sha256-JyHAQfTTUswP8MeGEZibx/2/v01Q7cU5mNpnmDazh24=", "owner": "protolude", "repo": "protolude", - "rev": "d821ef0ac7552cfa2c3e7a7bdf29539f57e3fae6", + "rev": "3e249724fd0ead27370c8c297b1ecd38f92cbd5b", "type": "github" }, "original": { "owner": "protolude", "repo": "protolude", - "rev": "d821ef0ac7552cfa2c3e7a7bdf29539f57e3fae6", "type": "github" } }, "root": { "inputs": { - "Shrinker": "Shrinker", - "Win32-network": "Win32-network", "cardano-base": "cardano-base", "cardano-crypto": "cardano-crypto", "cardano-prelude": "cardano-prelude", - "cryptonite": "cryptonite", - "flake-compat": "flake-compat", - "flake-compat-ci": "flake-compat-ci", + "emanote": "emanote", "flat": "flat", - "foundation": "foundation", "haskell-language-server": "haskell-language-server", "haskell-nix": "haskell-nix", + "haskell-nix-extra-hackage": "haskell-nix-extra-hackage", "hercules-ci-effects": "hercules-ci-effects", - "hs-memory": "hs-memory", + "iohk-nix": "iohk-nix", "nixpkgs": [ "haskell-nix", "nixpkgs-unstable" ], + "nixpkgs-latest": "nixpkgs-latest", "plutus": "plutus", "protolude": "protolude", - "sized-functors": "sized-functors", - "th-extras": "th-extras" + "secp256k1-haskell": "secp256k1-haskell" } }, - "sized-functors": { + "secp256k1-haskell": { "flake": false, "locked": { - "lastModified": 1620614934, - "narHash": "sha256-pVJbEGF4/lvXmWIypwkMQBYygOx3TQwLJbMpfdYovdY=", - "owner": "JonasDuregard", - "repo": "sized-functors", - "rev": "fe6bf78a1b97ff7429630d0e8974c9bc40945dcf", + "lastModified": 1650290419, + "narHash": "sha256-XrjiqCC7cNTFib78gdMPGNettAkwAxQlbC/n+/mRFt4=", + "owner": "haskoin", + "repo": "secp256k1-haskell", + "rev": "3df963ab6ae14ec122691a97af09a7331511a387", "type": "github" }, "original": { - "owner": "JonasDuregard", - "repo": "sized-functors", - "rev": "fe6bf78a1b97ff7429630d0e8974c9bc40945dcf", + "owner": "haskoin", + "repo": "secp256k1-haskell", "type": "github" } }, @@ -906,11 +976,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1642468901, - "narHash": "sha256-+Hu4m9i8v8Moey/C8fy8juyxB729JdsXz02cK8nJXLk=", + "lastModified": 1654046327, + "narHash": "sha256-IxX46Dh4OZpF3k7KPMa3tZSScYYGqFxXpCnMc0QRkuQ=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "7544f8fd16bb92b7cf90cb51cb4ddc43173526de", + "rev": "cc1d778723fcd431f9b2ed632a50c610c3e38b54", "type": "github" }, "original": { @@ -919,36 +989,28 @@ "type": "github" } }, - "stackage-nix": { - "flake": false, - "locked": { - "lastModified": 1597712578, - "narHash": "sha256-c/pcfZ6w5Yp//7oC0hErOGVVphBLc5vc4IZlWKZ/t6E=", - "owner": "input-output-hk", - "repo": "stackage.nix", - "rev": "e32c8b06d56954865725514ce0d98d5d1867e43a", - "type": "github" + "tailwind-haskell": { + "inputs": { + "ema": [ + "emanote", + "ema" + ], + "flake-compat": "flake-compat_2", + "flake-utils": "flake-utils_2", + "nixpkgs": "nixpkgs_2" }, - "original": { - "owner": "input-output-hk", - "repo": "stackage.nix", - "type": "github" - } - }, - "th-extras": { - "flake": false, "locked": { - "lastModified": 1641329261, - "narHash": "sha256-+K91xH/zew66ry0EAV5FaEIAHUZdJ3ngD9GzCJiUq7k=", - "owner": "mokus0", - "repo": "th-extras", - "rev": "787ed752c1e5d41b5903b74e171ed087de38bffa", + "lastModified": 1653230344, + "narHash": "sha256-MNwayqvZHsIsP1uyqwQFvzcfFGBMejzZOqAapDjrV5I=", + "owner": "srid", + "repo": "tailwind-haskell", + "rev": "0fb8a18b0e770bafc17521836658f31c56e6dfdb", "type": "github" }, "original": { - "owner": "mokus0", - "repo": "th-extras", - "rev": "787ed752c1e5d41b5903b74e171ed087de38bffa", + "owner": "srid", + "ref": "master", + "repo": "tailwind-haskell", "type": "github" } } diff --git a/flake.nix b/flake.nix index 8bb61d311..b39f49f8a 100644 --- a/flake.nix +++ b/flake.nix @@ -1,487 +1,399 @@ { description = "plutarch"; - inputs.haskell-nix.url = "github:L-as/haskell.nix?ref=master"; + inputs.haskell-nix.url = "github:input-output-hk/haskell.nix"; inputs.nixpkgs.follows = "haskell-nix/nixpkgs-unstable"; - inputs.flake-compat-ci.url = "github:hercules-ci/flake-compat-ci"; + inputs.nixpkgs-latest.url = "github:NixOS/nixpkgs?rev=a0a69be4b5ee63f1b5e75887a406e9194012b492"; + inputs.hercules-ci-effects.url = "github:hercules-ci/hercules-ci-effects"; - inputs.flake-compat = { - url = "github:edolstra/flake-compat"; - flake = false; - }; - - # https://github.com/input-output-hk/plutus/pull/4328 - inputs.plutus.url = "github:L-as/plutus?ref=master"; - # https://github.com/input-output-hk/cardano-prelude/pull/162 - inputs.cardano-prelude.url = "github:locallycompact/cardano-prelude?rev=93f95047bb36a055bdd56fb0cafd887c072cdce2"; + + inputs.haskell-nix-extra-hackage.url = "github:mlabs-haskell/haskell-nix-extra-hackage?ref=separate-hackages"; + inputs.haskell-nix-extra-hackage.inputs.haskell-nix.follows = "haskell-nix"; + inputs.haskell-nix-extra-hackage.inputs.nixpkgs.follows = "nixpkgs"; + + inputs.iohk-nix.url = "github:input-output-hk/iohk-nix"; + inputs.iohk-nix.flake = false; + # we use sphinxcontrib-haddock input + inputs.plutus.url = "github:input-output-hk/plutus"; + # https://github.com/input-output-hk/cardano-prelude/pull/163 + inputs.cardano-prelude.url = "github:mlabs-haskell/cardano-prelude?rev=713c7ae79a4d538fcd653c976a652913df1567b9"; inputs.cardano-prelude.flake = false; inputs.cardano-base.url = "github:input-output-hk/cardano-base"; inputs.cardano-base.flake = false; inputs.cardano-crypto.url = "github:input-output-hk/cardano-crypto?rev=07397f0e50da97eaa0575d93bee7ac4b2b2576ec"; inputs.cardano-crypto.flake = false; - # https://github.com/Quid2/flat/pull/27 - inputs.flat.url = "github:Quid2/flat?rev=41a040c413351e021982bb78bd00f750628f8060"; - inputs.flat.flake = false; - # https://github.com/input-output-hk/Win32-network/pull/10 - inputs.Win32-network.url = "github:input-output-hk/Win32-network?rev=2d1a01c7cbb9f68a1aefe2934aad6c70644ebfea"; - inputs.Win32-network.flake = false; - # https://github.com/haskell-foundation/foundation/pull/555 - inputs.foundation.url = "github:haskell-foundation/foundation?rev=0bb195e1fea06d144dafc5af9a0ff79af0a5f4a0"; - inputs.foundation.flake = false; - # https://github.com/locallycompact/protolude - inputs.protolude.url = "github:protolude/protolude?rev=d821ef0ac7552cfa2c3e7a7bdf29539f57e3fae6"; - inputs.protolude.flake = false; - # https://github.com/vincenthz/hs-memory/pull/87 - inputs.hs-memory.url = "github:vincenthz/hs-memory?rev=3cf661a8a9a8ac028df77daa88e8d65c55a3347a"; - inputs.hs-memory.flake = false; - # https://github.com/haskell-crypto/cryptonite/issues/357 - inputs.cryptonite.url = "github:haskell-crypto/cryptonite?rev=cec291d988f0f17828384f3358214ab9bf724a13"; - inputs.cryptonite.flake = false; - # https://github.com/JonasDuregard/sized-functors/pull/10 - inputs.sized-functors.url = "github:JonasDuregard/sized-functors?rev=fe6bf78a1b97ff7429630d0e8974c9bc40945dcf"; - inputs.sized-functors.flake = false; - # https://github.com/mokus0/th-extras/pull/17 - inputs.th-extras.url = "github:mokus0/th-extras?rev=787ed752c1e5d41b5903b74e171ed087de38bffa"; - inputs.th-extras.flake = false; - inputs.Shrinker.url = "github:Plutonomicon/Shrinker"; - inputs.Shrinker.flake = false; inputs.haskell-language-server.url = "github:haskell/haskell-language-server"; inputs.haskell-language-server.flake = false; - outputs = inputs@{ self, nixpkgs, haskell-nix, plutus, flake-compat, flake-compat-ci, hercules-ci-effects, ... }: + inputs.secp256k1-haskell.url = "github:haskoin/secp256k1-haskell"; + inputs.secp256k1-haskell.flake = false; + + # https://github.com/protolude/protolude/pull/133#issuecomment-1112150422 RC not uploaded to hackage yet... + inputs.protolude.url = "github:protolude/protolude"; + inputs.protolude.flake = false; + + # 0.4.5 hasn't been published to Hackage... + inputs.flat.url = "github:Quid2/flat"; + inputs.flat.flake = false; + + inputs.emanote.url = "github:srid/emanote/master"; + + outputs = inputs@{ self, nixpkgs, nixpkgs-latest, iohk-nix, haskell-nix, hercules-ci-effects, haskell-nix-extra-hackage, ... }: let - extraSources = [ - { - src = inputs.protolude; - subdirs = [ "." ]; - } - { - src = inputs.foundation; - subdirs = [ - "foundation" - "basement" - ]; - } - { - src = inputs.cardano-prelude; - subdirs = [ - "cardano-prelude" - ]; - } - { - src = inputs.hs-memory; - subdirs = [ "." ]; - } - { - src = inputs.cardano-crypto; - subdirs = [ "." ]; - } - { - src = inputs.cryptonite; - subdirs = [ "." ]; - } - { - src = inputs.flat; - subdirs = [ "." ]; - } - { - src = inputs.cardano-base; - subdirs = [ - "binary" - "cardano-crypto-class" - ]; - } - { - src = inputs.sized-functors; - subdirs = [ "." ]; - } - { - src = inputs.th-extras; - subdirs = [ "." ]; - } - { - src = inputs.plutus; - subdirs = [ - "plutus-core" - "plutus-ledger-api" - "plutus-tx" - "prettyprinter-configurable" - "word-array" - ]; - } - ]; + supportedSystems = nixpkgs-latest.lib.systems.flakeExposed; - supportedSystems = with nixpkgs.lib.systems.supported; tier1 ++ tier2 ++ tier3; - - perSystem = nixpkgs.lib.genAttrs supportedSystems; - - nixpkgsFor = system: import nixpkgs { inherit system; overlays = [ haskell-nix.overlay ]; inherit (haskell-nix) config; }; - nixpkgsFor' = system: import nixpkgs { inherit system; inherit (haskell-nix) config; }; - - ghcVersion = "ghc921"; - - tools.fourmolu = { }; - tools.haskell-language-server = { - modules = [{ - # https://github.com/input-output-hk/haskell.nix/issues/1177 - nonReinstallablePkgs = [ - "rts" - "ghc-heap" - "ghc-prim" - "integer-gmp" - "integer-simple" - "base" - "deepseq" - "array" - "ghc-boot-th" - "pretty" - "template-haskell" - # ghcjs custom packages - "ghcjs-prim" - "ghcjs-th" - "ghc-bignum" - "exceptions" - "stm" - "ghc-boot" - "ghc" - "Cabal" - "Win32" - "array" - "binary" - "bytestring" - "containers" - "directory" - "filepath" - "ghc-boot" - "ghc-compact" - "ghc-prim" - # "ghci" "haskeline" - "hpc" - "mtl" - "parsec" - "process" - "text" - "time" - "transformers" - "unix" - "xhtml" - "terminfo" - ]; - }]; - compiler-nix-name = ghcVersion; - # For some reason it doesn't use the latest version automatically. - index-state = - let l = builtins.attrNames (import "${haskell-nix.inputs.hackage}/index-state-hashes.nix"); in - builtins.elemAt l (builtins.length l - 1); - name = "haskell-language-server"; - version = "latest"; - cabalProjectLocal = '' - allow-newer: *:* - - constraints: - primitive-unlifted < 1.0.0.0 - - package haskell-language-server - flags: +use-ghc-stub +pedantic +ignore-plugins-ghc-bounds -alternateNumberFormat -brittany -callhierarchy -class -eval -floskell -fourmolu -haddockComments -hlint -importLens -ormolu -refineImports -retrie -splice -stylishhaskell -tactic -importLens - - ''; - src = "${inputs.haskell-language-server}"; - }; + perSystem = nixpkgs-latest.lib.genAttrs supportedSystems; - haskellModule = system: { - packages = { - basement.src = "${inputs.foundation}/basement"; - basement.components.library.postUnpack = "\n"; - cardano-binary.doHaddock = false; - cardano-binary.ghcOptions = [ "-Wwarn" ]; - cardano-binary.src = "${inputs.cardano-base}/binary"; - cardano-binary.components.library.postUnpack = "\n"; - cardano-crypto-class.components.library.pkgconfig = nixpkgs.lib.mkForce [ [ (import plutus { inherit system; }).pkgs.libsodium-vrf ] ]; - cardano-crypto-class.doHaddock = false; - cardano-crypto-class.ghcOptions = [ "-Wwarn" ]; - cardano-crypto-class.src = "${inputs.cardano-base}/cardano-crypto-class"; - cardano-crypto-class.components.library.postUnpack = "\n"; - cardano-crypto-praos.components.library.pkgconfig = nixpkgs.lib.mkForce [ [ (import plutus { inherit system; }).pkgs.libsodium-vrf ] ]; - cardano-crypto.src = "${inputs.cardano-crypto}"; - cardano-crypto.components.library.postUnpack = "\n"; - cardano-prelude.doHaddock = false; # somehow above options are not applied? - cardano-prelude.ghcOptions = [ "-Wwarn" ]; - cardano-prelude.src = "${inputs.cardano-prelude}/cardano-prelude"; - cardano-prelude.components.library.postUnpack = "\n"; - cryptonite.src = "${inputs.cryptonite}"; - cryptonite.components.library.postUnpack = "\n"; - flat.src = "${inputs.flat}"; - flat.components.library.postUnpack = "\n"; - foundation.src = "${inputs.foundation}/foundation"; - foundation.components.library.postUnpack = "\n"; - memory.src = "${inputs.hs-memory}"; - memory.components.library.postUnpack = "\n"; - plutus-core.src = "${inputs.plutus}/plutus-core"; - plutus-core.components.library.postUnpack = "\n"; - plutus-tx.src = "${inputs.plutus}/plutus-tx"; - plutus-tx.components.library.postUnpack = "\n"; - plutus-ledger-api.src = "${inputs.plutus}/plutus-ledger-api"; - plutus-ledger-api.components.library.postUnpack = "\n"; - #prettyprinter-configurable.src = "${inputs.plutus}/prettyprinter-configurable"; - #prettyprinter-configurable.components.library.postUnpack = "\n"; - protolude.src = "${inputs.protolude}"; - protolude.components.library.postUnpack = "\n"; - word-array.src = "${inputs.plutus}/word-array"; - word-array.components.library.postUnpack = "\n"; - }; + pkgsFor = system: import nixpkgs { + inherit system; + overlays = [ haskell-nix.overlay (import "${iohk-nix}/overlays/crypto") ]; + # This only does bad things for us... + # inherit (haskell-nix) config; }; + pkgsFor' = system: import nixpkgs-latest { inherit system; }; + + fourmoluFor = system: (pkgsFor' system).haskell.packages.ghc922.fourmolu_0_6_0_0; + + defaultGhcVersion = "ghc923"; + isGhc9 = x: builtins.trace "Checking whether ${x} is GHC 9.*" (builtins.substring 3 1 x == "9"); + + # https://github.com/input-output-hk/haskell.nix/issues/1177 + nonReinstallablePkgs = [ + "array" + "array" + "base" + "binary" + "bytestring" + "Cabal" + "containers" + "deepseq" + "directory" + "exceptions" + "filepath" + "ghc" + "ghc-bignum" + "ghc-boot" + "ghc-boot" + "ghc-boot-th" + "ghc-compact" + "ghc-heap" + # "ghci" + # "haskeline" + "ghcjs-prim" + "ghcjs-th" + "ghc-prim" + "ghc-prim" + "hpc" + "integer-gmp" + "integer-simple" + "mtl" + "parsec" + "pretty" + "process" + "rts" + "stm" + "template-haskell" + "terminfo" + "text" + "time" + "transformers" + "unix" + "Win32" + "xhtml" + ]; - cabalProjectLocal = '' - package plutus-tx-plugin - flags: +use-ghc-stub - - allow-newer: - cardano-binary:base - , cardano-crypto-class:base - , cardano-prelude:base - , canonical-json:bytestring - , plutus-core:ral - , plutus-core:some - , monoidal-containers:base - , hedgehog:mmorph - , text:deepseq - , hedgehog:template-haskell - , protolude:base - , protolude:ghc-prim - , protolude:transformers-compat - , protolude:hashable - , protolude:bytestring - , size-based:template-haskell - - constraints: - OneTuple ^>= 0.3.1 - , Only ^>= 0.1 - , QuickCheck ^>= 2.14.2 - , StateVar ^>= 1.2.2 - , Stream ^>= 0.4.7.2 - , adjunctions ^>= 4.4 - , aeson ^>= 2.0.3.0 - , algebraic-graphs ^>= 0.6 - , ansi-terminal ^>= 0.11.1 - , ansi-wl-pprint ^>= 0.6.9 - , assoc ^>= 1.0.2 - , async ^>= 2.2.4 - , attoparsec ^>= 0.14.4 - , barbies ^>= 2.0.3.1 - , base-compat ^>= 0.12.1 - , base-compat-batteries ^>= 0.12.1 - , base-orphans ^>= 0.8.6 - , base16-bytestring ^>= 1.0.2.0 - , basement ^>= 0.0.12 - , bifunctors ^>= 5.5.11 - , bimap ^>= 0.4.0 - , bin ^>= 0.1.2 - , boring ^>= 0.2 - , boxes ^>= 0.1.5 - , cabal-doctest ^>= 1.0.9 - , call-stack ^>= 0.4.0 - , canonical-json ^>= 0.6.0.0 - , cardano-binary ^>= 1.5.0 - , cardano-crypto ^>= 1.1.0 - , cardano-crypto-class ^>= 2.0.0 - , cardano-prelude ^>= 0.1.0.0 - , case-insensitive ^>= 1.2.1.0 - , cassava ^>= 0.5.2.0 - , cborg ^>= 0.2.6.0 - , clock ^>= 0.8.2 - , colour ^>= 2.3.6 - , comonad ^>= 5.0.8 - , composition-prelude ^>= 3.0.0.2 - , concurrent-output ^>= 1.10.14 - , constraints ^>= 0.13.2 - , constraints-extras ^>= 0.3.2.1 - , contravariant ^>= 1.5.5 - , cryptonite ^>= 0.29 - , data-default ^>= 0.7.1.1 - , data-default-class ^>= 0.1.2.0 - , data-default-instances-containers ^>= 0.0.1 - , data-default-instances-dlist ^>= 0.0.1 - , data-default-instances-old-locale ^>= 0.0.1 - , data-fix ^>= 0.3.2 - , dec ^>= 0.0.4 - , dependent-map ^>= 0.4.0.0 - , dependent-sum ^>= 0.7.1.0 - , dependent-sum-template ^>= 0.1.1.1 - , deriving-aeson ^>= 0.2.8 - , deriving-compat ^>= 0.6 - , dictionary-sharing ^>= 0.1.0.0 - , distributive ^>= 0.6.2.1 - , dlist ^>= 1.0 - , dom-lt ^>= 0.2.3 - , double-conversion ^>= 2.0.2.0 - , erf ^>= 2.0.0.0 - , exceptions ^>= 0.10.4 - , extra ^>= 1.7.10 - , fin ^>= 0.2.1 - , flat ^>= 0.4.5 - , foldl ^>= 1.4.12 - , formatting ^>= 7.1.3 - , foundation ^>= 0.0.26.1 - , free ^>= 5.1.7 - , half ^>= 0.3.1 - , hashable ^>= 1.4.0.2 - , haskell-lexer ^>= 1.1 - , hedgehog ^>= 1.0.5 - , indexed-traversable ^>= 0.1.2 - , indexed-traversable-instances ^>= 0.1.1 - , integer-logarithms ^>= 1.0.3.1 - , invariant ^>= 0.5.5 - , kan-extensions ^>= 5.2.3 - , lazy-search ^>= 0.1.2.1 - , lazysmallcheck ^>= 0.6 - , lens ^>= 5.1 - , lifted-async ^>= 0.10.2.2 - , lifted-base ^>= 0.2.3.12 - , list-t ^>= 1.0.5.1 - , logict ^>= 0.7.0.3 - , megaparsec ^>= 9.2.0 - , memory ^>= 0.16.0 - , microlens ^>= 0.4.12.0 - , mmorph ^>= 1.2.0 - , monad-control ^>= 1.0.3.1 - , mono-traversable ^>= 1.0.15.3 - , monoidal-containers ^>= 0.6.2.0 - , mtl-compat ^>= 0.2.2 - , newtype ^>= 0.2.2.0 - , newtype-generics ^>= 0.6.1 - , nothunks ^>= 0.1.3 - , old-locale ^>= 1.0.0.7 - , old-time ^>= 1.1.0.3 - , optparse-applicative ^>= 0.16.1.0 - , parallel ^>= 3.2.2.0 - , parser-combinators ^>= 1.3.0 - , plutus-core ^>= 0.1.0.0 - , plutus-ledger-api ^>= 0.1.0.0 - , plutus-tx ^>= 0.1.0.0 - , pretty-show ^>= 1.10 - , prettyprinter ^>= 1.7.1 - , prettyprinter-configurable ^>= 0.1.0.0 - , primitive ^>= 0.7.3.0 - , profunctors ^>= 5.6.2 - , protolude ^>= 0.3.0 - , quickcheck-instances ^>= 0.3.27 - , ral ^>= 0.2.1 - , random ^>= 1.2.1 - , rank2classes ^>= 1.4.4 - , recursion-schemes ^>= 5.2.2.2 - , reflection ^>= 2.1.6 - , resourcet ^>= 1.2.4.3 - , safe ^>= 0.3.19 - , safe-exceptions ^>= 0.1.7.2 - , scientific ^>= 0.3.7.0 - , semialign ^>= 1.2.0.1 - , semigroupoids ^>= 5.3.7 - , semigroups ^>= 0.20 - , serialise ^>= 0.2.4.0 - , size-based ^>= 0.1.2.0 - , some ^>= 1.0.3 - , split ^>= 0.2.3.4 - , splitmix ^>= 0.1.0.4 - , stm ^>= 2.5.0.0 - , strict ^>= 0.4.0.1 - , syb ^>= 0.7.2.1 - , tagged ^>= 0.8.6.1 - , tasty ^>= 1.4.2.1 - , tasty-golden ^>= 2.3.5 - , tasty-hedgehog ^>= 1.1.0.0 - , tasty-hunit ^>= 0.10.0.3 - , temporary ^>= 1.3 - , terminal-size ^>= 0.3.2.1 - , testing-type-modifiers ^>= 0.1.0.1 - , text-short ^>= 0.1.5 - , th-abstraction ^>= 0.4.3.0 - , th-compat ^>= 0.1.3 - , th-expand-syns ^>= 0.4.9.0 - , th-extras ^>= 0.0.0.6 - , th-lift ^>= 0.8.2 - , th-lift-instances ^>= 0.1.19 - , th-orphans ^>= 0.13.12 - , th-reify-many ^>= 0.1.10 - , th-utilities ^>= 0.2.4.3 - , these ^>= 1.1.1.1 - , time-compat ^>= 1.9.6.1 - , transformers-base ^>= 0.4.6 - , transformers-compat ^>= 0.7.1 - , type-equality ^>= 1 - , typed-process ^>= 0.2.8.0 - , unbounded-delays ^>= 0.1.1.1 - , universe-base ^>= 1.1.3 - , unliftio-core ^>= 0.2.0.1 - , unordered-containers ^>= 0.2.16.0 - , uuid-types ^>= 1.0.5 - , vector ^>= 0.12.3.1 - , vector-algorithms ^>= 0.8.0.4 - , void ^>= 0.7.3 - , wcwidth ^>= 0.0.2 - , witherable ^>= 0.4.2 - , wl-pprint-annotated ^>= 0.1.0.1 - , word-array ^>= 0.1.0.0 - ''; - - projectForGhc = ghcName: flagDevelopment: system: - let pkgs = nixpkgsFor system; in - let pkgs' = nixpkgsFor' system; in - (nixpkgsFor system).haskell-nix.cabalProject' ({ - # This is truly a horrible hack but is necessary. We can't disable tests otherwise in haskell.nix. - src = if ghcName == ghcVersion then ./. else - pkgs.runCommand "fake-src" { } '' - cp -rT ${./.} $out - chmod u+w $out $out/plutarch.cabal - # Remove stanzas from .cabal that won't work in GHC 8.10 - sed -i '/-- Everything below this line is deleted for GHC 8.10/,$d' $out/plutarch.cabal - ''; - compiler-nix-name = ghcName; - inherit extraSources; - modules = [ - (haskellModule system) + hlsFor' = compiler-nix-name: pkgs: + pkgs.haskell-nix.cabalProject' { + modules = [{ + inherit nonReinstallablePkgs; + reinstallableLibGhc = false; + }]; + inherit compiler-nix-name; + src = "${inputs.haskell-language-server}"; + sha256map."https://github.com/pepeiborra/ekg-json"."7a0af7a8fd38045fd15fb13445bdcc7085325460" = "fVwKxGgM0S4Kv/4egVAAiAjV7QB5PBqMVMCfsv7otIQ="; + }; + hlsFor = compiler-nix-name: system: + let + pkgs = pkgsFor system; + oldGhc = "8107"; + in + if (compiler-nix-name == "ghc${oldGhc}") then + pkgs.haskell-language-server.override { - packages.plutarch-test.flags.development = flagDevelopment; - packages.plutarch.flags.development = flagDevelopment; + supportedGhcVersions = [ oldGhc ]; } - ]; - shell = { - withHoogle = true; - - exactDeps = true; - - # We use the ones from Nixpkgs, since they are cached reliably. - # Eventually we will probably want to build these with haskell.nix. - nativeBuildInputs = [ - pkgs'.cabal-install - pkgs'.hlint - pkgs'.haskellPackages.cabal-fmt - pkgs'.nixpkgs-fmt + else + (hlsFor' compiler-nix-name pkgs).hsPkgs.haskell-language-server.components.exes.haskell-language-server; + + haskellModules = [ + ({ config, pkgs, hsPkgs, ... }: { + inherit nonReinstallablePkgs; # Needed for a lot of different things + packages = { + cardano-binary.doHaddock = false; + cardano-binary.ghcOptions = [ "-Wwarn" ]; + cardano-crypto-class.components.library.pkgconfig = pkgs.lib.mkForce [ [ pkgs.libsodium-vrf ] ]; + cardano-crypto-class.doHaddock = false; + cardano-crypto-class.ghcOptions = [ "-Wwarn" ]; + cardano-crypto-praos.components.library.pkgconfig = pkgs.lib.mkForce [ [ pkgs.libsodium-vrf ] ]; + cardano-prelude.doHaddock = false; # somehow above options are not applied? + cardano-prelude.ghcOptions = [ "-Wwarn" ]; + # Workaround missing support for build-tools: + # https://github.com/input-output-hk/haskell.nix/issues/231 + plutarch-test.components.exes.plutarch-test.build-tools = [ + config.hsPkgs.hspec-discover ]; + }; + }) + ]; - inherit tools; + myhackages = system: compiler-nix-name: haskell-nix-extra-hackage.mkHackagesFor system compiler-nix-name ( + [ + "${inputs.flat}" + "${inputs.protolude}" + "${inputs.cardano-prelude}/cardano-prelude" + "${inputs.cardano-crypto}" + "${inputs.cardano-base}/binary" + "${inputs.cardano-base}/cardano-crypto-class" + "${inputs.plutus}/plutus-core" + "${inputs.plutus}/plutus-ledger-api" + "${inputs.plutus}/plutus-tx" + "${inputs.plutus}/prettyprinter-configurable" + "${inputs.plutus}/word-array" + "${inputs.secp256k1-haskell}" + "${inputs.plutus}/plutus-tx-plugin" # necessary for FFI tests + ] + ); - additional = ps: [ - ps.plutus-ledger-api - #ps.shrinker - #ps.shrinker-testing - ]; - }; - } // (if ghcName == ghcVersion then { - inherit cabalProjectLocal; - } else { })); + applyPlutarchDep = pkgs: o: + let h = myhackages pkgs.system o.compiler-nix-name; in + o // { + modules = haskellModules ++ h.modules ++ (o.modules or [ ]); + extra-hackages = h.extra-hackages ++ (o.extra-hackages or [ ]); + extra-hackage-tarballs = h.extra-hackage-tarballs // (o.extra-hackage-tarballs or { }); + cabalProjectLocal = (o.cabalProjectLocal or "") + ( + '' + allow-newer: + cardano-binary:base + , cardano-crypto-class:base + , cardano-prelude:base + , canonical-json:bytestring + , plutus-core:ral + , plutus-core:some + , int-cast:base + , inline-r:singletons + + constraints: + OneTuple >= 0.3.1 + , Only >= 0.1 + , QuickCheck >= 2.14.2 + , StateVar >= 1.2.2 + , Stream >= 0.4.7.2 + , adjunctions >= 4.4 + , aeson >= 2.0.3.0 + , algebraic-graphs >= 0.6 + , ansi-terminal >= 0.11.1 + , ansi-wl-pprint >= 0.6.9 + , assoc >= 1.0.2 + , async >= 2.2.4 + , attoparsec >= 0.14.4 + , barbies >= 2.0.3.1 + , base-compat >= 0.12.1 + , base-compat-batteries >= 0.12.1 + , base-orphans >= 0.8.6 + , base16-bytestring >= 1.0.2.0 + , basement >= 0.0.12 + , bifunctors >= 5.5.11 + , bimap >= 0.4.0 + , bin >= 0.1.2 + , boring >= 0.2 + , boxes >= 0.1.5 + , cabal-doctest >= 1.0.9 + , call-stack >= 0.4.0 + , canonical-json >= 0.6.0.0 + , cardano-binary >= 1.5.0 + , cardano-crypto >= 1.1.0 + , cardano-crypto-class >= 2.0.0 + , cardano-prelude >= 0.1.0.0 + , case-insensitive >= 1.2.1.0 + , cassava >= 0.5.2.0 + , cborg >= 0.2.6.0 + , clock >= 0.8.2 + , colour >= 2.3.6 + , comonad >= 5.0.8 + , composition-prelude >= 3.0.0.2 + , concurrent-output >= 1.10.14 + , constraints >= 0.13.2 + , constraints-extras >= 0.3.2.1 + , contravariant >= 1.5.5 + , cryptonite >= 0.29 + , data-default >= 0.7.1.1 + , data-default-class >= 0.1.2.0 + , data-default-instances-containers >= 0.0.1 + , data-default-instances-dlist >= 0.0.1 + , data-default-instances-old-locale >= 0.0.1 + , data-fix >= 0.3.2 + , dec >= 0.0.4 + , dependent-map >= 0.4.0.0 + , dependent-sum >= 0.7.1.0 + , dependent-sum-template >= 0.1.1.1 + , deriving-aeson >= 0.2.8 + , deriving-compat >= 0.6 + , dictionary-sharing >= 0.1.0.0 + , distributive >= 0.6.2.1 + , dlist >= 1.0 + , dom-lt >= 0.2.3 + , double-conversion >= 2.0.2.0 + , erf >= 2.0.0.0 + , exceptions >= 0.10.4 + , extra >= 1.7.10 + , fin >= 0.2.1 + , flat >= 0.4.5 + , foldl >= 1.4.12 + , formatting >= 7.1.3 + , foundation >= 0.0.26.1 + , free >= 5.1.7 + , half >= 0.3.1 + , hashable >= 1.4.0.2 + , haskell-lexer >= 1.1 + , hedgehog >= 1.0.5 + , indexed-traversable >= 0.1.2 + , indexed-traversable-instances >= 0.1.1 + , integer-logarithms >= 1.0.3.1 + , invariant >= 0.5.5 + , kan-extensions >= 5.2.3 + , lazy-search >= 0.1.2.1 + , lazysmallcheck >= 0.6 + , lens >= 5.1 + , lifted-async >= 0.10.2.2 + , lifted-base >= 0.2.3.12 + , list-t >= 1.0.5.1 + , logict >= 0.7.0.3 + , megaparsec >= 9.2.0 + , memory >= 0.16.0 + , microlens >= 0.4.12.0 + , mmorph >= 1.2.0 + , monad-control >= 1.0.3.1 + , mono-traversable >= 1.0.15.3 + , monoidal-containers >= 0.6.2.0 + , mtl-compat >= 0.2.2 + , newtype >= 0.2.2.0 + , newtype-generics >= 0.6.1 + , nothunks >= 0.1.3 + , old-locale >= 1.0.0.7 + , old-time >= 1.1.0.3 + , optparse-applicative >= 0.16.1.0 + , parallel >= 3.2.2.0 + , parser-combinators >= 1.3.0 + , plutus-core >= 0.1.0.0 + , plutus-ledger-api >= 0.1.0.0 + , plutus-tx >= 0.1.0.0 + , pretty-show >= 1.10 + , prettyprinter >= 1.7.1 + , prettyprinter-configurable >= 0.1.0.0 + , primitive >= 0.7.3.0 + , profunctors >= 5.6.2 + , protolude >= 0.3.0 + , quickcheck-instances >= 0.3.27 + , ral >= 0.2.1 + , random >= 1.2.1 + , rank2classes >= 1.4.4 + , recursion-schemes >= 5.2.2.2 + , reflection >= 2.1.6 + , resourcet >= 1.2.4.3 + , safe >= 0.3.19 + , safe-exceptions >= 0.1.7.2 + , scientific >= 0.3.7.0 + , semialign >= 1.2.0.1 + , semigroupoids >= 5.3.7 + , semigroups >= 0.20 + , serialise >= 0.2.4.0 + , size-based >= 0.1.2.0 + , some >= 1.0.3 + , split >= 0.2.3.4 + , splitmix >= 0.1.0.4 + , stm >= 2.5.0.0 + , strict >= 0.4.0.1 + , syb >= 0.7.2.1 + , tagged >= 0.8.6.1 + , tasty >= 1.4.2.1 + , tasty-golden >= 2.3.5 + , tasty-hedgehog >= 1.1.0.0 + , tasty-hunit >= 0.10.0.3 + , temporary >= 1.3 + , terminal-size >= 0.3.2.1 + , testing-type-modifiers >= 0.1.0.1 + , text-short >= 0.1.5 + , th-abstraction >= 0.4.3.0 + , th-compat >= 0.1.3 + , th-expand-syns >= 0.4.9.0 + , th-extras >= 0.0.0.6 + , th-lift >= 0.8.2 + , th-lift-instances >= 0.1.19 + , th-orphans >= 0.13.12 + , th-reify-many >= 0.1.10 + , th-utilities >= 0.2.4.3 + , these >= 1.1.1.1 + , time-compat >= 1.9.6.1 + , transformers-base >= 0.4.6 + , transformers-compat >= 0.7.1 + , type-equality >= 1 + , typed-process >= 0.2.8.0 + , unbounded-delays >= 0.1.1.1 + , universe-base >= 1.1.3 + , unliftio-core >= 0.2.0.1 + , unordered-containers >= 0.2.16.0 + , uuid-types >= 1.0.5 + , vector >= 0.12.3.1 + , vector-algorithms >= 0.8.0.4 + , void >= 0.7.3 + , wcwidth >= 0.0.2 + , witherable >= 0.4.2 + , wl-pprint-annotated >= 0.1.0.1 + , word-array >= 0.1.0.0 + , secp256k1-haskell >= 0.6 + , inline-r >= 0.10.5 + '' + ); + }; - projectFor = projectForGhc ghcVersion; + projectForGhc = compiler-nix-name: system: + let + pkgs = pkgsFor system; + pkgs' = pkgsFor' system; + pkgSet = pkgs.haskell-nix.cabalProject' (applyPlutarchDep pkgs { + src = ./.; + inherit compiler-nix-name; + shell = { + withHoogle = true; + + exactDeps = true; + + # We use the ones from Nixpkgs, since they are cached reliably. + # Eventually we will probably want to build these with haskell.nix. + nativeBuildInputs = [ + pkgs'.cabal-install + pkgs'.hlint + pkgs'.haskellPackages.cabal-fmt + (fourmoluFor system) + pkgs'.nixpkgs-fmt + pkgSet.hsPkgs.hspec-discover.components.exes.hspec-discover + (hlsFor compiler-nix-name system) + ]; + }; + }); + in + pkgSet; + + projectFor = projectForGhc defaultGhcVersion; projectFor810 = projectForGhc "ghc8107"; formatCheckFor = system: let - pkgs = nixpkgsFor system; - pkgs' = nixpkgsFor' system; - t = pkgs.haskell-nix.tools ghcVersion { inherit (tools) fourmolu haskell-language-server; }; + pkgs' = pkgsFor' system; in - pkgs.runCommand "format-check" + pkgs'.runCommand "format-check" { - nativeBuildInputs = [ pkgs'.haskellPackages.cabal-fmt pkgs'.nixpkgs-fmt t.fourmolu ]; + nativeBuildInputs = [ pkgs'.haskellPackages.cabal-fmt pkgs'.nixpkgs-fmt (fourmoluFor system) ]; } '' export LC_CTYPE=C.UTF-8 export LC_ALL=C.UTF-8 @@ -494,11 +406,11 @@ haddock = system: let - pkgs = nixpkgsFor system; + pkgs = pkgsFor system; sphinxcontrib-haddock = - pkgs.callPackage plutus.inputs.sphinxcontrib-haddock { pythonPackages = pkgs.python3Packages; }; + pkgs.callPackage inputs.plutus.inputs.sphinxcontrib-haddock { pythonPackages = pkgs.python3Packages; }; haddock-combine = pkgs.callPackage "${inputs.plutus}/nix/lib/haddock-combine.nix" { - ghc = pkgs.haskell-nix.compiler.${ghcVersion}; + ghc = pkgs.haskell-nix.compiler.${defaultGhcVersion}; inherit (sphinxcontrib-haddock) sphinxcontrib-haddock; }; # If you use this, filter out pretty-show, it doesn't work if not. @@ -528,10 +440,39 @@ ''; }; }; + plutarchWebsiteStatic = system: + let + pkgs = pkgsFor system; + configFile = (pkgs.formats.yaml { }).generate "emanote-configFile" { + template.baseUrl = "/"; # Use this when pushing to github.io: "/plutarch/"; + }; + configDir = pkgs.runCommand "emanote-configDir" { } '' + mkdir -p $out + cp ${configFile} $out/index.yaml + ''; + in + pkgs.runCommand "plutarch-docs-html" { } + '' + mkdir $out + ${inputs.emanote.defaultPackage.${system}}/bin/emanote \ + --layers "${self}/docs;${configDir}" \ + gen $out + ''; + plutarchWebsiteLive = system: path: + rec { + type = "app"; + # '' is required for escaping ${} in nix + script = (pkgsFor system).writers.writeBash "emanoteLiveReload.sh" '' + set -xe + export PORT="''${EMANOTE_PORT:-7072}" + ${inputs.emanote.defaultPackage.${system}}/bin/emanote --layers ${path} run --port "$PORT" + ''; + program = builtins.toString script; + }; # Checks the shell script using ShellCheck checkedShellScript = system: name: text: - ((nixpkgsFor system).writeShellApplication { + ((pkgsFor system).writeShellApplication { inherit name text; }) + "/bin/${name}"; @@ -542,63 +483,52 @@ in { type = "app"; - program = checkedShellScript system "plutatch-test-${name}" + program = checkedShellScript system "plutarch-test-${name}" '' - cd ${self}/plutarch-test ${flake.packages."plutarch-test:exe:plutarch-test"}/bin/plutarch-test; ''; }; # Take a flake app (identified as the key in the 'apps' set), and return a # derivation that runs it in the compile phase. - # + # # In effect, this allows us to run an 'app' as part of the build process (eg: in CI). flakeApp2Derivation = system: appName: - (nixpkgsFor system).runCommand appName { } "${self.apps.${system}.${appName}.program} | tee $out"; + (pkgsFor system).runCommand appName { } "${self.apps.${system}.${appName}.program} | tee $out"; in { - inherit extraSources cabalProjectLocal haskellModule tools; + inherit hlsFor hlsFor' applyPlutarchDep; - # Build matrix. Plutarch is built against different GHC versions, and 'development' flag. + # Build matrix. Plutarch is built against different GHC versions. projectMatrix = { - ghc9 = { - nodev = perSystem (system: (projectFor false system)); - dev = perSystem (system: (projectFor true system)); - }; - ghc810 = { - nodev = perSystem (system: (projectFor810 false system)); - dev = perSystem (system: (projectFor810 true system)); - }; + ghc9 = perSystem projectFor; + ghc810 = perSystem projectFor810; }; # Default build configuration. - project = self.projectMatrix.ghc9.nodev; + project = self.projectMatrix.ghc9; flake = perSystem (system: self.project.${system}.flake { }); - haddockProject = perSystem (projectFor false); + haddockProject = self.project; + ghc810Flake = perSystem (system: self.projectMatrix.ghc810.${system}.flake { }); packages = perSystem (system: self.flake.${system}.packages // { haddock = haddock system; + website = plutarchWebsiteStatic system; }); checks = perSystem (system: self.flake.${system}.checks // { formatCheck = formatCheckFor system; - benchmark = (nixpkgsFor system).runCommand "benchmark" { } "${self.apps.${system}.benchmark.program} | tee $out"; - test-ghc9-nodev = flakeApp2Derivation system "test-ghc9-nodev"; - test-ghc9-dev = flakeApp2Derivation system "test-ghc9-dev"; - test-ghc810-nodev = flakeApp2Derivation system "test-ghc810-nodev"; - test-ghc810-dev = flakeApp2Derivation system "test-ghc810-dev"; - "ghc810-plutarch:lib:plutarch" = (self.projectMatrix.ghc810.nodev.${system}.flake { }).packages."plutarch:lib:plutarch"; - "ghc810-plutarch:lib:plutarch-test" = (self.projectMatrix.ghc810.nodev.${system}.flake { }).packages."plutarch-test:lib:plutarch-test"; - "ghc810-plutarch:lib:plutarch-benchmark" = (self.projectMatrix.ghc810.nodev.${system}.flake { }).packages."plutarch-benchmark:lib:plutarch-benchmark"; + test-ghc9 = flakeApp2Derivation system "test-ghc9"; + hls = checkedShellScript system "hls" "${self.project.${system}.pkgs.haskell-language-server}/bin/haskell-language-server"; }); - # Because `nix flake check` does not work with haskell.nix (due to IFD), + # Because `nix flake check` does not work with haskell.nix (due to IFD), # we provide this attribute for running the checks locally, using: # nix build .#check.x86_64-linux check = perSystem (system: - (nixpkgsFor system).runCommand "combined-test" + (pkgsFor system).runCommand "combined-test" { checksss = builtins.attrValues self.checks.${system}; } '' @@ -610,59 +540,29 @@ apps = perSystem (system: self.flake.${system}.apps // { - test-ghc9-nodev = plutarchTestApp system "ghc9-nodev" self.projectMatrix.ghc9.nodev; - test-ghc9-dev = plutarchTestApp system "ghc9-dev" self.projectMatrix.ghc9.dev; - test-ghc810-nodev = plutarchTestApp system "ghc810-nodev" self.projectMatrix.ghc810.nodev; - test-ghc810-dev = plutarchTestApp system "ghc810-dev" self.projectMatrix.ghc810.dev; - # TODO: The bellow apps will be removed eventually. - benchmark = { - type = "app"; - program = "${self.flake.${system}.packages."plutarch-benchmark:bench:benchmark"}/bin/benchmark"; - }; - benchmark-diff = { - type = "app"; - program = "${self.flake.${system}.packages."plutarch-benchmark:exe:benchmark-diff"}/bin/benchmark-diff"; - }; + test-ghc9 = plutarchTestApp system "ghc9" self.projectMatrix.ghc9; + + # `nix run .#docs` should be run from the Git repo. + docs = plutarchWebsiteLive system "./docs"; + # `nix run github:Plutonomicon/plutarch#website` can be run from anywhere + website = plutarchWebsiteLive system "${self}/docs"; } ); - devShell = perSystem (system: self.flake.${system}.devShell); - effects = { src }: + devShells = perSystem (system: + { + "ghc9" = self.flake.${system}.devShell; + }); + + devShell = perSystem (system: self.devShells.${system}."ghc9"); + + effects = { ref, ... }: let pkgs = nixpkgs.legacyPackages.x86_64-linux; hci-effects = hercules-ci-effects.lib.withPkgs pkgs; in { - # Hercules 0.9 will allow us to calculate the merge-base so we can test all PRs. - # Right now we just hardcode this effect to test every commit against - # origin/staging. We set != "refs/head/master" so that merges into master don't - # cause a lot of unnecessary bogus benchmarks to appear in CI for the time - # being. - benchmark-diff = hci-effects.runIf (src.ref != "refs/heads/master") ( - hci-effects.mkEffect { - src = self; - buildInputs = with pkgs; [ git nixFlakes ]; - effectScript = '' - git clone https://github.com/Plutonomicon/plutarch.git plutarch - cd plutarch - - git checkout $(git merge-base origin/staging ${src.rev}) - nix --extra-experimental-features 'nix-command flakes' run .#benchmark -- --csv > before.csv - - git checkout ${src.rev} - nix --extra-experimental-features 'nix-command flakes' run .#benchmark -- --csv > after.csv - - echo - echo - echo "Benchmark diff between $(git merge-base origin/staging ${src.rev}) and ${src.rev}:" - echo - echo - - nix --extra-experimental-features 'nix-command flakes' run .#benchmark-diff -- before.csv after.csv - ''; - } - ); - gh-pages = hci-effects.runIf (src.ref == "refs/heads/master") ( + gh-pages = hci-effects.runIf (ref == "refs/heads/master") ( hci-effects.mkEffect { src = self; buildInputs = with pkgs; [ openssh git ]; @@ -689,11 +589,6 @@ } ); }; - - ciNix = args@{ src }: flake-compat-ci.lib.recurseIntoFlakeWith { - flake = self; - systems = [ "x86_64-linux" ]; - effectsArgs = args; - }; + herculesCI.ciSystems = [ "x86_64-linux" ]; }; } diff --git a/plutarch-benchmark/README.md b/plutarch-benchmark/README.md deleted file mode 100644 index cbbf2d9d8..000000000 --- a/plutarch-benchmark/README.md +++ /dev/null @@ -1,39 +0,0 @@ -# `plutarch-benchmark` - -**NOTE**: These benchmarks will soon be removed, to be replaced by the golden tests in `./plutarch-test`. - -```sh -# If running from repo root: -cabal bench plutarch-benchmark -# Or, if running from this sub directory: -cabal bench -``` - -This will write the benchmark report to `bench.csv` as well as output a table view of the same. - -## Benchmarking a commit -To run benchmarks on a particular commit, - -``` -nix run github:Plutonomicon/plutarch/#benchmark -``` - -You can also emit a `.csv` file into stdout by passing the `--csv` flag: - -``` -nix run github:Plutonomicon/plutarch/#benchmark -- --csv -``` - -## Benchmarking in CI - -Note that you can also view these benchmarks on a per-commit basis by looking at Hercules CI logs. Go to the Hercules CI job run for a given commit, and navigate to the `checks.x86_64-linux.benchmark` page in the Attributes table, and then click on the "Log" header to view its output. - -Additionally, a Hercules Effect to diff benchmarks between commits is created for PRs into staging. This is findable from the effects link on the PR. - -## Diffing two `.csv` files - -You can diff two previous result files using the `benchmark-diff` binary: - -``` -nix run .#benchmark-diff -- -``` diff --git a/plutarch-benchmark/bench/Main.hs b/plutarch-benchmark/bench/Main.hs deleted file mode 100644 index 781ce8f12..000000000 --- a/plutarch-benchmark/bench/Main.hs +++ /dev/null @@ -1,427 +0,0 @@ -{-# LANGUAGE QualifiedDo #-} - -module Main (main) where - -import Control.Monad.Trans.Cont (cont, runCont) -import Data.ByteString (ByteString) -import Plutarch (ClosedTerm) -import Plutarch.Api.V1 -import Plutarch.Benchmark (NamedBenchmark, bench, bench', benchGroup, benchMain) -import Plutarch.Bool -import Plutarch.Builtin -import qualified Plutarch.List as List -import qualified Plutarch.Monadic as P -import Plutarch.Prelude -import Plutus.V1.Ledger.Address (Address (Address)) -import Plutus.V1.Ledger.Api (DCert (DCertGenesis), toData) -import Plutus.V1.Ledger.Contexts (ScriptPurpose (Certifying, Minting, Rewarding, Spending), TxOutRef (TxOutRef)) -import Plutus.V1.Ledger.Credential ( - Credential (PubKeyCredential, ScriptCredential), - StakingCredential (StakingPtr), - ) - -main :: IO () -main = do - benchMain benchmarks - -benchmarks :: [NamedBenchmark] -benchmarks = - benchGroup - "types" - [ benchGroup "int" integerBench - , benchGroup "bool" boolBench - , benchGroup "builtin:intlist" intListBench - , benchGroup "data" dataBench - , benchGroup "syn" syntaxBench - ] - -integerBench :: [[NamedBenchmark]] -integerBench = - [ -- Calling add twice - benchGroup - "add(2)" - $ let addInlined :: Term s PInteger -> Term s PInteger -> Term s PInteger - addInlined x y = x + y + 1 - addUnhoisted :: Term s (PInteger :--> PInteger :--> PInteger) - addUnhoisted = plam $ \x y -> x + y + 1 - addHoisted :: Term s (PInteger :--> PInteger :--> PInteger) - addHoisted = phoistAcyclic $ plam $ \x y -> x + y + 1 - in [ bench "inlined" $ addInlined 12 32 + addInlined 5 4 - , bench "unhoist" $ addUnhoisted # 12 # 32 + addUnhoisted # 5 # 4 - , bench "hoisted" $ addHoisted # 12 # 32 + addHoisted # 5 # 4 - ] - ] - -boolBench :: [[NamedBenchmark]] -boolBench = - let true = pconstant @PBool True - false = pconstant @PBool False - pandNoHoist = phoistAcyclic $ plam $ \x y -> pif' # x # y # (pdelay $ pcon PFalse) - in [ benchGroup - "and" - [ bench "strict" $ pand' # true # false - , bench "lazy" $ (#&&) true false - , -- Calling `pand` twice. - bench "pand(2)" $ - let x = pand # true # pdelay false - in pand # true # x - , bench "pand(2):unhoisted" $ - let x = pandNoHoist # true # pdelay false - in pandNoHoist # true # x - ] - ] - -intListBench :: [[NamedBenchmark]] -intListBench = - let numList = pconstant @(PBuiltinList PInteger) [1 .. 5] - in [ bench "phead" $ List.phead # numList - , bench "ptail" $ List.ptail # numList - , -- Accessing the first two elements, and adds them. - benchGroup - "x1+x2" - [ -- Via HeadList and TailList only - bench "builtin" $ - (List.phead #$ List.ptail # numList) + (List.phead # numList) - , -- Via ChooseList (twice invoked) - bench "pmatch" $ - pmatch numList $ \case - PNil -> perror - PCons x xs -> - pmatch xs $ \case - PNil -> perror - PCons y _ -> - x + y - ] - , -- Various ways to uncons a list - benchGroup - "uncons" - [ -- ChooseList builtin, like uncons but fails on null lists - bench "ChooseList" $ - pmatch numList $ \case - PNil -> perror - PCons _x xs -> - xs - , -- Retrieving head and tail of a list - bench "head-and-tail" $ - plet (List.phead # numList) $ \_x -> - List.ptail # numList - , -- Retrieve head and tail using builtins, but fail on null lists. - bench "head-and-tail-and-null" $ - plet (List.pnull # numList) $ \isEmpty -> - pmatch isEmpty $ \case - PTrue -> perror - PFalse -> plet (List.phead # numList) $ \_x -> - List.ptail # numList - ] - , bench - "plength" - $ List.plength # pconstant @(PBuiltinList PInteger) [1, 2, 3, 4, 5, 6, 7, 8, 9, 0] - , bench - "pelem" - $ List.pelem # 1 # pconstant @(PBuiltinList PInteger) [5, 2, 3, 4, 7, 5, 1, 6, 2] - , bench - "pall" - $ List.pall @PBuiltinList @PInteger # plam (const $ pconstant @PBool False) # pconstant [1, 2, 3, 4, 5, 6] - , benchGroup - "plistEquals" - [ bench "==(n=3)" $ List.plistEquals @PBuiltinList @PInteger # pconstant [1, 2, 3] # pconstant [1, 2, 3] - , bench "/=(n=4)" $ List.plistEquals @PBuiltinList @PInteger # pconstant [1, 2, 3, 4] # pconstant [1, 2, 3] - , bench "/=(empty;n=3)" $ List.plistEquals @PBuiltinList @PInteger # pconstant [] # pconstant [1, 2, 3] - ] - , benchGroup - "primitives" - [ bench' $ plam $ \_ -> pconstant True - , bench' $ plam $ \_ -> (0 :: Term _ PInteger) - , bench' $ plam $ \_ -> (1 :: Term _ PInteger) - , bench' $ plam $ \_ -> (512 :: Term _ PInteger) - , bench' $ plam $ \_ -> (1048576 :: Term _ PInteger) - , bench' $ plam $ \_ -> pconstant ("1" :: ByteString) - , bench' $ plam $ \_ -> pconstant ("1111111" :: ByteString) - , bench' $ plam $ \_ -> pconstant ([()] :: [()]) - , bench' $ plam $ \_ -> pconstant () - , bench' $ pconstant () - , bench' $ plam $ \x -> x - , bench' $ plam $ \_ -> (plam (+) :: Term _ (PInteger :--> PInteger :--> PInteger)) - , bench' $ (plam (+) :: Term _ (PInteger :--> PInteger :--> PInteger)) - ] - ] - -dataBench :: [[NamedBenchmark]] -dataBench = - [ benchGroup "deconstruction" deconstrBench - , benchGroup - "pmatch-pfield" - -- These two should ideally have the exact same efficiency. - [ benchGroup - "pmatch" - [ bench "newtype" $ P.do - let addr = pconstant $ Address (PubKeyCredential "ab") Nothing - PAddress addrFields <- pmatch addr - y <- pletFields @'["credential", "stakingCredential"] addrFields - ppairDataBuiltin # hrecField @"credential" y # hrecField @"stakingCredential" y - ] - , benchGroup - "pfield" - [ bench "newtype" $ P.do - let addr = pconstant $ Address (PubKeyCredential "ab") Nothing - y <- pletFields @'["credential", "stakingCredential"] addr - ppairDataBuiltin # hrecField @"credential" y # hrecField @"stakingCredential" y - ] - ] - , benchGroup - "pfield-pletFields" - -- These two should ideally have the exact same efficiency. - [ benchGroup - "pfield" - [ bench "single" $ P.do - let addr = pconstant $ Address (PubKeyCredential "ab") Nothing - pfromData $ pfield @"credential" # addr - ] - , benchGroup - "pletFields" - [ bench "single" $ P.do - let addr = pconstant $ Address (PubKeyCredential "ab") Nothing - y <- pletFields @'["credential"] addr - pfromData $ hrecField @"credential" y - ] - ] - ] - -{- | For comparing typed and untyped data deconstruction approaches. - -We ideally want the typed and raw versions to have as little deviation as possible. --} -deconstrBench :: [[NamedBenchmark]] -deconstrBench = - [ benchGroup - "matching" - $ [ benchGroup - "typed" - [ bench "newtype" $ - plam - ( \x -> P.do - PAddress addrFields <- pmatch x - addrFields - ) - # pconstant addrPC - , bench "sumtype(ignore-fields)" $ - plam - ( \x -> P.do - PMinting _ <- pmatch x - pconstant () - ) - # pconstant minting - , bench "sumtype(partial-match)" $ - plam - ( \x -> P.do - PMinting hs <- pmatch x - hs - ) - # pconstant minting - , benchGroup "sumtype(exhaustive)" $ - benchPurpose $ - plam - ( \x -> P.do - purp <- pmatch x - case purp of - PMinting f -> plet f $ const $ phexByteStr "01" - PSpending f -> plet f $ const $ phexByteStr "02" - PRewarding f -> plet f $ const $ phexByteStr "03" - PCertifying f -> plet f $ const $ phexByteStr "04" - ) - , benchGroup "sumtype(exhaustive)(ignore-fields)" $ - benchPurpose $ - plam - ( \x -> P.do - purp <- pmatch x - case purp of - PMinting _ -> phexByteStr "01" - PSpending _ -> phexByteStr "02" - PRewarding _ -> phexByteStr "03" - PCertifying _ -> phexByteStr "04" - ) - ] - , benchGroup - "raw" - [ bench "newtype" $ - plam - ( \x -> - psndBuiltin #$ pasConstr # x - ) - #$ pconstant - $ toData addrPC - , bench "sumtype(ignore-fields)" $ - plam - ( \x -> - pif - ((pfstBuiltin #$ pasConstr # x) #== 0) - (pconstant ()) - perror - ) - #$ pconstant - $ toData minting - , bench "sumtype(partial-match)" $ - plam - ( \x -> - plet (pasConstr # x) $ \d -> - pif - (pfstBuiltin # d #== 0) - (psndBuiltin # d) - perror - ) - #$ pconstant - $ toData minting - , benchGroup "sumtype(exhaustive)" $ - benchPurpose' $ - plam - ( \x -> P.do - d <- plet $ pasConstr # x - constr <- plet $ pfstBuiltin # d - _ <- plet $ psndBuiltin # d - pif - (constr #== 1) - (phexByteStr "02") - $ pif - (constr #== 2) - (phexByteStr "03") - $ pif - (constr #== 3) - (phexByteStr "04") - $ phexByteStr "01" - ) - , benchGroup "sumtype(exhaustive)(ignore-fields)" $ - benchPurpose' $ - plam - ( \x -> P.do - constr <- plet $ pfstBuiltin #$ pasConstr # x - pif - (constr #== 1) - (phexByteStr "02") - $ pif - (constr #== 2) - (phexByteStr "03") - $ pif - (constr #== 3) - (phexByteStr "04") - $ phexByteStr "01" - ) - ] - ] - , benchGroup - "fields" - $ [ benchGroup - "typed" - [ bench "extract-single" $ - plam - ( \x -> - pfield @"credential" # x - ) - # pconstant addrSC - ] - , benchGroup - "raw" - [ bench "extract-single" $ - plam - ( \x -> - phead #$ psndBuiltin #$ pasConstr # x - ) - #$ pconstant - $ toData addrSC - ] - ] - , benchGroup - "combined" - [ benchGroup - "typed" - [ bench "toValidatorHash" $ - plam - ( \x -> P.do - cred <- pmatch . pfromData $ pfield @"credential" # x - case cred of - PPubKeyCredential _ -> pcon PNothing - PScriptCredential credFields -> pcon . PJust $ pto $ pfromData $ pfield @"_0" # credFields - ) - # pconstant addrSC - ] - , benchGroup - "raw" - [ bench "toValidatorHash" $ - plam - ( \x -> - P.do - let cred = phead #$ psndBuiltin #$ pasConstr # x - deconstrCred <- plet $ pasConstr # cred - pif - (pfstBuiltin # deconstrCred #== 0) - (pcon PNothing) - $ pcon . PJust $ pasByteStr #$ phead #$ psndBuiltin # deconstrCred - ) - #$ pconstant - $ toData addrSC - ] - ] - ] - where - addrSC = Address (ScriptCredential "ab") Nothing - addrPC = Address (PubKeyCredential "ab") Nothing - minting = Minting "" - spending = Spending (TxOutRef "ab" 0) - rewarding = Rewarding (StakingPtr 42 0 7) - certifying = Certifying DCertGenesis - -- Bench given function feeding in all 4 types of script purpose (typed). - benchPurpose :: ClosedTerm (PScriptPurpose :--> PByteString) -> [[NamedBenchmark]] - benchPurpose f = - [ bench "minting" $ f # pconstant minting - , bench "spending" $ f # pconstant spending - , bench "rewarding" $ f # pconstant rewarding - , bench "certifying" $ f # pconstant certifying - ] - - -- Bench given function feeding in all 4 types of script purpose (untyped). - benchPurpose' :: ClosedTerm (PData :--> PByteString) -> [[NamedBenchmark]] - benchPurpose' f = - [ bench "minting" $ f #$ pconstant $ toData minting - , bench "spending" $ f #$ pconstant $ toData spending - , bench "rewarding" $ f #$ pconstant $ toData rewarding - , bench "certifying" $ f #$ pconstant $ toData certifying - ] - --- | Nested lambda, vs do-syntax vs cont monad. -syntaxBench :: [[NamedBenchmark]] -syntaxBench = - let integerList :: [Integer] -> Term s (PList PInteger) - integerList xs = List.pconvertLists #$ pconstant @(PBuiltinList PInteger) xs - xs = integerList [1 .. 10] - in [ benchGroup - "ttail-pmatch" - [ -- We expect all these benchmarks to produce equivalent numbers - bench "nested" $ do - pmatch xs $ \case - PSCons _x xs' -> do - pmatch xs' $ \case - PSCons _ xs'' -> - xs'' - PSNil -> perror - PSNil -> perror - , bench "do" $ - P.do - PSCons _ xs' <- pmatch xs - PSCons _ xs'' <- pmatch xs' - xs'' - , bench "cont" $ - flip runCont id $ do - ls <- cont $ pmatch xs - case ls of - PSCons _ xs' -> do - ls' <- cont $ pmatch xs' - case ls' of - PSCons _ xs'' -> pure xs'' - PSNil -> pure perror - PSNil -> pure perror - , bench "termcont" $ - unTermCont $ do - PSCons _ xs' <- TermCont $ pmatch xs - PSCons _ xs'' <- TermCont $ pmatch xs' - pure xs'' - ] - ] diff --git a/plutarch-benchmark/benchmark-diff/Main.hs b/plutarch-benchmark/benchmark-diff/Main.hs deleted file mode 100644 index b8eace681..000000000 --- a/plutarch-benchmark/benchmark-diff/Main.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Main (main) where - -import Plutarch.Benchmark (decodeBenchmarks, diffBenchmarks, renderDiffTable) - -import qualified Data.ByteString.Lazy as BSL -import System.Environment (getArgs) -import qualified Text.PrettyPrint.Boxes as B - --------------------------------------------------------------------------------- - -main :: IO () -main = - getArgs >>= \case - [oldPath, newPath] -> do - Right old <- decodeBenchmarks <$> BSL.readFile oldPath - Right new <- decodeBenchmarks <$> BSL.readFile newPath - - putStrLn . B.render . renderDiffTable $ diffBenchmarks old new - _ -> usage - -usage :: IO () -usage = - putStrLn "usage: benchmark-diff [old] [new]" diff --git a/plutarch-benchmark/src/Plutarch/Benchmark.hs b/plutarch-benchmark/src/Plutarch/Benchmark.hs deleted file mode 100644 index 2d9201a0f..000000000 --- a/plutarch-benchmark/src/Plutarch/Benchmark.hs +++ /dev/null @@ -1,243 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - --- | Benchmark (exbudget and script size) for Plutus scripts -module Plutarch.Benchmark ( - -- | * Types - Benchmark, - NamedBenchmark, - ScriptSizeBytes, - -- | * Benchmark an arbitraty Plutus script - benchmarkScript, - benchmarkScript', - -- | * Benchmark entrypoints - bench, - bench', - benchGroup, - benchMain, - -- | * Working with benchmark results - decodeBenchmarks, - diffBenchmarks, - renderDiffTable, -) where - -import Codec.Serialise (serialise) -import Control.Arrow ((&&&)) -import Control.Monad (mzero) -import Data.Aeson (ToJSON) -import qualified Data.ByteString.Lazy as BSL -import Data.Coerce (coerce) -import qualified Data.Map.Strict as Map -import Data.Vector (Vector, (!)) -import qualified Data.Vector as Vector -import System.Environment (getArgs) -import Text.PrettyPrint.Boxes ((//)) -import qualified Text.PrettyPrint.Boxes as B - -import qualified Data.ByteString.Lazy as LB -import qualified Data.ByteString.Short as SBS -import Data.Csv ( - DefaultOrdered, - ToField, - ToNamedRecord, - header, - namedRecord, - (.!), - (.=), - ) -import qualified Data.Csv as Csv -import Data.Int (Int64) -import qualified Data.List as List -import Data.Maybe (fromJust) -import GHC.Generics (Generic) -import GHC.Stack (HasCallStack) -import Plutarch (ClosedTerm, compile, printTerm) -import Plutus.V1.Ledger.Api ( - ExBudget (ExBudget), - ExCPU (ExCPU), - ExMemory (ExMemory), - Script, - ) -import qualified Plutus.V1.Ledger.Api as Plutus - --------------------------------------------------------------------------------- - --- | Benchmark the given script -benchmarkScript :: String -> Script -> NamedBenchmark -benchmarkScript name = NamedBenchmark . (name,) . benchmarkScript' - -benchmarkScript' :: Script -> Benchmark -benchmarkScript' = - uncurry mkBenchmark . (evalScriptCounting &&& (fromInteger . toInteger . SBS.length)) . serialiseScriptShort - where - mkBenchmark :: ExBudget -> Int64 -> Benchmark - mkBenchmark (ExBudget cpu mem) = Benchmark cpu mem . ScriptSizeBytes - - serialiseScriptShort :: Script -> SBS.ShortByteString - serialiseScriptShort = SBS.toShort . LB.toStrict . serialise -- Using `flat` here breaks `evalScriptCounting` - evalScriptCounting :: HasCallStack => Plutus.SerializedScript -> Plutus.ExBudget - evalScriptCounting script = - let costModel = fromJust Plutus.defaultCostModelParams - (_logout, e) = Plutus.evaluateScriptCounting Plutus.Verbose costModel script [] - in case e of - Left evalErr -> error ("Eval Error: " <> show evalErr) - Right exbudget -> exbudget - -data Benchmark = Benchmark - { exBudgetCPU :: ExCPU - -- ^ CPU budget used by the script - , exBudgetMemory :: ExMemory - -- ^ Memory budget used by the script - , scriptSizeBytes :: ScriptSizeBytes - -- ^ Size of Plutus script in bytes - } - deriving stock (Show, Generic) - deriving anyclass (ToJSON) - -newtype ScriptSizeBytes = ScriptSizeBytes Int64 - deriving stock (Eq, Ord, Show, Generic) - deriving newtype (Num, ToField) - deriving newtype (ToJSON) - -{- | A `Benchmark` with a name. - - Handy for writing CSV files with headers. --} -newtype NamedBenchmark = NamedBenchmark (String, Benchmark) - deriving stock (Show, Generic) - deriving newtype (ToJSON) - -instance ToNamedRecord NamedBenchmark where - toNamedRecord (NamedBenchmark (name, Benchmark {..})) = - namedRecord ["name" .= name, "cpu" .= exBudgetCPU, "mem" .= exBudgetMemory, "size" .= scriptSizeBytes] - -instance DefaultOrdered NamedBenchmark where - headerOrder _ = header ["name", "cpu", "mem", "size"] - --- | Create a benchmark group with a shared prefix -benchGroup :: String -> [[NamedBenchmark]] -> [NamedBenchmark] -benchGroup groupName bs = - [NamedBenchmark (groupName ++ ":" ++ name, benchmark) | NamedBenchmark (name, benchmark) <- concat bs] - --- | Create a benchmark with a name -bench :: String -> ClosedTerm a -> [NamedBenchmark] -bench name prog = - [coerce . benchmarkScript name $ compile prog] - --- | Create a benchmark with itself as name -bench' :: ClosedTerm a -> [NamedBenchmark] -bench' prog = bench (init . drop (length ("(program 1.0.0 " :: String)) $ printTerm prog) prog - --- | Decode benchmark results from a CSV file -decodeBenchmarks :: LB.ByteString -> Either String [NamedBenchmark] -decodeBenchmarks = - let (#!) :: Num a => Vector Csv.Field -> Int -> Csv.Parser a - (#!) v f = fmap fromInteger . Csv.parseField $ v ! f - in fmap Vector.toList - <$> Csv.decodeWithP - ( \case - v - | length v == 4 -> - fmap NamedBenchmark $ - (,) <$> v .! 0 <*> (Benchmark <$> v #! 1 <*> v #! 2 <*> v #! 3) - _ | otherwise -> mzero - ) - Csv.defaultDecodeOptions - Csv.HasHeader - -data BenchmarkDiffs = BenchmarkDiffs - { dropped :: [NamedBenchmark] - , changed :: [BenchmarkDiff] - , added :: [NamedBenchmark] - } - deriving stock (Show, Generic) - -data BenchmarkDiff = BenchmarkDiff - { benchmark :: Benchmark - , change :: (Double, Double, Double) - , name :: String - } - deriving stock (Show, Generic) - -diffBenchmark :: String -> Benchmark -> Benchmark -> Maybe BenchmarkDiff -diffBenchmark - name - (Benchmark (ExCPU oldCpu) (ExMemory oldMem) (ScriptSizeBytes oldSize)) - new@(Benchmark (ExCPU cpu) (ExMemory mem) (ScriptSizeBytes size)) - | oldCpu /= cpu || oldMem /= mem || oldSize /= size = - let pctChange old new = softRound (fromInteger (toInteger new - toInteger old) / fromInteger (toInteger $ max old new) * 100) - - softRound n = fromInteger @Double (round @Double @Integer n * 10) / 10 - in Just $ - BenchmarkDiff - { benchmark = new - , change = (pctChange oldCpu cpu, pctChange oldMem mem, pctChange oldSize size) - , name = name - } - | otherwise = Nothing - -diffBenchmarks :: [NamedBenchmark] -> [NamedBenchmark] -> BenchmarkDiffs -diffBenchmarks (Map.fromList . coerce -> old) (Map.fromList . coerce -> new) = - BenchmarkDiffs - { changed = - Map.elems $ - Map.mapMaybeWithKey - ( \k new -> - old Map.!? k >>= \old -> diffBenchmark k old new - ) - new - , dropped = coerce . Map.toList $ old `Map.difference` new - , added = coerce . Map.toList $ new `Map.difference` old - } - -renderDiffTable :: BenchmarkDiffs -> B.Box -renderDiffTable (BenchmarkDiffs dropped changed added) = - let renderChange change - | abs change <= 0.01 = B.text "" - | otherwise = B.text $ if change > 0 then "+" <> show change <> "%" else show change <> "%" - - renderResult old diff tag = - [B.text $ show old <> "(" <> tag <> ")", renderChange diff] - - renderBenchmarkDiff :: BenchmarkDiff -> [B.Box] - renderBenchmarkDiff (BenchmarkDiff (Benchmark (ExCPU x) (ExMemory y) (ScriptSizeBytes z)) (dx, dy, dz) name) = - mconcat - [ [B.text name] - , renderResult x dx "cpu" - , renderResult y dy "mem" - , renderResult z dz "bytes" - ] - in B.vsep - 1 - B.top - [ if null dropped then B.nullBox else B.text "Dropped benchmarks:" // renderBudgetTable dropped - , if null changed then B.nullBox else B.text "Changed benchmarks:" // renderTable [renderBenchmarkDiff change | change <- changed] - , if null added then B.nullBox else B.text "Added benchmarks:" // renderBudgetTable added - ] - -renderTable :: [[B.Box]] -> B.Box -renderTable rows = - let alignments = - -- Align all but the first column to the right, because they represent numeric values. - B.left : repeat B.right - in B.hsep 2 B.left . fmap (uncurry B.vcat) $ zip alignments (List.transpose rows) - -renderBudgetTable :: [NamedBenchmark] -> B.Box -renderBudgetTable bs = - renderTable $ - [ [ B.text name - , B.text $ show cpu <> "(cpu)" - , B.text $ show mem <> "(mem)" - , B.text $ show sz <> "(bytes)" - ] - | NamedBenchmark (name, Benchmark (ExCPU cpu) (ExMemory mem) (ScriptSizeBytes sz)) <- bs - ] - -benchMain :: [NamedBenchmark] -> IO () -benchMain benchmarks = - getArgs >>= \case - ["--csv"] -> BSL.putStr $ Csv.encodeDefaultOrderedByName benchmarks - _ -> do - let csv = Csv.encodeDefaultOrderedByName benchmarks - BSL.writeFile "bench.csv" csv - putStrLn "Wrote to bench.csv:" - putStrLn . B.render $ renderBudgetTable benchmarks diff --git a/plutarch-extra/Plutarch/Extra.hs b/plutarch-extra/Plutarch/Extra.hs new file mode 100644 index 000000000..b390b7b96 --- /dev/null +++ b/plutarch-extra/Plutarch/Extra.hs @@ -0,0 +1 @@ +module Plutarch.Extra () where diff --git a/plutarch-extra/Plutarch/Extra/Api.hs b/plutarch-extra/Plutarch/Extra/Api.hs new file mode 100644 index 000000000..92c812bc7 --- /dev/null +++ b/plutarch-extra/Plutarch/Extra/Api.hs @@ -0,0 +1,108 @@ +module Plutarch.Extra.Api ( + pgetContinuingOutputs, + pfindOwnInput, + pparseDatum, +) where + +import Plutarch.Api.V1 ( + PAddress, + PDatum, + PDatumHash, + PTuple, + PTxInInfo, + PTxOut, + PTxOutRef, + ) +import Plutarch.Prelude + +{- | Find the output txns corresponding to the input being validated. + + Takes as arguments the inputs, outputs and the spending transaction referenced + from `PScriptPurpose`. + + __Example:__ + + @ + ctx <- tcont $ pletFields @["txInfo", "purpose"] sc + pmatchC (getField @"purpose" ctx) >>= \case + PSpending outRef' -> do + let outRef = pfield @"_0" # outRef' + inputs = pfield @"inputs" # (getField @"txInfo" ctx) + outputs = pfield @"outputs" # (getField @"txInfo" ctx) + pure $ pgetContinuingOutputs # inputs # outputs # outRef + _ -> + pure $ ptraceError "not a spending tx" + @ +-} +pgetContinuingOutputs :: Term s (PBuiltinList PTxInInfo :--> PBuiltinList PTxOut :--> PTxOutRef :--> PBuiltinList PTxOut) +pgetContinuingOutputs = phoistAcyclic $ + plam $ \inputs outputs outRef -> + pmatch (pfindOwnInput # inputs # outRef) $ \case + PJust tx -> do + let resolved = pfield @"resolved" # tx + outAddr = pfield @"address" # resolved + pfilter # (matches # outAddr) # outputs + PNothing -> + ptraceError "can't get any continuing outputs" + where + matches :: Term s (PAddress :--> PTxOut :--> PBool) + matches = phoistAcyclic $ + plam $ \adr txOut -> + adr #== pfield @"address" # txOut + +{- | Find the input being spent in the current transaction. + + Takes as arguments the inputs, as well as the spending transaction referenced from `PScriptPurpose`. + + __Example:__ + + @ + ctx <- tcont $ pletFields @["txInfo", "purpose"] sc + pmatchC (getField @"purpose" ctx) >>= \case + PSpending outRef' -> do + let outRef = pfield @"_0" # outRef' + inputs = pfield @"inputs" # (getField @"txInfo" ctx) + pure $ pfindOwnInput # inputs # outRef + _ -> + pure $ ptraceError "not a spending tx" + @ +-} +pfindOwnInput :: Term s (PBuiltinList PTxInInfo :--> PTxOutRef :--> PMaybe PTxInInfo) +pfindOwnInput = phoistAcyclic $ + plam $ \inputs outRef -> + pfind # (matches # outRef) # inputs + where + matches :: Term s (PTxOutRef :--> PTxInInfo :--> PBool) + matches = phoistAcyclic $ + plam $ \outref txininfo -> + outref #== pfield @"outRef" # txininfo + +{- | Lookup up the datum given the datum hash. + + Takes as argument the datum assoc list from a `PTxInfo`. Validates the datum + using `PTryFrom`. + + __Example:__ + + @ + pparseDatum @MyType # datumHash #$ pfield @"datums" # txinfo + @ +-} +pparseDatum :: forall a s. PTryFrom PData (PAsData a) => Term s (PDatumHash :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum)) :--> PMaybe (PAsData a)) +pparseDatum = phoistAcyclic $ + plam $ \dh datums -> + pmatch (pfind # (matches # dh) # datums) $ \case + PNothing -> + pcon PNothing + PJust datumTuple -> + let datum :: Term _ PData + datum = pto $ pfromData $ pfield @"_1" # pfromData datumTuple + in pcon $ PJust $ ptryFromData datum + where + matches :: forall k v s. (PEq k, PIsData k) => Term s (k :--> PAsData (PTuple k v) :--> PBool) + matches = phoistAcyclic $ + plam $ \a ab -> + a #== pfield @"_0" # ab + +ptryFromData :: forall a s. PTryFrom PData (PAsData a) => Term s PData -> Term s (PAsData a) +ptryFromData x = unTermCont $ fst <$> tcont (ptryFrom @(PAsData a) x) diff --git a/plutarch-extra/Plutarch/Extra/ByteString.hs b/plutarch-extra/Plutarch/Extra/ByteString.hs new file mode 100644 index 000000000..3f6e7579d --- /dev/null +++ b/plutarch-extra/Plutarch/Extra/ByteString.hs @@ -0,0 +1,25 @@ +module Plutarch.Extra.ByteString (pallBS, pisHexDigit) where + +import Plutarch.Prelude + +pallBS :: Term s ((PInteger :--> PBool) :--> PByteString :--> PBool) +pallBS = phoistAcyclic $ + plam $ \f str -> plet (plengthBS # str) $ \ln -> + let helper :: Term _ (PInteger :--> PBool) + helper = pfix #$ plam $ \self i -> + pif + (i #< ln) + ( pif + (f #$ pindexBS # str # i) + (self # (i + 1)) + (pcon PFalse) + ) + (pcon PTrue) + in helper # 0 + +pisHexDigit :: Term s (PInteger :--> PBool) +pisHexDigit = phoistAcyclic $ + plam $ \chr -> + (chr #<= 57 #&& 48 #<= chr) + #|| (chr #<= 70 #&& 65 #<= chr) + #|| (chr #<= 102 #&& 97 #<= chr) diff --git a/plutarch-extra/Plutarch/Extra/Interval.hs b/plutarch-extra/Plutarch/Extra/Interval.hs new file mode 100644 index 000000000..c329af7ae --- /dev/null +++ b/plutarch-extra/Plutarch/Extra/Interval.hs @@ -0,0 +1,471 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE QualifiedDo #-} + +module Plutarch.Extra.Interval ( + pmember, + pinterval, + pfrom, + pto, + palways, + pnever, + psingleton, + phull, + pintersection, + pcontains, + pbefore, + pafter, +) where + +import Plutarch.Api.V1.Interval ( + PClosure, + PExtended (PFinite, PNegInf, PPosInf), + PInterval (PInterval), + PLowerBound (PLowerBound), + PUpperBound (PUpperBound), + ) +import Plutarch.Bool (pif') +import qualified Plutarch.Monadic as P +import Plutarch.Prelude hiding (psingleton, pto) +import qualified PlutusLedgerApi.V1.Interval as Plutus + +-- check if `a` belongs to interval `i` +pmember :: + forall a (s :: S). + (PEq a, POrd a, PIsData a) => + Term + s + ( PAsData a + :--> PInterval a + :--> PBool + ) +pmember = phoistAcyclic $ plam $ \a i -> pcontains # i # (psingleton # a) + +{- | create an interval that includes all values that are greater than or equal + - to a and smaller than or equal to b +-} +pinterval :: + forall a (s :: S). + PIsData a => + Term + s + ( PAsData a + :--> PAsData a + :--> PInterval a + ) +pinterval = phoistAcyclic $ + plam $ \a b -> + let start :: Term _ (PExtended a) + start = pcon $ PFinite $ pdcons @"_0" # a # pdnil + + end :: Term _ (PExtended a) + end = pcon $ PFinite $ pdcons @"_0" # b # pdnil + in pclosedInterval # start # end + +{- | create an interval that includes all values that are greater than or equal + - to a +-} +pfrom :: forall a s. PIsData a => Term s (PAsData a :--> PInterval a) +pfrom = phoistAcyclic $ + plam $ \a -> + let start :: Term _ (PExtended a) + start = pcon $ PFinite $ pdcons @"_0" # a # pdnil + end :: Term _ (PExtended a) + end = pcon $ PPosInf pdnil + in pclosedInterval # start # end + +{- | create an interval that includes all values that are smaller than or equal + - to a +-} +pto :: forall a (s :: S). PIsData a => Term s (PAsData a :--> PInterval a) +pto = phoistAcyclic $ + plam $ \a -> + let start :: Term _ (PExtended a) + start = pcon $ PNegInf pdnil + + end :: Term _ (PExtended a) + end = pcon $ PFinite $ pdcons @"_0" # a # pdnil + in pclosedInterval # start # end + +-- | create an interval that covers every slot +palways :: forall a (s :: S). (PIsData a, PLiftData a) => Term s (PInterval a) +palways = pconstant Plutus.always + +-- | create an interval that is empty +pnever :: forall a (s :: S). (PIsData a, PLiftData a) => Term s (PInterval a) +pnever = pconstant Plutus.never + +-- | create and interval [a, a] +psingleton :: forall a (s :: S). PIsData a => Term s (PAsData a :--> PInterval a) +psingleton = phoistAcyclic $ + plam $ \a -> + plet (pcon $ PFinite $ pdcons @"_0" # a # pdnil) $ \start -> + pclosedInterval # start # start + +-- | `hull i1 i2` is the smallest interval containing `i1` and `i2` +phull :: + forall a (s :: S). + (PEq a, POrd a, PIsData a) => + Term + s + ( PInterval a + :--> PInterval a + :--> PInterval a + ) +phull = phoistAcyclic $ + plam $ \x' y' -> P.do + x <- pletFields @'["from", "to"] x' + y <- pletFields @'["from", "to"] y' + + let lowerX = x.from + upperX = x.to + lowerY = y.from + upperY = y.to + + lower = pcon $ PLowerBound $ minP # (lToE # lowerX) # (lToE # lowerY) + upper = pcon $ PUpperBound $ maxP # (uToE # upperX) # (uToE # upperY) + + pinterval' # pdata lower # pdata upper + +-- | `intersecion i1 i2` is the largest interval contained in `i1` and `i2` +pintersection :: + forall a (s :: S). + (PEq a, POrd a, PIsData a) => + Term + s + ( PInterval a + :--> PInterval a + :--> PInterval a + ) +pintersection = phoistAcyclic $ + plam $ \x' y' -> P.do + x <- pletFields @'["from", "to"] x' + y <- pletFields @'["from", "to"] y' + + let lowerX = x.from + upperX = x.to + + lowerY = y.from + upperY = y.to + + lower = pcon $ PLowerBound $ maxP # (lToE # lowerX) # (lToE # lowerY) + upper = pcon $ PUpperBound $ minP # (uToE # upperX) # (uToE # upperY) + + pinterval' # pdata lower # pdata upper + +-- | pcontains # a # b is true if the interval `b` is entirely contained in `a` +pcontains :: + forall a (s :: S). + (PEq a, POrd a, PIsData a) => + Term + s + ( PInterval a + :--> PInterval a + :--> PBool + ) +pcontains = phoistAcyclic $ + plam $ \x' y' -> P.do + x <- pletFields @'["from", "to"] x' + y <- pletFields @'["from", "to"] y' + let lowerX = x.from + upperX = x.to + + lowerY = y.from + upperY = y.to + + leqP # (lToE # lowerX) # (lToE # lowerY) #&& leqP # (uToE # upperY) # (uToE # upperX) + +-- | `a` before interval `i` is true if `a` is earlier than the start of `i` +pbefore :: + forall a (s :: S). + (PEq a, POrd a, PIsData a) => + Term + s + ( a + :--> PInterval a + :--> PBool + ) +pbefore = phoistAcyclic $ + plam $ \a y -> + let lower = pfield @"from" # y + in pbefore' # a # (lToE # lower) + +-- | `a` after interval `i` is true if `a` is later than the end of `i` +pafter :: + forall a s. + (PEq a, POrd a, PIsData a) => + Term + s + ( a + :--> PInterval a + :--> PBool + ) +pafter = phoistAcyclic $ + plam $ \a y -> + let upper = pfield @"to" # y + in pafter' # a # (uToE # upper) + +-- | interval from upper and lower +pinterval' :: + forall a (s :: S). + PIsData a => + Term + s + ( PAsData (PLowerBound a) + :--> PAsData (PUpperBound a) + :--> PInterval a + ) +pinterval' = phoistAcyclic $ + plam $ \lower upper -> + pcon $ + PInterval $ + pdcons @"from" # lower + #$ pdcons @"to" # upper # pdnil + +-- | closed interval from PExtended +pclosedInterval :: + forall a (s :: S). + PIsData a => + Term + s + ( PExtended a + :--> PExtended a + :--> PInterval a + ) +pclosedInterval = phoistAcyclic $ + plam $ \start end -> + let closure :: Term _ (PAsData PClosure) + closure = pconstantData True + + upper :: Term _ (PUpperBound a) + upper = + pcon $ + PUpperBound $ + pdcons @"_0" # pdata end #$ pdcons @"_1" + # closure + # pdnil + + lower :: Term _ (PLowerBound a) + lower = + pcon $ + PLowerBound $ + pdcons @"_0" # pdata start #$ pdcons @"_1" + # closure + # pdnil + in pinterval' # pdata lower # pdata upper + +-- | value < endpoint +pbefore' :: + forall a (s :: S). + (PIsData a, POrd a, PEq a) => + Term + s + ( a + :--> EndPoint a + :--> PBool + ) +pbefore' = phoistAcyclic $ + plam $ \a y' -> P.do + y <- pletFields @'["_0", "_1"] y' + yt <- plet $ y._0 + let yc = y._1 + + pif + yc + (pmatch yt (ltE' a)) + (pmatch yt (leqE' a)) + +-- | value > endpoint +pafter' :: + forall a (s :: S). + (PIsData a, POrd a, PEq a) => + Term + s + ( a + :--> EndPoint a + :--> PBool + ) +pafter' = phoistAcyclic $ + plam $ \a y' -> P.do + y <- pletFields @'["_0", "_1"] y' + yt <- plet $ y._0 + let yc = y._1 + + pif + yc + (pmatch yt (gtE' a)) + (pmatch yt (geqE' a)) + +-- | (x :: Term s (EndPoint a)) <= (y :: Term s (EndPoint a)) +leqP :: + forall a (s :: S). + (PIsData a, POrd a, PEq a) => + Term + s + ( EndPoint a + :--> EndPoint a + :--> PBool + ) +leqP = phoistAcyclic $ + plam $ \x' y' -> P.do + x <- pletFields @'["_0", "_1"] x' + y <- pletFields @'["_0", "_1"] y' + + xt <- plet $ x._0 + yt <- plet $ y._0 + + xc <- plet $ x._1 + yc <- plet $ y._1 + + pif + (xc #&& yc #|| (pnot # xc) #&& (pnot # yc)) + (leqE # xt # yt) + (ltE # xt # yt) + +minP :: + forall a (s :: S). + (PIsData a, POrd a, PEq a) => + Term + s + ( EndPoint a + :--> EndPoint a + :--> EndPoint a + ) +minP = phoistAcyclic $ plam $ \x y -> pif' # (leqP # x # y) # x # y + +maxP :: + forall a (s :: S). + (PIsData a, POrd a, PEq a) => + Term + s + ( EndPoint a + :--> EndPoint a + :--> EndPoint a + ) +maxP = phoistAcyclic $ plam $ \x y -> pif' # (leqP # x # y) # y # x + +-- | (x :: Term s (PExtended a)) < (y :: Term s (PExtended b)) +ltE :: + forall a (s :: S). + (POrd a, PIsData a) => + Term + s + ( PExtended a + :--> PExtended a + :--> PBool + ) +ltE = phoistAcyclic $ plam $ \x y -> pmatch x (cont y) + where + cont :: Term _ (PExtended a) -> PExtended a _ -> Term _ PBool + cont y' x' = case x' of + PNegInf _ -> pconstant True + PPosInf _ -> pmatch y' isPosInf + PFinite l -> pmatch y' (ltE' $ pfield @"_0" # l) + +-- | (x :: Term s (PExtended a)) = (y :: Term s (PExtended b)) +eqE :: + forall a (s :: S). + (PEq a, PIsData a) => + Term + s + ( PExtended a + :--> PExtended a + :--> PBool + ) +eqE = phoistAcyclic $ + plam $ \x y -> + let cont x' = case x' of + PNegInf _ -> pmatch y isNegInf + PPosInf _ -> pmatch y isPosInf + PFinite l -> pmatch y (eqE' (pfield @"_0" # l)) + in pmatch x cont + +-- | value < PExtended +ltE' :: + forall a (s :: S). + (POrd a, PIsData a) => + Term s a -> + PExtended a s -> + Term s PBool +ltE' a y' = case y' of + PNegInf _ -> pconstant False + PPosInf _ -> pconstant True + PFinite r -> a #< pfield @"_0" # r + +-- | value > PExtended +gtE' :: + forall a (s :: S). + (POrd a, PIsData a) => + Term s a -> + PExtended a s -> + Term s PBool +gtE' a y' = case y' of + PNegInf _ -> pconstant False + PPosInf _ -> pconstant True + PFinite r -> P.do + b <- plet $ pfield @"_0" # r + b #< a + +-- | value = PExtended +eqE' :: + forall a (s :: S). + (PEq a, PIsData a) => + Term s a -> + PExtended a s -> + Term s PBool +eqE' a y' = case y' of + PFinite r -> P.do + b <- plet $ pfield @"_0" # r + a #== b + _ -> pconstant False + +-- | value <= PExtended +leqE' :: + forall a (s :: S). + (POrd a, PEq a, PIsData a) => + Term s a -> + PExtended a s -> + Term s PBool +leqE' a y = ltE' a y #|| eqE' a y + +-- | value >= PExtended +geqE' :: + forall a (s :: S). + (POrd a, PEq a, PIsData a) => + Term s a -> + PExtended a s -> + Term s PBool +geqE' a y = gtE' a y #|| eqE' a y + +-- | (x :: Term s (PExtended a)) <= (y :: Term s (PExtended b)) +leqE :: + forall a (s :: S). + (PEq a, POrd a, PIsData a) => + Term + s + ( PExtended a + :--> PExtended a + :--> PBool + ) +leqE = phoistAcyclic $ plam $ \x y -> ltE # x # y #|| eqE # x # y + +isNegInf :: PExtended a s -> Term s PBool +isNegInf x = case x of + PNegInf _ -> pconstant True + _ -> pconstant False + +isPosInf :: PExtended a s -> Term s PBool +isPosInf x = case x of + PPosInf _ -> pconstant True + _ -> pconstant False + +type EndPoint a = + PDataRecord + '[ "_0" ':= PExtended a + , "_1" ':= PClosure + ] + +uToE :: Term s (PUpperBound a :--> EndPoint a) +uToE = phoistAcyclic $ plam $ \x -> pmatch x (\(PUpperBound a) -> a) + +lToE :: Term s (PLowerBound a :--> EndPoint a) +lToE = phoistAcyclic $ plam $ \x -> pmatch x (\(PLowerBound a) -> a) diff --git a/plutarch-extra/Plutarch/Extra/List.hs b/plutarch-extra/Plutarch/Extra/List.hs new file mode 100644 index 000000000..3e470edf1 --- /dev/null +++ b/plutarch-extra/Plutarch/Extra/List.hs @@ -0,0 +1,23 @@ +module Plutarch.Extra.List (preverse, pcheckSorted) where + +import Plutarch.Prelude + +-- | / O(n) /. reverses a list +preverse :: (PIsListLike l a) => Term s (l a :--> l a) +preverse = + phoistAcyclic $ + pfoldl # plam (\ys y -> pcons # y # ys) # pnil + +-- | / O(n) /.checks whether a list is sorted +pcheckSorted :: (PIsListLike l a, POrd a) => Term s (l a :--> PBool) +pcheckSorted = + pfix #$ plam $ \self xs -> + pelimList + ( \x1 xs -> + pelimList + (\x2 _ -> x1 #<= x2 #&& (self # xs)) + (pcon PTrue) + xs + ) + (pcon PTrue) + xs diff --git a/plutarch-extra/Plutarch/Extra/RationalData.hs b/plutarch-extra/Plutarch/Extra/RationalData.hs new file mode 100644 index 000000000..d3a544d23 --- /dev/null +++ b/plutarch-extra/Plutarch/Extra/RationalData.hs @@ -0,0 +1,66 @@ +module Plutarch.Rational ( + PRational (..), + preduce, + pnumerator, + pdenominator, + pfromInteger, + pround, + ptruncate, + pproperFraction, +) where + +import Data.Ratio (denominator, numerator) +import qualified GHC.Generics as GHC +import Generics.SOP (Generic, I (I)) +import Plutarch ( + PlutusType (..), + Term, + pcon, + pfix, + phoistAcyclic, + plam, + plet, + pmatch, + (#), + (#$), + type (:-->), + ) +import Plutarch.Bool (PEq (..), POrd (..), pif) +import Plutarch.Builtin ( + PAsData, + PBuiltinList, + PData, + PIsData, + pasInt, + pasList, + pdata, + pdataImpl, + pforgetData, + pfromDataImpl, + ) +import Plutarch.Integer (PInteger, PIntegral (pdiv, pmod)) +import Plutarch.List (PListLike (pcons, phead, pnil, ptail), pmap) +import Plutarch.Pair (PPair (..)) +import Plutarch.Show (PShow (pshow'), pshow) +import Plutarch.Trace (ptraceError) +import Plutarch.Unsafe (punsafeCoerce) + +data PRational s + = PRational + ( Term + s + ( PDataRecord + '[ "numerator" ':= PInteger + , "denominator" ':= PInteger + ] + ) + ) + deriving stock (GHC.Generic) + deriving anyclass (Generic) + deriving anyclass (PIsDataRepr) + deriving + (PlutusType, PIsData, PDataFields, PEq) + via PIsDataReprInstances PScriptContext + +instance PUnsafeLiftDecl PScriptContext where type PLifted PScriptContext = Plutus.ScriptContext +deriving via (DerivePConstantViaData Plutus.ScriptContext PScriptContext) instance PConstantDecl Plutus.ScriptContext diff --git a/plutarch-extra/Plutarch/Extra/TermCont.hs b/plutarch-extra/Plutarch/Extra/TermCont.hs new file mode 100644 index 000000000..fe30fc40e --- /dev/null +++ b/plutarch-extra/Plutarch/Extra/TermCont.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} + +-- | TermCont-related adapters for Plutarch functions. +module Plutarch.Extra.TermCont ( + pletC, + pmatchC, + pletFieldsC, + ptraceC, + pguardC, + pguardC', + ptryFromC, +) where + +import Plutarch.DataRepr (HRec, PDataFields, PFields) +import Plutarch.DataRepr.Internal.Field ( + BindFields, + Bindings, + BoundTerms, + ) +import Plutarch.Prelude +import Plutarch.Reducible (Reduce) +import Plutarch.TryFrom (PTryFrom (PTryFromExcess)) + +-- | Like `plet` but works in a `TermCont` monad +pletC :: Term s a -> TermCont s (Term s a) +pletC = tcont . plet + +-- | Like `pmatch` but works in a `TermCont` monad +pmatchC :: PlutusType a => Term s a -> TermCont s (a s) +pmatchC = tcont . pmatch + +-- | Like `pletFields` but works in a `TermCont` monad. +pletFieldsC :: + forall fs a s b ps bs. + ( PDataFields a + , ps ~ PFields a + , bs ~ Bindings ps fs + , BindFields ps bs + ) => + Term s a -> + TermCont @b s (HRec (BoundTerms ps bs s)) +pletFieldsC x = tcont $ pletFields @fs x + +{- | Like `ptrace` but works in a `TermCont` monad. + +=== Example === + +@ +foo :: Term s PUnit +foo = unTermCont $ do + ptraceC "returning unit!" + pure $ pconstant () +@ +-} +ptraceC :: Term s PString -> TermCont s () +ptraceC s = tcont $ \f -> ptrace s (f ()) + +{- | Trace a message and raise error if 'cond' is false. Otherwise, continue. + +=== Example === + +@ +onlyAllow42 :: Term s (PInteger :--> PUnit) +onlyAllow42 = plam $ \i -> unTermCont $ do + pguardC "expected 42" $ i #== 42 + pure $ pconstant () +@ +-} +pguardC :: Term s PString -> Term s PBool -> TermCont s () +pguardC s cond = tcont $ \f -> pif cond (f ()) $ ptraceError s + +{- | Stop computation and return given term if 'cond' is false. Otherwise, continue. + +=== Example === + +@ +is42 :: Term s (PInteger :--> PBool) +is42 = plam $ \i -> unTermCont $ do + pguardC "expected 42" (pconstant False) $ i #== 42 + pure $ pconstant True +@ +-} +pguardC' :: Term s a -> Term s PBool -> TermCont @a s () +pguardC' r cond = tcont $ \f -> pif cond (f ()) r + +-- | 'TermCont' producing version of 'ptryFrom'. +ptryFromC :: forall b r a s. PTryFrom a b => Term s a -> TermCont @r s (Term s b, Reduce (PTryFromExcess a b s)) +ptryFromC = tcont . ptryFrom diff --git a/plutarch-benchmark/plutarch-benchmark.cabal b/plutarch-extra/plutarch-extra.cabal similarity index 61% rename from plutarch-benchmark/plutarch-benchmark.cabal rename to plutarch-extra/plutarch-extra.cabal index eee1a346b..2e25039bb 100644 --- a/plutarch-benchmark/plutarch-benchmark.cabal +++ b/plutarch-extra/plutarch-extra.cabal @@ -1,9 +1,6 @@ -cabal-version: 2.4 -name: plutarch-benchmark -version: 1.1.0 -author: Las Safin -license: MIT -extra-source-files: README.md +cabal-version: 3.0 +name: plutarch-extra +version: 1.2.0 common c default-language: Haskell2010 @@ -67,53 +64,27 @@ common c -Wno-partial-type-signatures -Wmissing-export-lists -Werror -Wincomplete-record-updates -Wmissing-deriving-strategies -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls - -fprint-explicit-kinds + -fprint-explicit-kinds -Wno-unrecognised-warning-flags -library - import: c - exposed-modules: Plutarch.Benchmark +common deps build-depends: - , aeson , base - , boxes - , bytestring - , cassava - , containers - , data-default - , flat - , foldl - , mtl , plutarch - , plutus-core , plutus-ledger-api - , serialise - , text - , these - , vector - hs-source-dirs: src +library plutarch-preludes + import: c, deps + hs-source-dirs: preludes + exposed-modules: PPrelude -benchmark benchmark - import: c - type: exitcode-stdio-1.0 - hs-source-dirs: bench - main-is: Main.hs - build-depends: - , base - , bytestring - , plutarch - , plutarch-benchmark - , plutus-ledger-api - , transformers +library + import: c, deps + exposed-modules: + Plutarch.Extra + Plutarch.Extra.Api + Plutarch.Extra.ByteString + Plutarch.Extra.Interval + Plutarch.Extra.List + Plutarch.Extra.TermCont -executable benchmark-diff - import: c - hs-source-dirs: benchmark-diff - main-is: Main.hs - build-depends: - , base - , boxes - , bytestring - , cassava - , plutarch - , plutarch-benchmark +-- other-modules: diff --git a/plutarch-extra/preludes/PPrelude.hs b/plutarch-extra/preludes/PPrelude.hs new file mode 100644 index 000000000..3a8025b4b --- /dev/null +++ b/plutarch-extra/preludes/PPrelude.hs @@ -0,0 +1,7 @@ +module PPrelude ( + module Prelude, + module Plutarch.Prelude, +) where + +import Plutarch.Prelude +import Prelude diff --git a/plutarch-test/Main.hs b/plutarch-test/Main.hs new file mode 100644 index 000000000..42c60feff --- /dev/null +++ b/plutarch-test/Main.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE CPP #-} + +module Main (main) where + +import qualified BaseSpec +import qualified ExtraSpec + +#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) +import qualified Plutarch.FieldSpec as FieldSpec +import qualified Plutarch.MonadicSpec as MonadicSpec +import qualified Plutarch.TryFromSpec as TryFromSpec +-- import Plutarch.Test.Run (noUnusedGoldens, hspecAndReturnForest) +import Test.Hspec (Spec, hspec, describe) +#else +-- import qualified Plutarch.FFISpec as FFISpec +import Test.Hspec (Spec, hspec) +#endif + +import GHC.IO.Encoding (setLocaleEncoding, utf8) + +main :: IO () +main = do + setLocaleEncoding utf8 + + -- FIXME: Re-enable unused golden checks + -- Old: + -- We test for unused goldens, but do so only in GHC 9. Because, under GHC 8 + -- certain modules are disabled (see the CPP below) which leads to legitimately + -- unused goldens detected leading to false positive in test failure. + -- #if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) + -- noUnusedGoldens =<< hspecAndReturnForest spec + -- #else + hspec spec + +-- #endif + +spec :: Spec +spec = do + BaseSpec.spec + ExtraSpec.spec +#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) + describe "GHC-9-only" $ do + FieldSpec.spec + MonadicSpec.spec + TryFromSpec.spec +#else + -- describe "GHC-8-only" $ do + -- FFISpec.spec +#endif diff --git a/plutarch-test/README.md b/plutarch-test/README.md index 90e1b5ea5..ac0dbebd9 100644 --- a/plutarch-test/README.md +++ b/plutarch-test/README.md @@ -3,6 +3,7 @@ To run the tests using Nix: ```sh-session +$ cd $projectroot/plutarch-test # Runs tests $ nix run .#test-ghc9-nodev # To run the above in GHC 8.10 instead: @@ -13,28 +14,33 @@ $ nix run .#test-ghc810-nodev To run the tests using ghcid (fit for writing tests): ```sh-session -$ ghcid -c 'cabal repl plutarch-test:exe:plutarch-test' -T Main.main +bin/ghcid test ``` To run ghcid with development flag set: ```sh-session -$ vim cabal.project # And then uncomment the "flags: +developmenet" line. -$ ghcid -c 'cabal repl plutarch-test:exe:plutarch-test' -T Main.main +bin/ghcid test:dev ``` -## The `development` flag - -Plutarch has a `development` flag. Right now, the flag is used to control tracing functions, wherein turning on the flag will inject `Trace` instructions in the generated UPLC. - -Since this will impact the printTerm goldens in tests, we provide `plutarchDevFlagDescribe` that should be used everywhere in the test hierarchy where the immediate sub-tree of tests are known to use tracing functions (or any other development-flag-specific featuresto use tracing functions (or any other development-flag-specific features). +Note: `cabal run` should be run inside `./plutarch-test` directory. ## Goldens +### Navigation + To quickly nagivate and preview the golden files in the terminal, run: -``` +```sh-session nix run nixpkgs#ranger -- ./plutarch-test/goldens/ ``` Then hit `zv` to toggle on preview. Use `hjkl` to naviate. + +### Reset + +When writing tests you may want to clean up working copy goldens, and start from base. To do this, run: + +```sh-session +rm plutarch-test/goldens/*.golden; git restore --source=HEAD --staged --worktree -- plutarch-test/goldens/ +``` diff --git a/plutarch-test/common/Plutarch/Test.hs b/plutarch-test/common/Plutarch/Test.hs new file mode 100644 index 000000000..65c092b15 --- /dev/null +++ b/plutarch-test/common/Plutarch/Test.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ImpredicativeTypes #-} + +-- | Common functions for testing Plutarch code +module Plutarch.Test ( + -- * Plutarch specific `Expectation` operators + passert, + passertNot, + pfails, + psucceeds, + ptraces, + pshouldBe, + (#@?=), + + -- * Budget expectation + psatisfyWithinBenchmark, + + -- * Golden testing + (@|), + (@\), + (@->), + (@:->), + (@==), + pgoldenSpec, + pgoldenSpec', + PlutarchGoldens, + GoldenConf (..), + GoldenTest (..), + + -- * Benchmark type for use in `(@:->)` + Benchmark (Benchmark, exBudgetCPU, exBudgetMemory, scriptSizeBytes), + ScriptSizeBytes, + + -- * Test runner related utilities + noUnusedGoldens, + noUnusedGoldens', + hspecAndReturnForest, +) where + +import Data.Text (Text) +import qualified Data.Text as T + +import Plutarch (ClosedTerm, Config (Config, tracingMode), compile, pcon, printScript, pattern DetTracing) +import Plutarch.Bool (PBool (PFalse, PTrue)) +import Plutarch.Evaluate (evalScript) +import Plutarch.Test.Benchmark ( + Benchmark (Benchmark, exBudgetCPU, exBudgetMemory, scriptSizeBytes), + ScriptSizeBytes, + ) +import Plutarch.Test.Golden ( + GoldenConf (GoldenConf, chosenTests, goldenBasePath), + GoldenTest (GoldenT'Bench, GoldenT'UPLCPostEval, GoldenT'UPLCPreEval), + PlutarchGoldens, + TermExpectation, + evalScriptAlwaysWithBenchmark, + pgoldenSpec, + pgoldenSpec', + (@->), + (@:->), + (@\), + (@|), + ) +import Plutarch.Test.Run (hspecAndReturnForest, noUnusedGoldens, noUnusedGoldens') +import qualified PlutusLedgerApi.V1.Scripts as Scripts +import Test.Hspec (Expectation, expectationFailure, shouldBe, shouldSatisfy) +import Test.Tasty.HUnit (assertFailure) + +comp :: ClosedTerm a -> Scripts.Script +comp t = either (error . T.unpack) id $ compile (Config {tracingMode = DetTracing}) t + +{- | + Like `shouldBe` but but for Plutarch terms +-} +pshouldBe :: ClosedTerm a -> ClosedTerm b -> Expectation +pshouldBe x y = do + p1 <- eval $ comp x + p2 <- eval $ comp y + pscriptShouldBe p1 p2 + where + eval :: Scripts.Script -> IO Scripts.Script + eval s = case evalScript s of + (Left e, _, _) -> assertFailure $ "Script evaluation failed: " <> show e + (Right x', _, _) -> pure x' + +{- | + Like `pshouldBe` but on `Script` +-} +pscriptShouldBe :: Scripts.Script -> Scripts.Script -> Expectation +pscriptShouldBe x y = + printScript x `shouldBe` printScript y + +-- | Like `@?=` but for Plutarch terms +(#@?=) :: ClosedTerm a -> ClosedTerm b -> Expectation +(#@?=) = pshouldBe + +-- | Asserts the term to be true +passert :: ClosedTerm a -> Expectation +passert p = p #@?= pcon PTrue + +-- | Asserts the term to be false +passertNot :: ClosedTerm a -> Expectation +passertNot p = p #@?= pcon PFalse + +-- | Asserts the term evaluates successfully without failing +psucceeds :: ClosedTerm a -> Expectation +psucceeds p = + case evalScript $ comp p of + (Left _, _, _) -> expectationFailure $ "Term failed to evaluate" + (Right _, _, _) -> pure () + +-- | Asserts the term evaluates without success +pfails :: ClosedTerm a -> Expectation +pfails p = do + case evalScript $ comp p of + (Left _, _, _) -> pure () + (Right _, _, _) -> expectationFailure $ "Term succeeded" + +{- | Check that the given benchmark is within certain maximum values. + + Use this to ensure that a program's benchmark doesn't exceed expected values + (such as script size or memory budget). You will need this because, + + - `Plutarch.Test`'s golden testing uses maximum possible ExBudget for evaluating + programs + - You may want to check that the script size is within a certain value +-} +psatisfyWithinBenchmark :: Benchmark -> Benchmark -> Expectation +psatisfyWithinBenchmark bench maxBudget = do + shouldSatisfy bench $ \_ -> + exBudgetCPU bench <= exBudgetCPU maxBudget + shouldSatisfy bench $ \_ -> + exBudgetMemory bench <= exBudgetMemory maxBudget + shouldSatisfy bench $ \_ -> + scriptSizeBytes bench <= scriptSizeBytes maxBudget + +-- | Asserts that the term evaluates successfully with the given trace sequence +ptraces :: ClosedTerm a -> [Text] -> Expectation +ptraces p develTraces = + case evalScript $ comp p of + (Left _, _, _) -> expectationFailure $ "Term failed to evaluate" + (Right _, _, traceLog) -> do + traceLog `shouldBe` develTraces + +-- | Test that the Plutarch program evaluates to the given term +(@==) :: ClosedTerm a -> ClosedTerm b -> TermExpectation a +(@==) p x = p @:-> \(_, script, _) -> script `pscriptShouldBe` xScript + where + xScript = fst . evalScriptAlwaysWithBenchmark $ comp x + +infixr 1 @== diff --git a/plutarch-test/common/Plutarch/Test/Benchmark.hs b/plutarch-test/common/Plutarch/Test/Benchmark.hs new file mode 100644 index 000000000..dd1cb8289 --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/Benchmark.hs @@ -0,0 +1,41 @@ +module Plutarch.Test.Benchmark ( + -- * Working with `Benchmark` type + Benchmark (Benchmark, exBudgetCPU, exBudgetMemory, scriptSizeBytes), + ScriptSizeBytes, + + -- * Producing benchmark values + mkBenchmark, + scriptSize, +) where + +import Codec.Serialise (serialise) +import Data.Aeson (ToJSON) +import qualified Data.ByteString.Lazy as LB +import qualified Data.ByteString.Short as SBS +import Data.Int (Int64) +import GHC.Generics (Generic) +import PlutusLedgerApi.V1 (ExBudget (ExBudget), ExCPU, ExMemory, Script) + +data Benchmark = Benchmark + { exBudgetCPU :: ExCPU + -- ^ CPU budget used by the script. + , exBudgetMemory :: ExMemory + -- ^ Memory budget used by the script. + , scriptSizeBytes :: ScriptSizeBytes + -- ^ Size of Plutus script in bytes + } + deriving stock (Show, Generic) + deriving anyclass (ToJSON) + +mkBenchmark :: ExBudget -> ScriptSizeBytes -> Benchmark +mkBenchmark (ExBudget cpu mem) = Benchmark cpu mem + +newtype ScriptSizeBytes = ScriptSizeBytes Int64 + deriving stock (Eq, Ord, Show, Generic) + deriving newtype (Num, ToJSON) + +scriptSize :: Script -> ScriptSizeBytes +scriptSize = ScriptSizeBytes . fromIntegral . SBS.length . serialiseScriptShort + +serialiseScriptShort :: Script -> SBS.ShortByteString +serialiseScriptShort = SBS.toShort . LB.toStrict . serialise diff --git a/plutarch-test/common/Plutarch/Test/Golden.hs b/plutarch-test/common/Plutarch/Test/Golden.hs new file mode 100644 index 000000000..12b7179bc --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/Golden.hs @@ -0,0 +1,284 @@ +{-# LANGUAGE ImpredicativeTypes #-} + +module Plutarch.Test.Golden ( + -- * DSL + pgoldenSpec, + pgoldenSpec', + (@|), + (@\), + (@->), + (@:->), + TermExpectation, + PlutarchGoldens, + + -- * Golden key and path + GoldenKey, + currentGoldenKey, + goldenKeyString, + mkGoldenKeyFromSpecPath, + defaultGoldenBasePath, + goldenTestPath, + + -- * Golden config + GoldenConf (..), + GoldenTest (..), + + -- * Evaluation + evalScriptAlwaysWithBenchmark, + compileD, +) where + +import Control.Monad (forM_, unless) +import qualified Data.Aeson.Text as Aeson +import Data.Default (Default (def)) +import Data.List.NonEmpty (nonEmpty) +import Data.Maybe (mapMaybe) +import Data.Semigroup (sconcat) +import Data.String (IsString) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import qualified Data.Text.Lazy as TL +import GHC.Stack (HasCallStack) +import System.FilePath (()) +import Test.Hspec.Golden + +import qualified Data.List.NonEmpty as NE +import Data.Set (Set) +import qualified Data.Set as S +import Plutarch (Config (Config, tracingMode), compile, printScript, pattern DetTracing) +import Plutarch.Evaluate (evalScript) +import Plutarch.Prelude +import Plutarch.Test.Benchmark (Benchmark, mkBenchmark, scriptSize) +import Plutarch.Test.ListSyntax (ListSyntax, listSyntaxAdd, listSyntaxAddSubList, runListSyntax) +import PlutusLedgerApi.V1.Scripts (Script) +import qualified PlutusLedgerApi.V1.Scripts as Scripts +import Test.Hspec (Expectation, Spec, describe, it) +import Test.Hspec.Core.Spec (SpecM, getSpecDescriptionPath) + +data GoldenValue = GoldenValue + { goldenValueUplcPreEval :: Text + -- ^ Golden string for UPLC + , goldenValueUplcPostEval :: Text + -- ^ Golden string for evaluated UPLC + , goldenValueBench :: Text + -- ^ Golden string for benchmark JSON + , goldenValueEvaluated :: Script + -- ^ Evaluated result + , goldenValueBenchVal :: Benchmark + -- ^ `Benchmark` for evaluated UPLC + , goldenValueExpectation :: Maybe (Script -> Benchmark -> Expectation) + -- ^ User test's expectation function + } + +data GoldenConf = GoldenConf + { chosenTests :: Set GoldenTest + , goldenBasePath :: FilePath + -- ^ Directory to put the goldens in. + } + deriving stock (Eq, Show) + +instance Default GoldenConf where + def = GoldenConf (S.fromList [minBound .. maxBound]) defaultGoldenBasePath + +{- | Class of types that represent `GoldenValue` + + This class exists for syntatic sugar provided by (@->) (via `TermExpectation`). +-} +class HasGoldenValue (t :: S -> PType -> Type) where + mkGoldenValue :: forall a. (forall s. t s a) -> GoldenValue + +mkGoldenValue' :: ClosedTerm a -> Maybe (Script -> Benchmark -> Expectation) -> GoldenValue +mkGoldenValue' p mexp = + let compiledScript = compileD p + (evaluatedScript, bench) = evalScriptAlwaysWithBenchmark compiledScript + in GoldenValue + (T.pack $ printScript compiledScript) + (T.pack $ printScript evaluatedScript) + (TL.toStrict $ Aeson.encodeToLazyText bench) + evaluatedScript + bench + mexp + +-- We derive for `Term s a` only because GHC prevents us from deriving for +-- `ClosedTerm a`. In practice, this instance should be used only for closed +-- terms. +instance HasGoldenValue Term where + mkGoldenValue p = mkGoldenValue' p Nothing + +{- | A `Term` paired with its evaluation/benchmark expectation + + Example: + >>> TermExpectation (pcon PTrue) $ \(p, _script, _benchmark) -> pshouldBe (pcon PTrue) +-} +data TermExpectation' (s :: S) a = TermExpectation (ClosedTerm a) ((ClosedTerm a, Script, Benchmark) -> Expectation) + +type TermExpectation a = forall s. TermExpectation' s a + +-- | Test an expectation on a golden Plutarch program +(@->) :: ClosedTerm a -> (ClosedTerm a -> Expectation) -> TermExpectation a +(@->) p f = p @:-> \(p', _, _) -> f p' + +infixr 1 @-> + +{- | Like `@->` but also takes the evaluated script and benchmark as arguments + + Useful to do assertion checks on post-evaluation benchmark (eg: to check if + script size is below certain threshold) -- use in conjunction with + `psatisfyWithinBenchmark` -- or on evaluated script (ie., without + re-evaluating the program). +-} +(@:->) :: ClosedTerm a -> ((ClosedTerm a, Script, Benchmark) -> Expectation) -> TermExpectation a +(@:->) p f = TermExpectation p (\(p', pe, b) -> f (p', pe, b)) + +infixr 1 @:-> + +instance HasGoldenValue TermExpectation' where + mkGoldenValue (TermExpectation p f) = + mkGoldenValue' p (Just $ \pe b -> f (p, pe, b)) + +-- | The key used in the .golden files containing multiple golden values +newtype GoldenKey = GoldenKey Text + deriving newtype (Eq, Show, Ord, IsString) + +goldenKeyString :: GoldenKey -> String +goldenKeyString (GoldenKey s) = T.unpack s + +instance Semigroup GoldenKey where + GoldenKey s1 <> GoldenKey s2 = GoldenKey $ s1 <> "." <> s2 + +currentGoldenKey :: HasCallStack => SpecM () GoldenKey +currentGoldenKey = do + mkGoldenKeyFromSpecPath . fmap T.pack <$> getSpecDescriptionPath + +mkGoldenKeyFromSpecPath :: HasCallStack => [Text] -> GoldenKey +mkGoldenKeyFromSpecPath path = + case nonEmpty path of + Nothing -> error "cannot use currentGoldenKey from top-level spec" + Just anc -> + -- hspec-discover adds a top-level entry; remove that. + case nonEmpty (NE.drop 1 anc) of + Nothing -> error "cannot use currentGoldenKey from top-level spec (after hspec-discover)" + Just path -> + sconcat $ fmap GoldenKey path + +goldenPath :: FilePath -> GoldenKey -> FilePath +goldenPath baseDir (GoldenKey k) = + baseDir T.unpack k <> ".golden" + +type PlutarchGoldens = ListSyntax (GoldenKey, GoldenValue) + +-- | Specify goldens for the given Plutarch program +(@|) :: forall t a. HasGoldenValue t => GoldenKey -> (forall s. t s a) -> PlutarchGoldens +(@|) k v = listSyntaxAdd (k, mkGoldenValue v) + +infixr 0 @| + +-- | Add an expectation for the Plutarch program specified with (@|) +(@\) :: GoldenKey -> PlutarchGoldens -> PlutarchGoldens +(@\) = listSyntaxAddSubList + +{- | Create golden specs for pre/post-eval UPLC and benchmarks. + + A *single* golden file will be created (for each metric) for all the programs + in the given tree. + + For example, + ``` + pgoldenSpec $ do + "foo" @| pconstant 42 + "bar" @\ do + "qux" @| pconstant "Hello" + ``` + + Will create three golden files -- uplc.golden, uplc.eval.golden and + bench.golden -- each containing three lines one for each program above. + Hierarchy is represented by intercalating with a dot; for instance, the key + for 'qux' will be "bar.qux". +-} +pgoldenSpec :: HasCallStack => PlutarchGoldens -> Spec +pgoldenSpec = pgoldenSpec' def + +{- | Like 'pgoldenSpec' but takes a 'GoldenConf' to determine which goldens to track. + +> pgoldenSpec = pgoldenSpec' def +-} +pgoldenSpec' :: HasCallStack => GoldenConf -> PlutarchGoldens -> Spec +pgoldenSpec' conf@(GoldenConf {goldenBasePath}) map = do + base <- currentGoldenKey + let bs = runListSyntax map + -- Golden tests + describe "golden" $ do + goldenTestSpec goldenBasePath base bs `mapM_` chosenTests conf + -- Assertion tests (if any) + let asserts = flip mapMaybe bs $ \(k, v) -> do + (k,) . (\f -> f (goldenValueEvaluated v) $ goldenValueBenchVal v) <$> goldenValueExpectation v + unless (null asserts) $ do + forM_ asserts $ \(k, v) -> + it (goldenKeyString $ "" <> k <> "assert") v + +data GoldenTest + = -- | The unevaluated UPLC (compiled target of Plutarch term) + GoldenT'UPLCPreEval + | -- | The evaluated UPLC (evaluated result of Plutarch term) + GoldenT'UPLCPostEval + | -- | Benchmark of Plutarch term (will never fail) + GoldenT'Bench + deriving stock (Eq, Show, Ord, Enum, Bounded) + +goldenTestKey :: GoldenTest -> GoldenKey +goldenTestKey = \case + GoldenT'UPLCPreEval -> "uplc" + GoldenT'UPLCPostEval -> "uplc.eval" + GoldenT'Bench -> "bench" + +defaultGoldenBasePath :: FilePath +defaultGoldenBasePath = "goldens" + +goldenTestPath :: FilePath -> GoldenKey -> GoldenTest -> FilePath +goldenTestPath goldenBasePath base gt = + goldenPath goldenBasePath $ base <> goldenTestKey gt + +goldenTestVal :: GoldenTest -> GoldenValue -> Text +goldenTestVal t v = case t of + GoldenT'UPLCPreEval -> goldenValueUplcPreEval v + GoldenT'UPLCPostEval -> goldenValueUplcPostEval v + GoldenT'Bench -> goldenValueBench v + +goldenTestSpec :: FilePath -> GoldenKey -> [(GoldenKey, GoldenValue)] -> GoldenTest -> Spec +goldenTestSpec goldenBasePath base vals gt = do + it (goldenKeyString $ goldenTestKey gt) $ do + Golden + { output = combineGoldens $ fmap (goldenTestVal gt) <$> vals + , goldenFile = goldenTestPath goldenBasePath base gt + , actualFile = Nothing + , encodePretty = show + , writeToFile = TIO.writeFile + , readFromFile = TIO.readFile + , failFirstTime = False + } + where + -- Group multiple goldens values in the same file + combineGoldens :: [(GoldenKey, Text)] -> Text + combineGoldens xs = + T.intercalate "\n" $ + (\(GoldenKey k, v) -> k <> " " <> v) <$> xs + +{- | Like `evalScript` but doesn't throw `EvalError`, and returns `Benchmark`. + + On `EvalError`, this function returns `perror` as evaluated script. Plutus + does not provide an accurate way to tell if the program evalutes to `Error` or + not; see https://github.com/input-output-hk/plutus/issues/4270 +-} +evalScriptAlwaysWithBenchmark :: Scripts.Script -> (Scripts.Script, Benchmark) +evalScriptAlwaysWithBenchmark script = + let (res, exbudget, _traces) = evalScript script + bench = mkBenchmark exbudget (scriptSize script) + in ( case res of + Left _ -> either undefined id $ compile (Config {tracingMode = DetTracing}) perror + Right x -> x + , bench + ) + +compileD :: ClosedTerm a -> Scripts.Script +compileD t = either (error . T.unpack) id $ compile (Config {tracingMode = DetTracing}) t diff --git a/plutarch-test/common/Plutarch/Test/ListSyntax.hs b/plutarch-test/common/Plutarch/Test/ListSyntax.hs new file mode 100644 index 000000000..f60923cee --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/ListSyntax.hs @@ -0,0 +1,30 @@ +module Plutarch.Test.ListSyntax ( + ListSyntax, + runListSyntax, + listSyntaxAdd, + listSyntaxAddSubList, +) where + +import Control.Monad (void) +import Control.Monad.Writer (Writer, execWriter, tell) + +listSyntaxAddSubList :: Semigroup k => k -> ListSyntax (k, v) -> ListSyntax (k, v) +listSyntaxAddSubList name m = + void $ + flip traverse (runListSyntax m) $ \(k, v) -> do + let k' = name <> k + listSyntaxAdd (k', v) + +newtype ListSyntaxM elem a = ListSyntax {unListSyntax :: Writer [elem] a} + deriving newtype (Functor, Applicative, Monad) + +type ListSyntax elem = ListSyntaxM elem () + +runListSyntax :: ListSyntax elem -> [elem] +runListSyntax = + execWriter . unListSyntax + +listSyntaxAdd :: elem -> ListSyntax elem +listSyntaxAdd = ListSyntax . tell . one + where + one x = [x] diff --git a/plutarch-test/common/Plutarch/Test/Property.hs b/plutarch-test/common/Plutarch/Test/Property.hs new file mode 100644 index 000000000..5bce715a1 --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/Property.hs @@ -0,0 +1,8 @@ +-- | Helper for writing property tests for Plutarch terms. +module Plutarch.Test.Property ( + module X, +) where + +import Plutarch.Test.Property.Extra as X +import Plutarch.Test.Property.HaskEquiv as X +import Plutarch.Test.Property.Marshal as X diff --git a/plutarch-test/common/Plutarch/Test/Property/Extra.hs b/plutarch-test/common/Plutarch/Test/Property/Extra.hs new file mode 100644 index 000000000..3a0d8377f --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/Property/Extra.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} + +{- | + Extra properties based on `prop_haskEquiv` +-} +module Plutarch.Test.Property.Extra ( + prop_leftInverse, + prop_dataRoundTrip, +) where + +import Hedgehog (Gen, Property) + +import Plutarch.Prelude + +import Plutarch.Test.Property.HaskEquiv ( + Equality (OnPEq), + HaskEquiv, + LamArgs, + NP (Nil, (:*)), + Totality (TotalFun), + prop_haskEquiv, + ) +import Plutarch.Test.Property.Marshal (Marshal) + +{- | + `l` is a left inverse of `r` + + See https://en.wikipedia.org/wiki/Inverse_function#Left_inverses + + Like `prop_haskEquiv`, you want to call this with @TypeApplications@ + specifying the value of `e`. For example, + + >>> prop_leftInverse + @'OnPEq + mapJoin + mapSplit + $ mapOf (pairOf integer integer) rational +-} +prop_leftInverse :: + forall e p p' h. + ( LamArgs h ~ '[] + , HaskEquiv e 'TotalFun (h -> h) (p :--> p) '[h] + , Show h + , Marshal h p + ) => + ClosedTerm (p' :--> p) -> + ClosedTerm (p :--> p') -> + Gen h -> + Property +prop_leftInverse l r arg = + prop_haskEquiv @e @( 'TotalFun) (id @h) (plam $ \x -> l #$ r # x) (arg :* Nil) + +{- | + A Plutarch term that is a `PIsData` can be encoded to and decoded back to the + same value. +-} +prop_dataRoundTrip :: + forall h p. + ( LamArgs h ~ '[] + , Show h + , Marshal h p + , PIsData p + , PEq p + ) => + Gen h -> + Property +prop_dataRoundTrip = + prop_leftInverse + @( 'OnPEq) + @p + @(PAsData p) + @h + (plam pfromData) + (plam pdata) diff --git a/plutarch-test/common/Plutarch/Test/Property/Gen.hs b/plutarch-test/common/Plutarch/Test/Property/Gen.hs new file mode 100644 index 000000000..178e8cdd8 --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/Property/Gen.hs @@ -0,0 +1,124 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Generator helpers +module Plutarch.Test.Property.Gen ( + genRational, + genInteger, + genList, + bsOfLength, +) where + +import Control.Monad (MonadPlus, join, liftM2, mfilter) +import Data.List (nub, sortOn) +import Data.Ratio ((%)) + +import Hedgehog (MonadGen) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +import Test.Tasty.QuickCheck ( + Arbitrary, + Gen, + Negative (getNegative), + Positive (getPositive), + arbitrary, + choose, + elements, + listOf1, + oneof, + vectorOf, + ) + +import PlutusLedgerApi.V1 + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Internal (c2w) +import Test.QuickCheck.Instances () + +import qualified PlutusTx.AssocMap as PlutusMap + +genInteger :: MonadGen g => g Integer +genInteger = Gen.integral (Range.linear (-1_000_000_000) 1_000_000_000) + +genRational :: (MonadPlus g, MonadGen g) => g Rational +genRational = liftM2 (%) genInteger (mfilter (/= 0) genInteger) + +genList :: MonadGen g => g a -> g [a] +genList = Gen.list (Range.linear 0 100) + +------------------- Arbitrary instances for several ApiTypes ----------------------- + +bsOfLength :: Int -> Gen ByteString +bsOfLength n = + BS.pack <$> vectorOf n (c2w <$> choose (minBound :: Char, maxBound)) + +instance Arbitrary BuiltinByteString where + arbitrary = toBuiltin @ByteString <$> arbitrary + +instance Arbitrary CurrencySymbol where + arbitrary = + let arbitrary' = + join $ fmap (toBuiltin @ByteString) . bsOfLength <$> elements [0, 28] + in CurrencySymbol <$> arbitrary' + +instance Arbitrary Value where + arbitrary = + (\a -> Value . PlutusMap.fromList . sortOn fst . zip a) + <$> currSyms + <*> listOf1 arbitraryTokMap + where + -- List of unique token names. + tokNames = nub <$> listOf1 (arbitrary @TokenName) + -- List of unique currency symbols. + currSyms = nub <$> listOf1 (arbitrary @CurrencySymbol) + arbitraryTokMap = + (\a -> PlutusMap.fromList . sortOn fst . zip a) + <$> tokNames + <*> listOf1 (oneof [getPositive @Integer <$> arbitrary, getNegative @Integer <$> arbitrary]) + +instance Arbitrary TokenName where + arbitrary = do + ln <- choose (0, 32) + str <- + BS.pack + <$> vectorOf + ln + ( oneof $ + map + (fmap c2w) + [ choose ('a', 'f') + , choose ('A', 'F') + , choose ('0', '9') + ] + ) + pure . TokenName . toBuiltin @ByteString $ str + +instance Arbitrary PubKeyHash where + arbitrary = + let arbitrary' = + toBuiltin @ByteString <$> bsOfLength 28 + in PubKeyHash <$> arbitrary' + +instance Arbitrary ValidatorHash where + arbitrary = + let arbitrary' = + toBuiltin @ByteString <$> bsOfLength 28 + in ValidatorHash <$> arbitrary' + +instance Arbitrary Credential where + arbitrary = + oneof + [ PubKeyCredential <$> arbitrary + , ScriptCredential <$> arbitrary + ] + +instance Arbitrary StakingCredential where + arbitrary = + oneof + [ StakingHash <$> arbitrary + , StakingPtr <$> arbitrary <*> arbitrary <*> arbitrary + ] + +instance Arbitrary Address where + arbitrary = Address <$> arbitrary <*> arbitrary diff --git a/plutarch-test/common/Plutarch/Test/Property/HaskEquiv.hs b/plutarch-test/common/Plutarch/Test/Property/HaskEquiv.hs new file mode 100644 index 000000000..4708fb1a3 --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/Property/HaskEquiv.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE UndecidableInstances #-} + +{- | + The property of Plutarch terms corresponding to a Haskell term. + + Assuming Haskell functions are already well-tested, by verifying the property + that a Plutarch term functions equivalently to the corresponding Haskell term + we automatically (more or less) verify the correctness of the Plutarch term. + + This modules provides a `prop_haskEquiv` to that end. +-} +module Plutarch.Test.Property.HaskEquiv ( + -- * The principal property of the module #prop# + prop_haskEquiv, + Equality (..), + Totality (..), + NP ((:*), Nil), -- Re-exports from sop-core for building Gen arguments + + -- * For writing helper functions using `prop_haskEquiv` #types# + LamArgs, + HaskEquiv, + + -- * Underlying equality tests #util# + testDataEq, + testPEq, +) where + +import Control.Exception (SomeException, evaluate, try) +import Control.Monad.IO.Class (liftIO) +import Data.SOP (NP (Nil, (:*))) +import Data.Text (Text) +import qualified Data.Text as T +import Hedgehog (Gen, Property, PropertyT, annotate, annotateShow, assert, forAll, property, (===)) +import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (ExBudget)) +import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (ExCPU), ExMemory (ExMemory)) +import PlutusLedgerApi.V1.Scripts (Script (Script, unScript)) + +import Plutarch (Config (Config, tracingMode), compile, pattern DetTracing) +import Plutarch.Evaluate (EvalError, evalScript') +import Plutarch.Prelude +import Plutarch.Test.Property.Marshal (Marshal (marshal)) + +-- | The nature of equality between two Plutarch terms. +data Equality + = OnPEq + | OnPData + | -- | Terms are equal on both `PEq` and `PData` + OnBoth + deriving stock (Eq, Show, Ord) + +-- | Whether a function is total or partial. +data Totality + = TotalFun + | -- | The Plutarch *and* Haskell function is expected to be partial (error's on + -- certain inputs). + PartialFun + deriving stock (Eq, Show, Ord) + +{- | + Class of pairs of Plutarch and Haskell types that are semantically + equivalent, upto the given `Equality` and `Totality`. +-} +class LamArgs h ~ args => HaskEquiv (e :: Equality) (t :: Totality) h p args | h -> p where + -- | Test that `h` and `p` are equal when applied on the given `args`. + haskEquiv :: h -> ClosedTerm p -> NP Gen args -> PropertyT IO () + +-- | Argument types for a Haskell function (empty if a term value) +type family LamArgs f :: [Type] where + LamArgs (a -> b) = a ': LamArgs b + LamArgs _ = '[] + +-- For lambda terms generate the first argument and delegate. +instance + (Show ha, Marshal ha pa, HaskEquiv e t hb pb hbArgs, LamArgs hb ~ hbArgs) => + HaskEquiv e t (ha -> hb) (pa :--> pb) (ha ': hbArgs) + where + haskEquiv hf pf (a :* as) = do + x <- forAll a + haskEquiv @e @t (hf x) (pf # marshal x) as + +instance (PIsData p, Marshal h p, LamArgs h ~ '[]) => HaskEquiv 'OnPData 'TotalFun h p '[] where + haskEquiv h p Nil = testDataEq' h p + +instance (PEq p, Marshal h p, LamArgs h ~ '[]) => HaskEquiv 'OnPEq 'TotalFun h p '[] where + haskEquiv h p Nil = testPEq (marshal h) p + +instance + ( PEq p + , PIsData p + , Marshal h p + , HaskEquiv 'OnPEq 'TotalFun h p '[] + , HaskEquiv 'OnPData 'TotalFun h p '[] + ) => + HaskEquiv 'OnBoth 'TotalFun h p '[] + where + haskEquiv h p Nil = do + haskEquiv @( 'OnPEq) @( 'TotalFun) h p Nil + haskEquiv @( 'OnPData) @( 'TotalFun) h p Nil + +instance + (PIsData p, Marshal h p, HaskEquiv eq 'TotalFun h p '[]) => + HaskEquiv eq 'PartialFun h p '[] + where + haskEquiv h p Nil = testPartial (\h' p' -> haskEquiv @eq @( 'TotalFun) h' p' Nil) h p + +{- | + The given Plutarch term is equivalent to the given Haskell type upto the given + `Equality` and `Totality`. + + Generator arguments must be non-empty if the term is a lambda. This function + must always be called using `TypeApplications` specifying the first two + type variables. + + Example: + + >>> prop_haskEquiv + @'OnPEq + @'TotalFun + (reverse :: [Integer] -> [Integer]) + preverse + (genList genInteger :* Nil) +-} +prop_haskEquiv :: + forall (e :: Equality) (t :: Totality) h p. + HaskEquiv e t h p (LamArgs h) => + h -> + ClosedTerm p -> + NP Gen (LamArgs h) -> + Property +prop_haskEquiv h p = do + property . haskEquiv @e @t h p + +testDataEq' :: (PIsData a, Marshal h a) => h -> ClosedTerm a -> PropertyT IO () +testDataEq' x y = + testDataEq (marshal x) y + +testDataEq :: (PIsData a) => ClosedTerm a -> ClosedTerm a -> PropertyT IO () +testDataEq x y = pshouldBe (pdata x) (pdata y) + +testPartial :: (h -> ClosedTerm p -> PropertyT IO ()) -> h -> ClosedTerm p -> PropertyT IO () +testPartial baseTest h p = + liftIO (try $ evaluate h) >>= \case + Left (_ :: SomeException) -> + case run p of + (Left _, _, _) -> assert True + (Right _, _, _) -> do + annotate "plutarch didn't fail but haskell did" + assert False + Right _ -> baseTest h p + +testPEq :: PEq a => ClosedTerm a -> ClosedTerm a -> PropertyT IO () +testPEq x y = + -- Evaluate the terms once so we can annotate them individually. + -- Then, evaluate `x #== y`. + case (run x, run y) of + ((Right (Script x'), _, _), (Right (Script y'), _, _)) -> do + annotateShow x' + annotateShow y' + pshouldBe (pcon PTrue) (x #== y) + _ -> assert False + +-- | Like `Plutarch.Test.pshouldBe` but in Hedgehog property monad. +pshouldBe :: ClosedTerm a -> ClosedTerm a -> PropertyT IO () +pshouldBe x y = + -- testing equality of Scott encoded types + -- this way is generally prone to false errors + -- hence this function not being directly exposed + case (run x, run y) of + ((Right script1, _, trace1), (Right script2, _, trace2)) -> do + annotateShow trace1 + annotateShow trace2 + annotateShow $ unScript script1 + annotateShow $ unScript script2 + trace1 === trace2 + script1 === script2 + _ -> assert False + +run :: ClosedTerm h -> (Either EvalError Script, ExBudget, [Text]) +run t = evalScriptHugeBudget $ either (error . T.unpack) id $ compile (Config {tracingMode = DetTracing}) t + +{- | A more suitable version of `evalScript` geared towards property tests that + can use lots of resources +-} +evalScriptHugeBudget :: Script -> (Either EvalError Script, ExBudget, [Text]) +evalScriptHugeBudget = + evalScript' $ + ExBudget (ExCPU 10_000_000_000_000) (ExMemory 10_000_000_000) diff --git a/plutarch-test/common/Plutarch/Test/Property/Marshal.hs b/plutarch-test/common/Plutarch/Test/Property/Marshal.hs new file mode 100644 index 000000000..f18238c75 --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/Property/Marshal.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.Test.Property.Marshal ( + Marshal (marshal), +) where + +import Plutarch.Lift (PLifted) +import Plutarch.Prelude + +-- | Class of Haskell types that can be marshalled to a Plutarch term. +class Marshal h (p :: PType) | h -> p where + marshal :: h -> ClosedTerm p + default marshal :: (PLifted p ~ h, PLift p) => h -> ClosedTerm p + marshal x = pconstant x + +instance Marshal h p => Marshal [h] (PList p) where + marshal xs = foldr (\h t -> pcons # marshal h # t) pnil xs + +instance Marshal ha pa => Marshal (Maybe ha) (PMaybe pa) where + marshal (Just x) = pcon $ PJust $ marshal x + marshal Nothing = pcon PNothing + +instance (Marshal ha pa, Marshal hb pb) => Marshal (ha, hb) (PPair pa pb) where + marshal (a, b) = pcon $ PPair (marshal a) (marshal b) + +instance Marshal Integer PInteger where + marshal n = fromInteger n + +instance Marshal Rational PRational where + marshal r = fromRational r + +instance Marshal Bool PBool where + marshal True = pcon PTrue + marshal False = pcon PFalse + +instance Marshal () PUnit where + marshal () = pcon PUnit diff --git a/plutarch-test/common/Plutarch/Test/Run.hs b/plutarch-test/common/Plutarch/Test/Run.hs new file mode 100644 index 000000000..1eecefff1 --- /dev/null +++ b/plutarch-test/common/Plutarch/Test/Run.hs @@ -0,0 +1,116 @@ +module Plutarch.Test.Run ( + noUnusedGoldens, + noUnusedGoldens', + hspecAndReturnForest, +) where + +import Control.Monad (forM_) +import Data.Default (def) +import Data.List (isPrefixOf) +import Data.Set (Set) +import qualified Data.Set as Set +import qualified Data.Text as T +import Plutarch.Test.Golden ( + GoldenConf (GoldenConf, chosenTests, goldenBasePath), + GoldenKey, + goldenTestPath, + mkGoldenKeyFromSpecPath, + ) +import System.Directory (listDirectory) +import System.Environment (getArgs, withArgs) +import System.Exit (ExitCode (ExitFailure), exitWith) +import System.FilePath (()) +import Test.Hspec (Spec) +import Test.Hspec.Core.Runner (defaultConfig, evalSpec, evaluateResult, readConfig, runSpecForest) +import Test.Hspec.Core.Spec (SpecTree, Tree (Leaf, Node, NodeWithCleanup)) + +{- | Like `hspec`, but returns the test forest after running the tests. + + Based on https://github.com/hspec/hspec/issues/649#issuecomment-1092423220 +-} +hspecAndReturnForest :: Spec -> IO [SpecTree ()] +hspecAndReturnForest spec0 = do + (config, spec) <- evalSpec defaultConfig spec0 + getArgs >>= readConfig config + >>= withArgs [] . runSpecForest spec + >>= evaluateResult + return spec + +{- | Ensures that there are no unused goldens left behind. + + Use this on any `SpecTree` that interally uses `pgoldenSpec` to define the + golden tests. These golden file paths are accumulated, and compared to the + actual files existing on disk. If any golden file exists on disk, but is not + tracked by the `SpecTree` this function will fail, reporting the list of + untracked golden files. + + __Example:__ + + @ + noUnusedGoldens =<< hspecAndReturnForest spec + @ +-} +noUnusedGoldens :: [SpecTree ()] -> IO () +noUnusedGoldens = noUnusedGoldens' def + +{- | Like 'noUnusedGoldens' but takes a custom path to the golden storage. + + NOTE: This relies on the assumption that the same 'GoldenConf' is used in all +'pgoldenSpec'' calls. This function will go away after +https://github.com/Plutonomicon/plutarch/issues/458 +-} +noUnusedGoldens' :: GoldenConf -> [SpecTree ()] -> IO () +noUnusedGoldens' conf@(GoldenConf {goldenBasePath}) specForest = do + -- A second traversal here (`runSpecM`) can be obviated after + -- https://github.com/hspec/hspec/issues/649 + let usedGoldens = goldenPathsUsedBy conf specForest + unusedGoldens goldenBasePath usedGoldens >>= \case + [] -> pure () + unused -> do + putStrLn "ERROR: Unused golden files found lying around! Namely:" + forM_ unused $ \fp -> + putStrLn $ "- " <> fp + exitWith (ExitFailure 1) + +-- | Given a list of "used" goldens, return any unused golden files on disk. +unusedGoldens :: FilePath -> [FilePath] -> IO [FilePath] +unusedGoldens goldenBasePath usedGoldens' = do + let usedGoldens = foldMap knownGoldens usedGoldens' + allGoldens <- Set.fromList . fmap (goldenBasePath ) <$> listDirectory goldenBasePath + pure $ + Set.toList $ + Set.filter (not . isPrefixOf (goldenBasePath "FFI.")) $ + allGoldens `Set.difference` usedGoldens + where + knownGoldens :: FilePath -> Set FilePath + knownGoldens fp = + Set.fromList + [ fp + , -- Inject goldens for other flag values to be comprehensive in our + -- search. + replace "dev=true" "dev=false" fp + , replace "dev=false" "dev=true" fp + ] + replace a b = T.unpack . T.replace a b . T.pack + +goldenPathsUsedBy :: GoldenConf -> [SpecTree a] -> [FilePath] +goldenPathsUsedBy (GoldenConf {chosenTests, goldenBasePath}) trees = do + flip foldMap (queryGoldens trees) $ \k -> + flip fmap (Set.toList chosenTests) $ \t -> + goldenTestPath goldenBasePath k t + +-- | Retrieve all golden keys used by the given test tree. +queryGoldens :: [SpecTree a] -> [GoldenKey] +queryGoldens = + -- `drop 1`, to drop the hspec-discover generated root node. + fmap mkGoldenKeyFromSpecPath . concatMap (go []) + where + go ancestors = \case + Node "golden" _children -> + ancestors : [] + Node k children -> + concatMap (go $ T.pack k : ancestors) children + NodeWithCleanup _ _ trees -> + concatMap (go ancestors) trees + Leaf _ -> + mempty diff --git a/plutarch-test/conditional/Plutarch/FFISpec.hs b/plutarch-test/conditional/Plutarch/FFISpec.hs new file mode 100644 index 000000000..f7f41f97c --- /dev/null +++ b/plutarch-test/conditional/Plutarch/FFISpec.hs @@ -0,0 +1,423 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE TemplateHaskell #-} + +module Plutarch.FFISpec (spec) where + +import GHC.Generics (Generic) +import Generics.SOP qualified as SOP +import Plutarch (compile, printScript, printTerm) +import Plutarch.Api.V1 (PCurrencySymbol, PPubKeyHash, PScriptContext, PTokenName, PTxInfo) +import Plutarch.Evaluate (EvalError, evalScript) +import Plutarch.FFI ( + PTxList, + PTxMaybe (PTxJust, PTxNothing), + foreignExport, + foreignImport, + opaqueExport, + opaqueImport, + pmaybeFromTx, + pmaybeToTx, + ) +import Plutarch.List (pconvertLists) +import Plutarch.Prelude +import Plutarch.Rec qualified as Rec +import Plutarch.Rec.TH (deriveAll) +import Plutarch.Test +import Plutus.V1.Ledger.Api ( + Address (Address), + Credential (ScriptCredential), + CurrencySymbol, + DatumHash, + PubKeyHash (..), + ScriptContext (ScriptContext), + ScriptPurpose (Spending), + TxInInfo (TxInInfo, txInInfoOutRef, txInInfoResolved), + TxInfo ( + TxInfo, + txInfoDCert, + txInfoData, + txInfoFee, + txInfoId, + txInfoInputs, + txInfoMint, + txInfoOutputs, + txInfoSignatories, + txInfoValidRange, + txInfoWdrl + ), + TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue), + TxOutRef (TxOutRef), + ValidatorHash, + Value, + adaSymbol, + adaToken, + getTxId, + ) +import Plutus.V1.Ledger.Contexts qualified as Contexts +import Plutus.V1.Ledger.Interval qualified as Interval +import Plutus.V1.Ledger.Scripts (fromCompiledCode) +import Plutus.V1.Ledger.Value qualified as Value +import PlutusTx (CompiledCode, applyCode) +import PlutusTx qualified +import PlutusTx.Builtins.Internal (BuiltinBool, BuiltinUnit) +import PlutusTx.Prelude +import Shrink (shrinkScript, shrinkScriptSp, withoutTactics) + +import Test.Hspec +import Test.Tasty.HUnit ((@?=)) + +-- import Test.Tasty.Plutus.Internal.Context (ContextBuilder (cbSignatories), TransactionConfig(..), compileSpending) +import Prelude (String) +import Prelude qualified + +printCode :: CompiledCode a -> String +printCode = printScript . fromCompiledCode + +printShrunkCode :: CompiledCode a -> String +printShrunkCode = printScript . shrink . shrink . shrink . fromCompiledCode + where + shrink = shrinkScriptSp (withoutTactics ["strongUnsubs", "weakUnsubs"]) + +printEvaluatedCode :: CompiledCode a -> Either EvalError String +printEvaluatedCode = fmap printScript . fstOf3 . evalScript . fromCompiledCode + +printShrunkTerm :: ClosedTerm a -> String +printShrunkTerm x = printScript $ shrinkScript $ compile x + +printEvaluatedTerm :: ClosedTerm a -> Either EvalError String +printEvaluatedTerm s = fmap printScript . fstOf3 . evalScript $ compile s + +fstOf3 :: (a, _, _) -> a +fstOf3 (x, _, _) = x + +doubleInPlutusTx :: CompiledCode (Integer -> Integer) +doubleInPlutusTx = $$(PlutusTx.compile [||(2 *) :: Integer -> Integer||]) + +doubleInPlutarch :: Term s (PInteger :--> PInteger) +doubleInPlutarch = plam (2 Prelude.*) + +doubleImported :: Term s (PInteger :--> PInteger) +doubleImported = foreignImport doubleInPlutusTx + +doubleExported :: PlutusTx.CompiledCode (Integer -> Integer) +doubleExported = foreignExport doubleInPlutarch + +data SampleRecord = SampleRecord + { sampleBool :: BuiltinBool + , sampleInt :: Integer + , sampleString :: BuiltinString + } + deriving stock (Generic) + deriving anyclass (SOP.Generic) + +data PSampleRecord f = PSampleRecord + { psampleBool :: f PBool + , psampleInt :: f PInteger + , psampleString :: f PString + } +$(deriveAll ''PSampleRecord) + +data PSampleRecord' (s :: S) = PSampleRecord' + { psampleBool' :: Term s PBool + , psampleInt' :: Term s PInteger + , psampleString' :: Term s PString + } + deriving stock (Generic) + deriving anyclass (SOP.Generic, PlutusType) + +importedField :: Term _ (PDelayed (Rec.PRecord PSampleRecord) :--> PInteger) +importedField = foreignImport ($$(PlutusTx.compile [||sampleInt||]) :: CompiledCode (SampleRecord -> Integer)) + +exportedField :: CompiledCode (SampleRecord -> Integer) +exportedField = + foreignExport + ( (plam $ \r -> pmatch (pforce r) $ \(Rec.PRecord rr) -> psampleInt rr) :: + Term _ (PDelayed (Rec.PRecord PSampleRecord) :--> PInteger) + ) + +getTxInfo :: Term _ (PAsData PScriptContext :--> PAsData PTxInfo) +getTxInfo = pfield @"txInfo" + +exportedTxInfo :: CompiledCode (PlutusTx.BuiltinData -> PlutusTx.BuiltinData) +exportedTxInfo = foreignExport getTxInfo + +importedTxSignedBy :: Term _ (PAsData PTxInfo :--> PAsData PPubKeyHash :--> PBool) +importedTxSignedBy = foreignImport $$(PlutusTx.compile [||txDataSignedBy||]) + where + txDataSignedBy :: BuiltinData -> BuiltinData -> BuiltinBool + txDataSignedBy tx pkh = toBuiltin $ any id (Contexts.txSignedBy <$> PlutusTx.fromBuiltinData tx <*> PlutusTx.fromBuiltinData pkh) + +importedTxSignedBy' :: Term _ (PAsData PTxInfo :--> PPubKeyHash :--> PBool) +importedTxSignedBy' = foreignImport $$(PlutusTx.compile [||txDataSignedBy||]) + where + txDataSignedBy :: BuiltinData -> PubKeyHash -> BuiltinBool + txDataSignedBy tx pkh = toBuiltin $ any id (flip Contexts.txSignedBy pkh <$> PlutusTx.fromBuiltinData tx) + +type PSValue = PSMap PCurrencySymbol (PSMap PTokenName PInteger) + +type PSMap k v = PTxList (PDelayed (PPair k v)) + +sumValueAmounts :: Term _ (PSValue :--> PInteger) +sumValueAmounts = + pfoldl + # (plam $ \s vals -> pfoldl # (plam $ \s' p -> s' Prelude.+ psnd # p) # s # (psnd # vals)) + # 0 + +pfst :: Term s (PDelayed (PPair a b) :--> a) +pfst = plam $ \p -> pmatch (pforce p) $ \(PPair x _) -> x + +psnd :: Term s (PDelayed (PPair a b) :--> b) +psnd = plam $ \p -> pmatch (pforce p) $ \(PPair _ y) -> y + +---- lifted from https://github.com/Plutonomicon/plutarch/blob/master/examples/Examples/Api.hs ---- + +{- | + An example 'PScriptContext' Term, + lifted with 'pconstant' +-} +ctx :: ScriptContext +ctx = ScriptContext info purpose + +-- | Simple script context, with minting and a single input +info :: TxInfo +info = + TxInfo + { txInfoInputs = [inp] + , txInfoOutputs = [] + , txInfoFee = mempty + , txInfoMint = val + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = signatories + , txInfoData = [] + , txInfoId = "b0" + } + +-- | A script input +inp :: TxInInfo +inp = + TxInInfo + { txInInfoOutRef = ref + , txInInfoResolved = + TxOut + { txOutAddress = + Address (ScriptCredential validator) Nothing + , txOutValue = mempty + , txOutDatumHash = Just datum + } + } + +val :: Value +val = Value.singleton sym "sometoken" 1 <> Value.singleton adaSymbol adaToken 2 + +ref :: TxOutRef +ref = TxOutRef "a0" 0 + +purpose :: ScriptPurpose +purpose = Spending ref + +validator :: ValidatorHash +validator = "a1" + +datum :: DatumHash +datum = "d0" + +sym :: CurrencySymbol +sym = "c0" + +signatories :: [PubKeyHash] +signatories = ["ab01fe235c", "123014", "abcdef"] + +{- | Project wide tests + + @since 0.1 +-} +spec :: Spec +spec = describe "FFI" $ do + describe "Simple types" $ do + it "integer literal" $ + printCode $$(PlutusTx.compile [||42 :: Integer||]) @?= "(program 1.0.0 42)" + it "PlutusTx integer function" $ + printCode doubleInPlutusTx @?= "(program 1.0.0 (\\i0 -> multiplyInteger 2 i1))" + it "Plutarch integer function" $ + printTerm (plam $ \(x :: Term _ PInteger) -> 2 Prelude.* x) @?= "(program 1.0.0 (\\i0 -> multiplyInteger 2 i1))" + it "Imported PlutusTx integer function" $ + printTerm doubleImported @?= "(program 1.0.0 (\\i0 -> multiplyInteger 2 i1))" + it "Exported Plutarch integer function" $ + printCode doubleExported @?= "(program 1.0.0 (\\i0 -> multiplyInteger 2 i1))" + it "Imported and applied PlutusTx integer function" $ + printTerm (plam $ \n -> doubleImported #$ doubleImported # n) + @?= "(program 1.0.0 (\\i0 -> (\\i0 -> multiplyInteger 2 i1) (multiplyInteger 2 i1)))" + it "Exported and applied Plutarch integer function" $ + printCode (doubleExported `applyCode` PlutusTx.liftCode (21 :: Integer)) + @?= "(program 1.0.0 ((\\i0 -> multiplyInteger 2 i1) 21))" + it "Bool->Integer in Plutarch" $ + printShrunkTerm (plam $ \x -> pif x (1 :: Term _ PInteger) 0) + @?= "(program 1.0.0 (\\i0 -> force (force ifThenElse i1 (delay 1) (delay 0))))" + it "Bool->Integer in PlutusTx" $ + printShrunkCode $$(PlutusTx.compile [||\x -> if x then 1 :: Integer else 0||]) + @?= "(program 1.0.0 (\\i0 -> force i1 1 0))" + it "newtype in PlutusTx" $ + printShrunkCode $$(PlutusTx.compile [||PubKeyHash||]) @?= "(program 1.0.0 (\\i0 -> i1))" + it "export unit to PlutusTx" $ + printShrunkCode (foreignExport (pconstant ()) :: CompiledCode BuiltinUnit) @?= "(program 1.0.0 ())" + it "import unit from PlutusTx" $ + printShrunkTerm (foreignImport $$(PlutusTx.compile [||toBuiltin ()||]) :: ClosedTerm PUnit) @?= "(program 1.0.0 ())" + describe "Opaque" $ do + it "Export an integer and ignore it" $ + printCode ($$(PlutusTx.compile [||const (7 :: Integer)||]) `applyCode` opaqueExport (4 :: ClosedTerm PInteger)) + @?= "(program 1.0.0 ((\\i0 -> 7) 4))" + it "Import an integer and ignore it" $ + printTerm (plam (\_ -> 4 :: ClosedTerm PInteger) # opaqueImport (PlutusTx.liftCode (7 :: Integer))) + @?= "(program 1.0.0 ((\\i0 -> 4) 7))" + describe "Records" $ do + it "PlutusTx record value" $ + printShrunkCode $$(PlutusTx.compile [||SampleRecord (toBuiltin False) 6 "Hello"||]) @?= sampleScottEncoding + it "Plutarch HKD record value" $ + printTerm (pdelay $ Rec.rcon $ PSampleRecord (pcon PFalse) 6 "Hello") @?= sampleScottEncoding + it "Plutarch SOP record value" $ + printTerm (pdelay $ pcon $ PSampleRecord' (pcon PFalse) 6 "Hello") @?= sampleScottEncoding + it "PlutusTx record function" $ + printShrunkCode $$(PlutusTx.compile [||sampleInt||]) @?= sampleScottField + it "Plutarch record function" $ + printTerm (plam $ \r -> pforce r # Rec.field psampleInt) @?= sampleScottField + it "Apply PlutusTx record function in Plutarch" $ + printShrunkTerm (importedField #$ pdelay $ pcon $ Rec.PRecord $ PSampleRecord (pcon PFalse) 6 "Hello") @?= "(program 1.0.0 6)" + it "Apply Plutarch record function in PlutusTx" $ + printShrunkCode (exportedField `applyCode` $$(PlutusTx.compile [||SampleRecord (toBuiltin False) 6 "Hello"||])) + @?= "(program 1.0.0 6)" + it "import a pair" $ + printEvaluatedTerm + ( foreignImport (PlutusTx.liftCode ("foo" :: BuiltinString, 4 :: Integer)) :: + Term _ (PDelayed (PPair PString PInteger)) + ) + @?= Right "(program 1.0.0 (delay (\\i0 -> i1 \"foo\" 4)))" + it "import a pair" $ + printEvaluatedTerm + ( foreignImport (PlutusTx.liftCode ("foo" :: Value.TokenName, 4 :: Integer)) :: + Term _ (PDelayed (PPair PTokenName PInteger)) + ) + @?= Right "(program 1.0.0 (delay (\\i0 -> i1 #666f6f 4)))" + describe "Maybe" $ do + it "a PlutusTx Just Integer" $ + printShrunkCode (PlutusTx.liftCode (Just 4 :: Maybe Integer)) @?= justFour + it "a converted Plutarch PJust PInteger" $ + printShrunkTerm (pmaybeToTx # (pcon (PJust 4) :: Term _ (PMaybe PInteger))) @?= justFour + it "a Plutarch PTxJust PInteger" $ + printTerm (pcon (PTxJust 4) :: Term _ (PTxMaybe PInteger)) @?= justFour + it "a converted Plutarch PTxJust PInteger" $ + printShrunkTerm (pmaybeFromTx # (pcon $ PTxJust 4) :: Term _ (PMaybe PInteger)) @?= "(program 1.0.0 (\\i0 -> \\i0 -> i2 4))" + it "a PlutusTx Nothing" $ + printShrunkCode (PlutusTx.liftCode (Nothing :: Maybe Integer)) @?= nothing + it "a converted Plutarch PNothing" $ + printShrunkTerm (pmaybeToTx # (pcon PNothing :: Term _ (PMaybe PInteger))) @?= nothing + it "a Plutarch PTxNothing" $ + printTerm (pcon PTxNothing :: Term _ (PTxMaybe PInteger)) @?= nothing + it "a converted Plutarch PTxNothing" $ + printShrunkTerm (pmaybeFromTx # (pcon PTxNothing) :: Term _ (PMaybe PInteger)) @?= "(program 1.0.0 (\\i0 -> \\i0 -> force i1))" + it "import a Just Integer" $ + printEvaluatedTerm (foreignImport (PlutusTx.liftCode (Just 4 :: Maybe Integer)) :: Term _ (PTxMaybe PInteger)) @?= Right justFour + it "export a PTxJust PInteger" $ + printEvaluatedCode + ( (foreignExport (pcon (PTxJust 4) :: Term _ (PTxMaybe PInteger))) :: + CompiledCode (Maybe Integer) + ) + @?= Right justFour + describe "Lists" $ do + it "a PlutusTx list of integers" $ + printShrunkCode (PlutusTx.liftCode [1 :: Integer .. 3]) @?= oneTwoThree + it "import a list of integers" $ + printEvaluatedTerm (foreignImport (PlutusTx.liftCode [1 :: Integer .. 3]) :: Term _ (PTxList PInteger)) @?= Right oneTwoThree + it "import and map over a Value" $ + printEvaluatedTerm (pmap # pfst # (foreignImport (PlutusTx.liftCode val) :: Term _ PSValue)) + @?= Right "(program 1.0.0 (delay (\\i0 -> \\i0 -> i1 #c0 (delay (\\i0 -> \\i0 -> i1 # (delay (\\i0 -> \\i0 -> i2)))))))" + it "import and fold over a Value" $ + printEvaluatedTerm + (sumValueAmounts # (foreignImport (PlutusTx.liftCode val) :: Term _ PSValue)) + @?= Right "(program 1.0.0 3)" + it "export a list of integers" $ + printEvaluatedCode + ( foreignExport (pconvertLists #$ pconstant @(PBuiltinList PInteger) [1 .. 3] :: Term _ (PTxList PInteger)) :: + CompiledCode [Integer] + ) + @?= Right oneTwoThree + it "export a fold and apply it to a Value" $ + printEvaluatedCode + ((foreignExport sumValueAmounts :: CompiledCode (Value -> Integer)) `PlutusTx.applyCode` PlutusTx.liftCode val) + @?= Right "(program 1.0.0 3)" + + describe "Data" $ do + describe "Export and use a PData :--> PData function" $ do + it "evaluate a field" $ + printEvaluatedCode + ( $$(PlutusTx.compile [||\gti ctx -> maybe "undecoded" (getTxId . txInfoId) (PlutusTx.fromBuiltinData (gti ctx))||]) + `applyCode` exportedTxInfo + `applyCode` PlutusTx.liftCode (PlutusTx.toBuiltinData ctx) + ) + @?= Right "(program 1.0.0 #b0)" + it "evaluate a function to True" $ + printEvaluatedCode + ( $$(PlutusTx.compile [||\gti ctx pkh -> any (`Contexts.txSignedBy` pkh) (PlutusTx.fromBuiltinData (gti ctx))||]) + `applyCode` exportedTxInfo + `applyCode` PlutusTx.liftCode (PlutusTx.toBuiltinData ctx) + `applyCode` PlutusTx.liftCode (head signatories) + ) + @?= Right "(program 1.0.0 (delay (\\i0 -> \\i0 -> i2)))" + it "evaluate a function to False" $ + printEvaluatedCode + ( $$(PlutusTx.compile [||\gti ctx pkh -> any (`Contexts.txSignedBy` pkh) (PlutusTx.fromBuiltinData (gti ctx))||]) + `applyCode` exportedTxInfo + `applyCode` PlutusTx.liftCode (PlutusTx.toBuiltinData ctx) + `applyCode` PlutusTx.liftCode "0123" + ) + @?= Right "(program 1.0.0 (delay (\\i0 -> \\i0 -> i1)))" + + describe "Import and use a BuiltinData -> x function" $ do + it "evaluate a Data -> Data -> Bool function to True" $ + printEvaluatedTerm (importedTxSignedBy # pconstantData info # pconstantData (head signatories)) + @?= Right "(program 1.0.0 True)" + it "evaluate a Data -> Data -> Bool function to False" $ + printEvaluatedTerm (importedTxSignedBy # pconstantData info # pconstantData "0123") + @?= Right "(program 1.0.0 False)" + it "evaluate a Data -> PubKeyHash -> Bool function to True" $ + printEvaluatedTerm (importedTxSignedBy' # pconstantData info # pconstant (head signatories)) + @?= Right "(program 1.0.0 True)" + it "evaluate a Data -> PubKeyHash -> Bool function to False" $ + printEvaluatedTerm (importedTxSignedBy' # pconstantData info # pconstant "0123") + @?= Right "(program 1.0.0 False)" + + describe "Benchmarks" $ do + pgoldenSpec $ do + "Value.isZero" + @| (foreignImport $$(PlutusTx.compile [||toBuiltin . Value.isZero||]) :: Term _ (PSValue :--> PBool)) + @-> \isZero -> passertNot (isZero # foreignImport (PlutusTx.liftCode val)) + "Value.valueOf" + @| ( foreignImport $$(PlutusTx.compile [||Value.valueOf||]) :: + Term _ (PSValue :--> PCurrencySymbol :--> PTokenName :--> PInteger) + ) + @-> \valueOf -> + ( valueOf + # foreignImport (PlutusTx.liftCode val) + # foreignImport (PlutusTx.liftCode adaSymbol) + # foreignImport (PlutusTx.liftCode adaToken) + ) + #@?= (2 :: Term _ PInteger) + "mappend @Value" + @| (foreignImport $$(PlutusTx.compile [||mappend @Value||]) :: Term _ (PSValue :--> PSValue :--> PSValue)) + @-> \plus -> + (plus # foreignImport (PlutusTx.liftCode val) # foreignImport (PlutusTx.liftCode val)) + #@?= (foreignImport (PlutusTx.liftCode $ val <> val) :: Term _ PSValue) + "(==) @Value" + @| ( foreignImport $$(PlutusTx.compile [||\a (b :: Value) -> toBuiltin (a == b)||]) :: + Term _ (PSValue :--> PSValue :--> PBool) + ) + @-> \eq -> + passert (eq # foreignImport (PlutusTx.liftCode val) # foreignImport (PlutusTx.liftCode val)) + where + sampleScottEncoding = "(program 1.0.0 (delay (\\i0 -> i1 False 6 \"Hello\")))" + sampleScottField = "(program 1.0.0 (\\i0 -> force i1 (\\i0 -> \\i0 -> \\i0 -> i2)))" + oneTwoThree, justFour :: String + oneTwoThree = "(program 1.0.0 (delay (\\i0 -> \\i0 -> i1 1 (delay (\\i0 -> \\i0 -> i1 2 (delay (\\i0 -> \\i0 -> i1 3 (delay (\\i0 -> \\i0 -> i2)))))))))" + justFour = "(program 1.0.0 (delay (\\i0 -> \\i0 -> i2 4)))" + nothing = "(program 1.0.0 (delay (\\i0 -> \\i0 -> i1)))" diff --git a/plutarch-test/src/Plutarch/FieldSpec.hs b/plutarch-test/conditional/Plutarch/FieldSpec.hs similarity index 56% rename from plutarch-test/src/Plutarch/FieldSpec.hs rename to plutarch-test/conditional/Plutarch/FieldSpec.hs index 2aefba9cc..4888ab2c0 100644 --- a/plutarch-test/src/Plutarch/FieldSpec.hs +++ b/plutarch-test/conditional/Plutarch/FieldSpec.hs @@ -1,120 +1,91 @@ {-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE UndecidableInstances #-} module Plutarch.FieldSpec (spec) where -import Test.Tasty.HUnit - -import qualified GHC.Generics as GHC -import Generics.SOP (Generic, I (I)) -import Plutarch -import Plutarch.DataRepr ( - PDataFields, - PIsDataReprInstances (PIsDataReprInstances), - ) -import Plutarch.Unsafe (punsafeBuiltin, punsafeCoerce) - import qualified PlutusCore as PLC +import PlutusLedgerApi.V1.Address (Address (Address)) +import PlutusLedgerApi.V1.Credential (Credential (PubKeyCredential)) import qualified PlutusTx +import Test.Tasty.HUnit +import Plutarch.Api.V1 (PAddress (PAddress)) +import Plutarch.Builtin (ppairDataBuiltin) import Plutarch.Prelude +import Plutarch.SpecTypes (PTriplet) import Plutarch.Test +import Plutarch.Unsafe (punsafeBuiltin, punsafeCoerce) +import Test.Hspec spec :: Spec spec = do describe "field" $ do -- example: Trips - describe "trips" $ do + describe "trips" . pgoldenSpec $ do -- compilation - describe "tripSum" $ do - golden All tripSum - describe "getY" $ do - golden All getY - describe "tripYZ" $ do - golden All tripYZ - -- tests - describe "tripSum # tripA = 1000" $ do - let p = 1000 - it "works" $ plift (tripSum # tripA) @?= p - describe "tripSum # tripB = 100" $ do - let p = 100 - it "works" $ plift (tripSum # tripB) @?= p - describe "tripSum # tripC = 10" $ do - let p = 10 - it "works" $ plift (tripSum # tripC) @?= p - describe "tripYZ = tripZY" $ - it "works" $ tripZY #@?= tripYZ + "lam" @\ do + "tripSum" @| tripSum + "getY" @| getY + "tripYZ" @| tripYZ + "tripSum" @\ do + "A" @| tripSum # tripA @-> \p -> + plift p @?= 1000 + "B" @| tripSum # tripB @-> \p -> + plift p @?= 100 + "C" @| tripSum # tripC @-> \p -> + plift p @?= 10 + "tripYZ=tripZY" @| tripZY @== tripYZ -- rangeFields - describe "rangeFields" $ do + describe "rangeFields" . pgoldenSpec $ do -- compilation - describe "rangeFields" $ do - golden All rangeFields - -- tests - describe "rangeFields someFields = 11" $ do - let p = 11 - it "works" $ plift (rangeFields # someFields) @?= p + "lam" @| rangeFields + "app" @| rangeFields # someFields @-> \p -> plift p @?= 11 -- dropFields - describe "dropFields" $ do + describe "dropFields" . pgoldenSpec $ do -- compilation - describe "dropFields" $ do - golden All dropFields - -- tests - describe "dropFields someFields = 17" $ do - let p = 17 - it "works" $ plift (dropFields # someFields) @?= p + "lam" @| dropFields + "app" @| dropFields # someFields @-> \p -> plift p @?= 17 -- pletFields - describe "pletFields" $ do + describe "pletFields" . pgoldenSpec $ do -- compilation - describe "letSomeFields" $ do - golden All letSomeFields - describe "nFields" $ do - golden All nFields - -- tests - describe "letSomeFields = letSomeFields'" $ do - it "works" $ letSomeFields #@?= letSomeFields' - describe "letSomeFields someFields = 14" $ do - let p = 14 - it "works" $ plift (letSomeFields # someFields) @?= p - describe "nFields someFields = 1" $ do - let p = 1 - it "works" $ plift (nFields # someFields) @?= p - describe "other" $ do - -- tests - describe "by = 10" $ do - let p = 10 - it "works" $ plift by @?= p - describe "dotPlus = 19010" $ do - let p = 19010 - it "works" $ plift dotPlus @?= p + "letSomeFields" @\ do + "lam" @| letSomeFields + "order" @| letSomeFields' @== letSomeFields + "app" @| letSomeFields # someFields @-> \p -> plift p @?= 14 + "nFields" @\ do + "lam" @| nFields + "app" @| nFields # someFields @-> \p -> plift p @?= 1 + describe "other" . pgoldenSpec $ do + "by" @| by @-> \p -> plift p @?= 10 + "dotPlus" @| dotPlus @-> \p -> plift p @?= 19010 + describe "data" . pgoldenSpec $ do + "pmatch-pfield" @\ do + -- These two should ideally have the exact same efficiency. + "pmatch" @\ do + "newtype" + @| let addr = pconstant $ Address (PubKeyCredential "ab") Nothing + in pmatch addr $ \(PAddress addrFields) -> + pletFields @'["credential", "stakingCredential"] addrFields $ \y -> + ppairDataBuiltin # getField @"credential" y # getField @"stakingCredential" y + "pfield" @\ do + "newtype" + @| let addr = pconstant $ Address (PubKeyCredential "ab") Nothing + in pletFields @'["credential", "stakingCredential"] addr $ \y -> + ppairDataBuiltin # getField @"credential" y # getField @"stakingCredential" y + "pfield-pletFields" @\ do + "pfield" @\ do + "single" + @| let addr = pconstant $ Address (PubKeyCredential "ab") Nothing + in pfromData $ pfield @"credential" # addr + "pletFields" @\ do + "single" + @| let addr = pconstant $ Address (PubKeyCredential "ab") Nothing + in pletFields @'["credential"] addr $ \y -> + pfromData $ getField @"credential" y -------------------------------------------------------------------------------- -{- | - We can defined a data-type using PDataRecord, with labeled fields. - - With an appropriate instance of 'PIsDataRepr', we can automatically - derive 'PDataFields'. --} -newtype Triplet (a :: PType) (s :: S) - = Triplet - ( Term - s - ( PDataRecord - '[ "x" ':= a - , "y" ':= a - , "z" ':= a - ] - ) - ) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData, PDataFields) - via (PIsDataReprInstances (Triplet a)) - mkTrip :: - forall a s. (PIsData a) => Term s a -> Term s a -> Term s a -> Term s (Triplet a) + forall a s. (PIsData a) => Term s a -> Term s a -> Term s a -> Term s (PTriplet a) mkTrip x y z = punsafeBuiltin PLC.ConstrData # (0 :: Term _ PInteger) # ( ( pcons # (pdata x) @@ -126,19 +97,19 @@ mkTrip x y z = ) -- | An example term -tripA :: Term s (Triplet PInteger) +tripA :: Term s (PTriplet PInteger) tripA = mkTrip 150 750 100 -- | Another -tripB :: Term s (Triplet PInteger) +tripB :: Term s (PTriplet PInteger) tripB = mkTrip 50 10 40 -- | Another -tripC :: Term s (Triplet PInteger) +tripC :: Term s (PTriplet PInteger) tripC = mkTrip 1 8 1 --- | Nested triplet -tripTrip :: Term s (Triplet (Triplet PInteger)) +-- | Nested PTriplet +tripTrip :: Term s (PTriplet (PTriplet PInteger)) tripTrip = mkTrip tripA tripB tripC {- | @@ -148,7 +119,7 @@ tripTrip = mkTrip tripA tripB tripC The fields in the 'HRec' can them be accessed with RecordDotSyntax. -} -tripSum :: Term s ((Triplet PInteger) :--> PInteger) +tripSum :: Term s ((PTriplet PInteger) :--> PInteger) tripSum = plam $ \x -> pletFields @["x", "y", "z"] x $ \fs -> @@ -159,7 +130,7 @@ tripSum = {- | A subset of fields can be specified. -} -tripYZ :: Term s ((Triplet PInteger) :--> PInteger) +tripYZ :: Term s ((PTriplet PInteger) :--> PInteger) tripYZ = plam $ \x -> pletFields @["y", "z"] x $ \fs -> @@ -169,7 +140,7 @@ tripYZ = The ordering of fields specified is irrelevant, this is equivalent to 'tripYZ'. -} -tripZY :: Term s ((Triplet PInteger) :--> PInteger) +tripZY :: Term s ((PTriplet PInteger) :--> PInteger) tripZY = plam $ \x -> pletFields @["z", "y"] x $ \fs -> @@ -184,7 +155,7 @@ tripZY = by :: Term s PInteger by = pfield @"y" # tripB -getY :: Term s (Triplet PInteger :--> PAsData PInteger) +getY :: Term s (PTriplet PInteger :--> PAsData PInteger) getY = pfield @"y" {- | diff --git a/plutarch-test/conditional/Plutarch/MonadicSpec.hs b/plutarch-test/conditional/Plutarch/MonadicSpec.hs new file mode 100644 index 000000000..3c082bb4e --- /dev/null +++ b/plutarch-test/conditional/Plutarch/MonadicSpec.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE QualifiedDo #-} + +module Plutarch.MonadicSpec (spec) where + +import Plutarch.Api.V1 ( + PAddress (PAddress), + PCredential, + PMaybeData, + PPubKeyHash, + PScriptContext, + PScriptPurpose (PSpending), + PStakingCredential, + ) +import qualified Plutarch.ApiSpec as ApiSpec +import qualified Plutarch.Monadic as P +import Plutarch.Prelude +import Plutarch.Test +import PlutusLedgerApi.V1 +import Test.Hspec + +spec :: Spec +spec = do + describe "monadic" $ do + {- TODO: Uncomment this after flakiness is fixed + See https://github.com/Plutonomicon/plutarch/issues/290 + -} + {- describe "pmatch-twice" . pgoldenSpec $ do + -- We expect all these benchmarks to produce equivalent numbers + let integerList :: [Integer] -> Term s (PList PInteger) + integerList xs = List.pconvertLists #$ pconstant @(PBuiltinList PInteger) xs + xs = integerList [1 .. 10] + "normal" + @| pmatch xs + $ \case + PSCons _x xs' -> do + pmatch xs' $ \case + PSCons _ xs'' -> + xs'' + PSNil -> perror + PSNil -> perror + "do" + @| P.do + PSCons _ xs' <- pmatch xs + PSCons _ xs'' <- pmatch xs' + xs'' + "cont" + @| flip runCont id + $ do + ls <- cont $ pmatch xs + case ls of + PSCons _ xs' -> do + ls' <- cont $ pmatch xs' + case ls' of + PSCons _ xs'' -> pure xs'' + PSNil -> pure perror + PSNil -> pure perror + "termcont" + @| unTermCont + $ do + PSCons _ xs' <- TermCont $ pmatch xs + PSCons _ xs'' <- TermCont $ pmatch xs' + pure xs'' + -} + describe "api.example" $ do + -- The checkSignatory family of functions implicitly use tracing due to + -- monadic syntax, and as such we need two sets of tests here. + describe "signatory" . pgoldenSpec $ do + let aSig :: PubKeyHash = "ab01fe235c" + "do" @\ do + "succeeds" @| checkSignatory # pconstant aSig # ApiSpec.ctx @-> psucceeds + "fails" @| checkSignatory # pconstant "41" # ApiSpec.ctx @-> pfails + describe "getFields" . pgoldenSpec $ do + "0" @| getFields + +checkSignatory :: Term s (PPubKeyHash :--> PScriptContext :--> PUnit) +checkSignatory = plam $ \ph ctx' -> + pletFields @["txInfo", "purpose"] ctx' $ \ctx -> P.do + PSpending _ <- pmatch $ ctx.purpose + let signatories = pfield @"signatories" # ctx.txInfo + pif + (pelem # pdata ph # pfromData signatories) + -- Success! + (pconstant ()) + -- Signature not present. + perror + +getFields :: Term s (PAddress :--> PDataRecord '["credential" ':= PCredential, "stakingCredential" ':= PMaybeData PStakingCredential]) +getFields = phoistAcyclic $ + plam $ \addr -> P.do + PAddress addrFields <- pmatch addr + addrFields diff --git a/plutarch-test/conditional/Plutarch/TryFromSpec.hs b/plutarch-test/conditional/Plutarch/TryFromSpec.hs new file mode 100644 index 000000000..a70ca8fac --- /dev/null +++ b/plutarch-test/conditional/Plutarch/TryFromSpec.hs @@ -0,0 +1,445 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.TryFromSpec (spec) where + +-- Plutus and PlutusTx imports + +import PlutusTx ( + Data (B, Constr, I), + ) + +-- Plutarch imports +import Plutarch.Prelude + +import Plutarch.Test + +import Plutarch.Unsafe ( + punsafeCoerce, + punsafeDowncast, + ) + +import Plutarch.Api.V1 ( + PAddress, + PDatum, + PDatumHash, + PMaybeData (PDJust), + PScriptContext, + PScriptPurpose (PSpending), + PTuple, + PTxInInfo, + PTxInfo, + PTxOut, + PTxOutRef, + PValidator, + ) + +import Plutarch.Builtin ( + pforgetData, + ppairDataBuiltin, + ) + +import Plutarch.TryFrom ( + PTryFromExcess, + ptryFrom', + ) + +import Plutarch.ApiSpec (invalidContext1, validContext0) +import Plutarch.Reducible (Reduce) + +import Plutarch.Extra.TermCont +import Test.Hspec + +spec :: Spec +spec = do + describe "data-verif" . pgoldenSpec $ do + "erroneous" @\ do + "(String, Integer) /= (String, String)" + @| checkDeep + @(PBuiltinPair (PAsData PInteger) (PAsData PByteString)) + @(PBuiltinPair (PAsData PByteString) (PAsData PByteString)) + (pdata $ ppairDataBuiltin # (pdata $ pconstant "foo") # (pdata $ pconstant "bar")) + @-> pfails + "[String] /= [Integer]" + @| checkDeep + @(PBuiltinList (PAsData PByteString)) + @(PBuiltinList (PAsData PInteger)) + (pdata $ (pcons # (pdata $ pconstant 3)) #$ (psingleton # (pdata $ pconstant 4))) + @-> pfails + "A { test := Integer, test2 := Integer } /= { test := String, test2 := Integer }" + @| checkDeep + @(PDataRecord (("foo" ':= PInteger) ': ("bar" ':= PInteger) ': '[])) + @(PDataRecord (("foo" ':= PByteString) ': ("bar" ':= PInteger) ': '[])) + (pdata (pdcons @"foo" # (pdata $ pconstant "baz") #$ pdcons @"bar" # (pdata $ pconstant 42) # pdnil)) + @-> pfails + "PDataSum constr 2" + @| checkDeep + @(PDataSum '[ '["i1" ':= PInteger, "b2" ':= PByteString]]) + @(PDataSum '[ '["i1" ':= PInteger, "b2" ':= PByteString], '["i3" ':= PInteger, "b4" ':= PByteString]]) + (punsafeCoerce $ pconstant $ Constr 1 [PlutusTx.I 5, B "foo"]) + @-> pfails + "PDataSum wrong record type" + @| checkDeep + @(PDataSum '[ '["i1" ':= PInteger, "b2" ':= PByteString], '["i3" ':= PByteString, "b4" ':= PByteString]]) + @(PDataSum '[ '["i1" ':= PInteger, "b2" ':= PByteString], '["i3" ':= PInteger, "b4" ':= PByteString]]) + (punsafeCoerce $ pconstant $ Constr 2 [PlutusTx.I 5, B "foo"]) + @-> pfails + "[ByteString] (with length == 2) /= PRational" + @| checkDeep + @PRational + @(PBuiltinList (PAsData PByteString)) + (pdata $ pcons # pdata (phexByteStr "41") #$ pcons # pdata (phexByteStr "2b") # pnil) + @-> pfails + "[Integer] (with length == 0) /= PRational" + @| checkDeep + @PRational + @(PBuiltinList (PAsData PInteger)) + (pdata $ pnil) + @-> pfails + "[Integer] (with length == 3) /= PRational" + @| checkDeep + @PRational + @(PBuiltinList (PAsData PInteger)) + (pdata $ pcons # pconstantData 42 #$ pcons # pconstantData 7 #$ pcons # pconstantData 0 # pnil) + @-> pfails + "[Integer] (with length == 2, with 0 denominator) /= PRational" + @| checkDeep + @PRational + @(PBuiltinList (PAsData PInteger)) + (pdata $ pcons # pconstantData 42 #$ pcons # pconstantData 0 # pnil) + @-> pfails + "working" @\ do + "(String, String) == (String, String)" + @| checkDeep + @(PBuiltinPair (PAsData PByteString) (PAsData PByteString)) + @(PBuiltinPair (PAsData PByteString) (PAsData PByteString)) + (pdata $ ppairDataBuiltin # (pdata $ pconstant "foo") # (pdata $ pconstant "bar")) + @-> psucceeds + "[String] == [String]" + @| checkDeep + @(PBuiltinList (PAsData PByteString)) + @(PBuiltinList (PAsData PByteString)) + (pdata $ (pcons # (pdata $ pconstant "foo")) #$ (psingleton # (pdata $ pconstant "bar"))) + @-> psucceeds + "[Integer] (with length == 2) == PRational" + @| ( unTermCont $ do + let numr = pconstantData 42 + let denm = pconstantData 31 + (drat, nz) <- + checkDeep' @PRational @(PBuiltinList (PAsData PInteger)) + (pdata $ pcons # numr #$ pcons # denm # pnil) + pguardC "non-zero should be as expected" $ pto nz #== pfromData denm + pguardC "drat should be as expected" $ pfromData drat #== pcon (PRational (pfromData numr) nz) + pure $ pconstant () + ) + @-> psucceeds + "A { test := Integer, test2 := Integer } == { test := Integer, test2 := Integer }" + @| checkDeep + @(PDataRecord (("foo" ':= PInteger) ': ("bar" ':= PInteger) ': '[])) + @(PDataRecord (("foo" ':= PInteger) ': ("bar" ':= PInteger) ': '[])) + (pdata (pdcons @"foo" # (pdata $ pconstant 7) #$ pdcons @"bar" # (pdata $ pconstant 42) # pdnil)) + @-> psucceeds + "A { test := Integer, test2 := Integer } == [Integer]" + @| checkDeep + @(PDataRecord (("foo" ':= PInteger) ': ("bar" ':= PInteger) ': '[])) + @(PBuiltinList (PAsData PInteger)) + (pdata (pcons # (pdata $ pconstant 7) #$ pcons # (pdata $ pconstant 42) # pnil)) + @-> psucceeds + "A { test := String, test2 := Integer } == { test := String, test2 := Integer }" + @| checkDeep + @(PDataRecord (("foo" ':= PByteString) ': ("bar" ':= PInteger) ': '[])) + @(PDataRecord (("foo" ':= PByteString) ': ("bar" ':= PInteger) ': '[])) + (pdata (pdcons @"foo" # (pdata $ pconstant "baz") #$ pdcons @"bar" # (pdata $ pconstant 42) # pdnil)) + @-> psucceeds + "PDataSum constr 0" + @| checkDeep + @(PDataSum '[ '["i1" ':= PInteger, "b2" ':= PByteString], '["i3" ':= PInteger, "b4" ':= PByteString]]) + @(PDataSum '[ '["i1" ':= PInteger, "b2" ':= PByteString], '["i3" ':= PInteger, "b4" ':= PByteString]]) + (punsafeCoerce $ pconstant $ Constr 0 [PlutusTx.I 5, B "foo"]) + @-> psucceeds + "PDataSum constr 1" + @| checkDeep + @(PDataSum '[ '["i1" ':= PInteger, "b2" ':= PByteString], '["i3" ':= PInteger, "b4" ':= PByteString]]) + @(PDataSum '[ '["i1" ':= PInteger, "b2" ':= PByteString], '["i3" ':= PInteger, "b4" ':= PByteString]]) + (punsafeCoerce $ pconstant $ Constr 1 [PlutusTx.I 5, B "foo"]) + @-> psucceeds + "recover PWrapInt" + @| pconstant 42 #== (unTermCont $ snd <$> tcont (ptryFrom @(PAsData PWrapInt) (pforgetData $ pdata $ pconstant @PInteger 42))) + @-> passert + "recovering a record partially vs completely" @\ do + "partially" + @| checkDeep + @(PDataRecord '["foo" ':= PInteger, "bar" ':= PData]) + @(PDataRecord '["foo" ':= PInteger, "bar" ':= PByteString]) + (pdata $ pdcons @"foo" # (pdata $ pconstant 3) #$ pdcons @"bar" # (pdata $ pconstant "baz") # pdnil) + @-> psucceeds + "completely" + @| checkDeep + @(PDataRecord '["foo" ':= PInteger, "bar" ':= PByteString]) + @(PDataRecord '["foo" ':= PInteger, "bar" ':= PByteString]) + (pdata (pdcons @"foo" # (pdata $ pconstant 3) #$ pdcons @"bar" # (pdata $ pconstant "baz") # pdnil)) + @-> psucceeds + "removing the data wrapper" @\ do + "erroneous" @\ do + "(String, Integer) /= (String, String)" + @| checkDeepUnwrap + @(PBuiltinPair (PAsData PByteString) (PAsData PByteString)) + @(PBuiltinPair (PAsData PInteger) (PAsData PByteString)) + (pdata $ ppairDataBuiltin # (pdata $ pconstant 42) # (pdata $ pconstant "bar")) + @-> pfails + "[String] /= [Integer]" + @| ( checkDeepUnwrap + @(PBuiltinList (PAsData PInteger)) + @(PBuiltinList (PAsData PByteString)) + (pdata $ (pcons # (pdata $ pconstant "foo")) #$ (psingleton # (pdata $ pconstant "baz"))) + ) + @-> pfails + "working" @\ do + "(String, String) == (String, String)" + @| ( checkDeepUnwrap + @(PBuiltinPair (PAsData PByteString) (PAsData PByteString)) + @(PBuiltinPair (PAsData PByteString) (PAsData PByteString)) + (pdata $ ppairDataBuiltin # (pdata $ pconstant "foo") # (pdata $ pconstant "bar")) + ) + @-> psucceeds + "[String] == [String]" + @| checkDeepUnwrap + @(PBuiltinList (PAsData PByteString)) + @(PBuiltinList (PAsData PByteString)) + (pdata $ (pcons # (pdata $ pconstant "foo")) #$ (psingleton # (pdata $ pconstant "bar"))) + @-> psucceeds + "partial checks" @\ do + -- this is way more expensive ... + "check whole structure" + @| fullCheck @-> psucceeds + -- ... than this + "check structure partly" + @| partialCheck @-> psucceeds + "recovering a nested record" @\ do + "succeeds" + @| checkDeep + @(PDataRecord '["_0" ':= (PDataRecord '["_1" ':= PInteger])]) + @(PDataRecord '["_0" ':= (PDataRecord '["_1" ':= PInteger])]) + (pdata $ pdcons # (pdata $ pdcons # pdata (pconstant 42) # pdnil) # pdnil) + @-> psucceeds + "fails" + @| checkDeep + @(PDataRecord '["_0" ':= (PDataRecord '["_1" ':= PByteString])]) + @(PDataRecord '["_0" ':= (PDataRecord '["_1" ':= PInteger])]) + (pdata $ pdcons # (pdata $ pdcons # pdata (pconstant 42) # pdnil) # pdnil) + @-> pfails + "sample usage contains the right value" + @| pconstant 42 #== theField @-> passert + "example" @\ do + let l1 :: Term _ (PAsData (PBuiltinList (PAsData PInteger))) + l1 = toDatadList [1 .. 5] + l2 :: Term _ (PAsData (PBuiltinList (PAsData PInteger))) + l2 = toDatadList [6 .. 10] + l3 :: Term _ (PAsData (PBuiltinList (PAsData PInteger))) + l3 = toDatadList [6 .. 9] + l4 :: Term _ (PAsData (PBuiltinList (PAsData PInteger))) + l4 = toDatadList [6, 8, 8, 9, 10] + "concatenate two lists, legal" + @| validator # pforgetData l1 # pforgetData l2 # validContext0 @-> psucceeds + "concatenate two lists, illegal (list too short)" + @| validator # pforgetData l1 # pforgetData l3 # validContext0 @-> pfails + "concatenate two lists, illegal (wrong elements in list)" + @| validator # pforgetData l1 # pforgetData l4 # validContext0 @-> pfails + "concatenate two lists, illegal (more than one output)" + @| validator # pforgetData l1 # pforgetData l2 # invalidContext1 @-> pfails + "example2" @\ do + "recovering a record succeeds" + @| recoverAB @-> psucceeds + +------------------- Checking deeply, shallowly and unwrapping ---------------------- + +checkDeep :: + forall (target :: PType) (actual :: PType). + ( PTryFrom PData (PAsData target) + , PIsData actual + , PIsData target + ) => + ClosedTerm (PAsData actual) -> + ClosedTerm (PAsData target) +checkDeep t = unTermCont $ fst <$> checkDeep' t + +checkDeep' :: + forall (target :: PType) (actual :: PType) (s :: S). + ( PTryFrom PData (PAsData target) + , PIsData actual + , PIsData target + ) => + ClosedTerm (PAsData actual) -> + TermCont s ((Term s (PAsData target), Reduce (PTryFromExcess PData (PAsData target) s))) +checkDeep' t = TermCont (ptryFrom @(PAsData target) $ pforgetData t) + +checkDeepUnwrap :: + forall (target :: PType) (actual :: PType) (s :: S). + ( PTryFrom PData (PAsData target) + , PIsData actual + , PIsData target + ) => + Term s (PAsData actual) -> + Term s (PAsData target) +checkDeepUnwrap t = unTermCont $ fst <$> TermCont (ptryFrom @(PAsData target) $ pforgetData t) + +sampleStructure :: Term _ (PAsData (PBuiltinList (PAsData (PBuiltinList (PAsData (PBuiltinList (PAsData PInteger))))))) +sampleStructure = pdata $ psingleton #$ pdata $ psingleton #$ toDatadList [1 .. 100] + +-- | PData serves as the base case for recursing into the structure +partialCheck :: Term _ (PAsData (PBuiltinList (PAsData (PBuiltinList PData)))) +partialCheck = + let dat :: Term _ PData + dat = pforgetData sampleStructure + in unTermCont $ fst <$> TermCont (ptryFrom dat) + +fullCheck :: Term _ (PAsData (PBuiltinList (PAsData (PBuiltinList (PAsData (PBuiltinList (PAsData PInteger))))))) +fullCheck = unTermCont $ fst <$> TermCont (ptryFrom $ pforgetData sampleStructure) + +------------------- Example: untrusted Redeemer ------------------------------------ + +newtype PNatural (s :: S) = PMkNatural (Term s PInteger) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PNatural where type DPTStrat _ = PlutusTypeNewtype + +-- | partial +pmkNatural :: Term s (PInteger :--> PNatural) +pmkNatural = plam $ \i -> pif (i #< 0) (ptraceError "could not make natural") (pcon $ PMkNatural i) + +newtype Flip f b a = Flip (f a b) + deriving stock (Generic) + +instance PTryFrom PData (PAsData PNatural) where + type PTryFromExcess PData (PAsData PNatural) = Flip Term PNatural + ptryFrom' opq = runTermCont $ do + (ter, exc) <- TermCont $ ptryFrom @(PAsData PInteger) opq + ver <- tcont $ plet $ pmkNatural #$ exc + pure (punsafeDowncast ter, ver) + +validator :: Term s PValidator +validator = phoistAcyclic $ + plam $ \dat red ctx -> unTermCont $ do + trustedRedeemer <- (\(snd -> red) -> red) <$> (TermCont $ ptryFrom @(PAsData (PBuiltinList (PAsData PNatural))) red) + let trustedDatum :: Term _ (PBuiltinList (PAsData PNatural)) + trustedDatum = pfromData $ punsafeCoerce dat + -- make the Datum and Redeemer trusted + + txInfo :: (Term _ PTxInfo) <- tcont $ plet $ pfield @"txInfo" # ctx + + PJust ownInput <- tcont $ pmatch $ pfindOwnInput # ctx + resolved <- tcont $ pletFields @["address", "datumHash"] $ pfield @"resolved" # ownInput + + let ownAddress :: Term _ PAddress + ownAddress = resolved.address + -- find own script address matching DatumHash + + ownHash :: Term _ PDatumHash + ownHash = unTermCont $ do + PDJust dhash <- tcont $ pmatch resolved.datumHash + pure $ pfield @"_0" # dhash + + data' :: Term _ (PBuiltinList (PAsData (PTuple PDatumHash PDatum))) + data' = pfield @"datums" # txInfo + + outputs :: Term _ (PBuiltinList PTxOut) + outputs = pfield @"outputs" # txInfo + -- find the list of the outputs + + matchingHashDatum :: Term _ (PBuiltinList PDatum) + matchingHashDatum = + precList + ( \self x xs -> pletFields @["_0", "_1"] x $ + \tup -> + ptrace "iteration" $ + pif + (tup._0 #== ownHash) + (ptrace "appended something" pcons # (tup._1) # (self # xs)) + (ptrace "called without appending" self # xs) + ) + (const pnil) + #$ data' + -- filter and map at the same time, as there is no efficient way + -- to do that with tools available, I wrote it by hand + + singleOutput :: Term _ PBool + singleOutput = pnull #$ ptail #$ pfilter # pred # outputs + where + pred :: Term _ (PTxOut :--> PBool) + pred = plam $ \out -> unTermCont $ do + pure $ pfield @"address" # pdata out #== pdata ownAddress + + -- make sure that after filtering the outputs, only one output + -- remains + + resultList :: Term _ (PAsData (PBuiltinList (PAsData PNatural))) + resultList = pdata $ pconcat # trustedDatum # trustedRedeemer + -- the resulting list with trusted datum and trusted redeemer + + isValid :: Term _ PBool + isValid = pif singleOutput (pto (phead # matchingHashDatum) #== pforgetData resultList) (pcon PFalse) + -- the final check for validity + pure $ + pif isValid (popaque $ pcon PUnit) (ptraceError "not valid") + +pfindOwnInput :: Term s (PScriptContext :--> PMaybe PTxInInfo) +pfindOwnInput = phoistAcyclic $ + plam $ \ctx' -> unTermCont $ do + ctx <- tcont $ pletFields @["txInfo", "purpose"] ctx' + PSpending txoutRef <- tcont $ pmatch $ ctx.purpose + let txInInfos :: Term _ (PBuiltinList PTxInInfo) + txInInfos = pfield @"inputs" #$ ctx.txInfo + target :: Term _ PTxOutRef + target = pfield @"_0" # txoutRef + pred :: Term _ (PTxInInfo :--> PBool) + pred = plam $ \actual -> + target #== pfield @"outRef" # actual + pure $ pfind # pred # txInInfos + +------------- Helpers -------------------------------------------------------- + +toDatadList :: [Integer] -> Term s (PAsData (PBuiltinList (PAsData PInteger))) +toDatadList = pdata . (foldr go pnil) + where + go :: Integer -> Term _ (PBuiltinList (PAsData PInteger)) -> Term _ (PBuiltinList (PAsData PInteger)) + go i acc = pcons # (pdata $ pconstant i) # acc + +------------------- Sample type with PIsDataRepr ----------------------------------- + +sampleAB :: Term s (PAsData PAB) +sampleAB = pdata $ pcon $ PA (pdcons @"_0" # (pdata $ pconstant 4) #$ pdcons # (pdata $ pconstant "foo") # pdnil) + +sampleABdata :: Term s PData +sampleABdata = pforgetData sampleAB + +recoverAB :: Term s (PAsData PAB) +recoverAB = unTermCont $ fst <$> tcont (ptryFrom sampleABdata) + +data PAB (s :: S) + = PA (Term s (PDataRecord '["_0" ':= PInteger, "_1" ':= PByteString])) + | PB (Term s (PDataRecord '["_0" ':= PBuiltinList (PAsData PInteger), "_1" ':= PByteString])) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData) +instance DerivePlutusType PAB where type DPTStrat _ = PlutusTypeData +instance PTryFrom PData (PAsData PAB) + +------------------- Sample usage with recovered record type ------------------------ + +untrustedRecord :: Term s PData +untrustedRecord = + let rec :: Term s (PAsData (PDataRecord '["_0" ':= (PDataRecord '["_1" ':= PInteger])])) + rec = pdata $ pdcons # (pdata $ pdcons # pdata (pconstant 42) # pdnil) # pdnil + in pforgetData rec + +theField :: Term s PInteger +theField = unTermCont $ do + (_, exc) <- tcont (ptryFrom @(PAsData (PDataRecord '["_0" ':= (PDataRecord '["_1" ':= PInteger])])) untrustedRecord) + pure $ snd . getField @"_1" . snd . snd . getField @"_0" . snd $ exc + +------------------- Sample usage DerivePNewType ------------------------------------ + +newtype PWrapInt (s :: S) = PWrapInt (Term s PInteger) + deriving stock (Generic) + deriving anyclass (PlutusType, PEq, PPartialOrd, POrd) +instance DerivePlutusType PWrapInt where type DPTStrat _ = PlutusTypeNewtype +instance PTryFrom PData (PAsData PWrapInt) diff --git a/plutarch-test/goldens/api.ctx.bench.golden b/plutarch-test/goldens/api.ctx.bench.golden new file mode 100644 index 000000000..50b3f05c1 --- /dev/null +++ b/plutarch-test/goldens/api.ctx.bench.golden @@ -0,0 +1,7 @@ +term {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":140} +get.txInfo {"exBudgetCPU":460976,"exBudgetMemory":1496,"scriptSizeBytes":149} +get.mint {"exBudgetCPU":1597398,"exBudgetMemory":5388,"scriptSizeBytes":177} +get.credentials {"exBudgetCPU":4834417,"exBudgetMemory":15200,"scriptSizeBytes":242} +get.sym {"exBudgetCPU":10539781,"exBudgetMemory":31123,"scriptSizeBytes":339} +ScriptPurpose.literal {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":48} +ScriptPurpose.decode {"exBudgetCPU":1247652,"exBudgetMemory":3498,"scriptSizeBytes":74} \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.credentials.bench.golden b/plutarch-test/goldens/api.ctx.get.credentials.bench.golden deleted file mode 100644 index d158e9e3f..000000000 --- a/plutarch-test/goldens/api.ctx.get.credentials.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":8007639,"exBudgetMemory":15200,"scriptSizeBytes":242} \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.credentials.uplc.eval.golden b/plutarch-test/goldens/api.ctx.get.credentials.uplc.eval.golden deleted file mode 100644 index 761dcf417..000000000 --- a/plutarch-test/goldens/api.ctx.get.credentials.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 [#41a1]) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.credentials.uplc.golden b/plutarch-test/goldens/api.ctx.get.credentials.uplc.golden deleted file mode 100644 index bffa1ca61..000000000 --- a/plutarch-test/goldens/api.ctx.get.credentials.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay [ ]) (delay (force mkCons (i3 (i5 i1)) (i2 (i4 i1))))))) (\i0 -> i3 (i5 (unConstrData ((\i0 -> i4 (i5 i1)) ((\i0 -> i4 (i5 i1)) (i3 (i2 (i4 i1)))))))) ((\i0 -> unListData (i3 (i4 i1))) ((\i0 -> i3 (i4 i1)) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff))) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.mint.bench.golden b/plutarch-test/goldens/api.ctx.get.mint.bench.golden deleted file mode 100644 index 45672ad50..000000000 --- a/plutarch-test/goldens/api.ctx.get.mint.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":2838750,"exBudgetMemory":5388,"scriptSizeBytes":177} \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.mint.uplc.eval.golden b/plutarch-test/goldens/api.ctx.get.mint.uplc.eval.golden deleted file mode 100644 index 3a63e9a6d..000000000 --- a/plutarch-test/goldens/api.ctx.get.mint.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 #a141c0a149736f6d65746f6b656e01) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.mint.uplc.golden b/plutarch-test/goldens/api.ctx.get.mint.uplc.golden deleted file mode 100644 index 9dc0fb79f..000000000 --- a/plutarch-test/goldens/api.ctx.get.mint.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i3 ((\i0 -> i3 (i3 (i3 i1))) (i4 i1))) ((\i0 -> i3 (i4 i1)) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.sym.bench.golden b/plutarch-test/goldens/api.ctx.get.sym.bench.golden deleted file mode 100644 index 4964f58c5..000000000 --- a/plutarch-test/goldens/api.ctx.get.sym.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":3825799,"exBudgetMemory":6816,"scriptSizeBytes":188} \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.sym.uplc.eval.golden b/plutarch-test/goldens/api.ctx.get.sym.uplc.eval.golden deleted file mode 100644 index 92ecc58c0..000000000 --- a/plutarch-test/goldens/api.ctx.get.sym.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 #c0) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.sym.uplc.golden b/plutarch-test/goldens/api.ctx.get.sym.uplc.golden deleted file mode 100644 index ad9dfedcc..000000000 --- a/plutarch-test/goldens/api.ctx.get.sym.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> unBData ((\i0 -> force (force fstPair) (i3 i1)) (unMapData ((\i0 -> i3 ((\i0 -> i3 (i3 (i3 i1))) (i4 i1))) ((\i0 -> i3 (i4 i1)) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff))))) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.txInfo.bench.golden b/plutarch-test/goldens/api.ctx.get.txInfo.bench.golden deleted file mode 100644 index bd11f8ac9..000000000 --- a/plutarch-test/goldens/api.ctx.get.txInfo.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":837149,"exBudgetMemory":1496,"scriptSizeBytes":149} \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.txInfo.uplc.eval.golden b/plutarch-test/goldens/api.ctx.get.txInfo.uplc.eval.golden deleted file mode 100644 index 5d2ba94aa..000000000 --- a/plutarch-test/goldens/api.ctx.get.txInfo.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 #d8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffff) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.get.txInfo.uplc.golden b/plutarch-test/goldens/api.ctx.get.txInfo.uplc.golden deleted file mode 100644 index 91bc4fa02..000000000 --- a/plutarch-test/goldens/api.ctx.get.txInfo.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> force headList (force (force sndPair) (unConstrData i1))) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff)) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.uplc.eval.golden b/plutarch-test/goldens/api.ctx.uplc.eval.golden index 6d009b355..982f866ad 100644 --- a/plutarch-test/goldens/api.ctx.uplc.eval.golden +++ b/plutarch-test/goldens/api.ctx.uplc.eval.golden @@ -1 +1,7 @@ -0 (program 1.0.0 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) \ No newline at end of file +term (program 1.0.0 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) +get.txInfo (program 1.0.0 #d8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffff) +get.mint (program 1.0.0 #a141c0a149736f6d65746f6b656e01) +get.credentials (program 1.0.0 [#41a1]) +get.sym (program 1.0.0 #c0) +ScriptPurpose.literal (program 1.0.0 #d8799f58201111111111111111111111111111111111111111111111111111111111111111ff) +ScriptPurpose.decode (program 1.0.0 [ #58201111111111111111111111111111111111111111111111111111111111111111 ]) \ No newline at end of file diff --git a/plutarch-test/goldens/api.ctx.uplc.golden b/plutarch-test/goldens/api.ctx.uplc.golden index 6d009b355..5ab986e7b 100644 --- a/plutarch-test/goldens/api.ctx.uplc.golden +++ b/plutarch-test/goldens/api.ctx.uplc.golden @@ -1 +1,7 @@ -0 (program 1.0.0 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) \ No newline at end of file +term (program 1.0.0 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) +get.txInfo (program 1.0.0 ((\i0 -> force headList (force (force sndPair) (unConstrData i1))) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff)) +get.mint (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i3 ((\i0 -> i3 (i3 (i3 i1))) (i4 i1))) ((\i0 -> i3 (i4 i1)) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +get.credentials (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay [ ]) (delay (force mkCons (i3 (i5 i1)) (i2 (i4 i1))))))) (\i0 -> i3 (i5 (unConstrData ((\i0 -> i4 (i5 i1)) ((\i0 -> i4 (i5 i1)) (i3 (i2 (i4 i1)))))))) ((\i0 -> unListData (i3 (i4 i1))) ((\i0 -> i3 (i4 i1)) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff))) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +get.sym (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> unBData ((\i0 -> i7 (i10 i1)) ((\i0 -> (\i0 -> i3 (\i0 -> i2 (unMapData i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (mapData i1)) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> (\i0 -> force (i10 (force nullList i1) (delay (\i0 -> \i0 -> force i1)) (delay (\i0 -> \i0 -> i2 i3)))) (i3 (\i0 -> force (i10 (equalsData i1 (iData 0)) (delay (\i0 -> \i0 -> force i1)) (delay (\i0 -> \i0 -> i2 i3)))) i1)) i1) (unMapData ((\i0 -> i10 ((\i0 -> i10 (i10 (i10 i1))) (i11 i1))) ((\i0 -> i10 (i11 i1)) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff)))))) (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (i6 i1 (delay i7) (delay ((\i0 -> i5 (i15 (i13 i2)) (\i0 -> i10 (mkPairData (i11 (i14 i3)) i1) i2) (delay i1)) (i2 (i11 i1)))))) i1)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) [ ]) (force mkCons)) (force (force fstPair))) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +ScriptPurpose.literal (program 1.0.0 #d8799f58201111111111111111111111111111111111111111111111111111111111111111ff) +ScriptPurpose.decode (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsInteger 0 i2) (delay i1) (delay error))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData #d8799f58201111111111111111111111111111111111111111111111111111111111111111ff))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.getFields.bench.golden b/plutarch-test/goldens/api.example.getFields.bench.golden index b8e62d0c1..4855f700a 100644 --- a/plutarch-test/goldens/api.example.getFields.bench.golden +++ b/plutarch-test/goldens/api.example.getFields.bench.golden @@ -1 +1 @@ -0 {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":11} \ No newline at end of file +0 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":11} \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.bench.golden b/plutarch-test/goldens/api.example.signatory.bench.golden new file mode 100644 index 000000000..3e66861c5 --- /dev/null +++ b/plutarch-test/goldens/api.example.signatory.bench.golden @@ -0,0 +1,4 @@ +cont.succeeds {"exBudgetCPU":6217368,"exBudgetMemory":16009,"scriptSizeBytes":335} +cont.fails {"exBudgetCPU":10465180,"exBudgetMemory":21069,"scriptSizeBytes":331} +termcont.succeeds {"exBudgetCPU":6217368,"exBudgetMemory":16009,"scriptSizeBytes":335} +termcont.fails {"exBudgetCPU":10465180,"exBudgetMemory":21069,"scriptSizeBytes":331} \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=false.cont.bench.golden b/plutarch-test/goldens/api.example.signatory.dev=false.cont.bench.golden deleted file mode 100644 index 8705ffc87..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=false.cont.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":8163467,"exBudgetMemory":16009,"scriptSizeBytes":290} \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=false.cont.uplc.eval.golden b/plutarch-test/goldens/api.example.signatory.dev=false.cont.uplc.eval.golden deleted file mode 100644 index 582b47c79..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=false.cont.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=false.cont.uplc.golden b/plutarch-test/goldens/api.example.signatory.dev=false.cont.uplc.golden deleted file mode 100644 index d8097f169..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=false.cont.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) ((\i0 -> unListData (i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1)))) (i8 i4))) (delay ()) (delay error)))) (delay error))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=false.termcont.bench.golden b/plutarch-test/goldens/api.example.signatory.dev=false.termcont.bench.golden deleted file mode 100644 index 8705ffc87..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=false.termcont.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":8163467,"exBudgetMemory":16009,"scriptSizeBytes":290} \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=false.termcont.uplc.eval.golden b/plutarch-test/goldens/api.example.signatory.dev=false.termcont.uplc.eval.golden deleted file mode 100644 index 582b47c79..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=false.termcont.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=false.termcont.uplc.golden b/plutarch-test/goldens/api.example.signatory.dev=false.termcont.uplc.golden deleted file mode 100644 index ed510fea3..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=false.termcont.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) (unListData ((\i0 -> i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1))) (i8 i4)))) (delay ()) (delay error)))) (delay error))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=true.cont.bench.golden b/plutarch-test/goldens/api.example.signatory.dev=true.cont.bench.golden deleted file mode 100644 index 33f6ffc2d..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=true.cont.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":8163467,"exBudgetMemory":16009,"scriptSizeBytes":335} \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=true.cont.uplc.eval.golden b/plutarch-test/goldens/api.example.signatory.dev=true.cont.uplc.eval.golden deleted file mode 100644 index 582b47c79..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=true.cont.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=true.cont.uplc.golden b/plutarch-test/goldens/api.example.signatory.dev=true.cont.uplc.golden deleted file mode 100644 index 4946be45e..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=true.cont.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) ((\i0 -> unListData (i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1)))) (i8 i4))) (delay ()) (delay error)))) (delay (force (force trace "checkSignatoryCont: not a spending tx" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=true.termcont.bench.golden b/plutarch-test/goldens/api.example.signatory.dev=true.termcont.bench.golden deleted file mode 100644 index 33f6ffc2d..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=true.termcont.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":8163467,"exBudgetMemory":16009,"scriptSizeBytes":335} \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=true.termcont.uplc.eval.golden b/plutarch-test/goldens/api.example.signatory.dev=true.termcont.uplc.eval.golden deleted file mode 100644 index 582b47c79..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=true.termcont.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.dev=true.termcont.uplc.golden b/plutarch-test/goldens/api.example.signatory.dev=true.termcont.uplc.golden deleted file mode 100644 index 7c786aef0..000000000 --- a/plutarch-test/goldens/api.example.signatory.dev=true.termcont.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) (unListData ((\i0 -> i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1))) (i8 i4)))) (delay ()) (delay error)))) (delay (force (force trace "checkSignatoryCont: not a spending tx" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.uplc.eval.golden b/plutarch-test/goldens/api.example.signatory.uplc.eval.golden new file mode 100644 index 000000000..0070757cf --- /dev/null +++ b/plutarch-test/goldens/api.example.signatory.uplc.eval.golden @@ -0,0 +1,4 @@ +cont.succeeds (program 1.0.0 ()) +cont.fails (program 1.0.0 error) +termcont.succeeds (program 1.0.0 ()) +termcont.fails (program 1.0.0 error) \ No newline at end of file diff --git a/plutarch-test/goldens/api.example.signatory.uplc.golden b/plutarch-test/goldens/api.example.signatory.uplc.golden new file mode 100644 index 000000000..0be2377ab --- /dev/null +++ b/plutarch-test/goldens/api.example.signatory.uplc.golden @@ -0,0 +1,4 @@ +cont.succeeds (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) ((\i0 -> unListData (i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1)))) (i8 i4))) (delay ()) (delay error)))) (delay (force (force trace "checkSignatoryCont: not a spending tx" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +cont.fails (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) ((\i0 -> unListData (i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1)))) (i8 i4))) (delay ()) (delay error)))) (delay (force (force trace "checkSignatoryCont: not a spending tx" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #41 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +termcont.succeeds (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) (unListData ((\i0 -> i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1))) (i8 i4)))) (delay ()) (delay error)))) (delay (force (force trace "checkSignatoryCont: not a spending tx" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +termcont.fails (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) (unListData ((\i0 -> i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1))) (i8 i4)))) (delay ()) (delay error)))) (delay (force (force trace "checkSignatoryCont: not a spending tx" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #41 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/api.map.bench.golden b/plutarch-test/goldens/api.map.bench.golden new file mode 100644 index 000000000..621b85d53 --- /dev/null +++ b/plutarch-test/goldens/api.map.bench.golden @@ -0,0 +1,28 @@ +lookup.itself {"exBudgetCPU":115100,"exBudgetMemory":600,"scriptSizeBytes":85} +lookup.hit {"exBudgetCPU":4028533,"exBudgetMemory":10054,"scriptSizeBytes":119} +lookup.miss {"exBudgetCPU":4394532,"exBudgetMemory":11422,"scriptSizeBytes":128} +lookupData.hit {"exBudgetCPU":3939176,"exBudgetMemory":9822,"scriptSizeBytes":117} +lookupData.miss {"exBudgetCPU":4325532,"exBudgetMemory":11122,"scriptSizeBytes":124} +findWithDefault.itself {"exBudgetCPU":115100,"exBudgetMemory":600,"scriptSizeBytes":78} +findWithDefault.hit {"exBudgetCPU":4097533,"exBudgetMemory":10354,"scriptSizeBytes":117} +findWithDefault.hit2 {"exBudgetCPU":14871543,"exBudgetMemory":39532,"scriptSizeBytes":329} +findWithDefault.miss {"exBudgetCPU":4532532,"exBudgetMemory":12022,"scriptSizeBytes":125} +singleton {"exBudgetCPU":742104,"exBudgetMemory":2828,"scriptSizeBytes":39} +singletonData {"exBudgetCPU":604104,"exBudgetMemory":2228,"scriptSizeBytes":34} +insert.empty {"exBudgetCPU":2113458,"exBudgetMemory":8060,"scriptSizeBytes":157} +insert.replace {"exBudgetCPU":4362797,"exBudgetMemory":14120,"scriptSizeBytes":179} +delete.empty {"exBudgetCPU":1555454,"exBudgetMemory":6132,"scriptSizeBytes":140} +delete.only {"exBudgetCPU":3873793,"exBudgetMemory":12492,"scriptSizeBytes":163} +delete.miss {"exBudgetCPU":4366498,"exBudgetMemory":14786,"scriptSizeBytes":169} +delete.new {"exBudgetCPU":9803231,"exBudgetMemory":30904,"scriptSizeBytes":205} +delete.old {"exBudgetCPU":7780191,"exBudgetMemory":25178,"scriptSizeBytes":204} +difference.emptyLeft {"exBudgetCPU":2067458,"exBudgetMemory":7860,"scriptSizeBytes":162} +difference.emptyRight {"exBudgetCPU":4494995,"exBudgetMemory":15848,"scriptSizeBytes":165} +difference.emptyResult {"exBudgetCPU":7452717,"exBudgetMemory":22006,"scriptSizeBytes":179} +unionWith.const {"exBudgetCPU":9281337,"exBudgetMemory":29270,"scriptSizeBytes":263} +unionWith.double {"exBudgetCPU":9372814,"exBudgetMemory":28772,"scriptSizeBytes":259} +unionWith.(+) {"exBudgetCPU":9144040,"exBudgetMemory":28276,"scriptSizeBytes":265} +unionWith.flip (+) {"exBudgetCPU":9144040,"exBudgetMemory":28276,"scriptSizeBytes":265} +unionWithData.const {"exBudgetCPU":8848623,"exBudgetMemory":27674,"scriptSizeBytes":249} +unionWithData.emptyLeft {"exBudgetCPU":2757458,"exBudgetMemory":10860,"scriptSizeBytes":236} +unionWithData.emptyRight {"exBudgetCPU":4209736,"exBudgetMemory":15888,"scriptSizeBytes":236} \ No newline at end of file diff --git a/plutarch-test/goldens/api.map.uplc.eval.golden b/plutarch-test/goldens/api.map.uplc.eval.golden new file mode 100644 index 000000000..43bb1f298 --- /dev/null +++ b/plutarch-test/goldens/api.map.uplc.eval.golden @@ -0,0 +1,28 @@ +lookup.itself (program 1.0.0 (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) i4) (delay (i5 (force headList i1))) (delay (i2 (force tailList i1)))))))) i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (unIData (force (force sndPair) i1))) (bData i1))) +lookup.hit (program 1.0.0 (\i0 -> \i0 -> i2 42)) +lookup.miss (program 1.0.0 (\i0 -> \i0 -> force i1)) +lookupData.hit (program 1.0.0 (\i0 -> \i0 -> i2 #182a)) +lookupData.miss (program 1.0.0 (\i0 -> \i0 -> force i1)) +findWithDefault.itself (program 1.0.0 (\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i5) (delay (force (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) i6) (delay (i4 (force (force sndPair) (force headList i1)))) (delay (i2 (force tailList i1)))))))) i1) (bData i1) i2 unIData)) +findWithDefault.hit (program 1.0.0 42) +findWithDefault.hit2 (program 1.0.0 6) +findWithDefault.miss (program 1.0.0 12) +singleton (program 1.0.0 [(#436b6579, #182a)]) +singletonData (program 1.0.0 [(#436b6579, #182a)]) +insert.empty (program 1.0.0 [(#436b6579, #182a)]) +insert.replace (program 1.0.0 [(#436b6579, #1854)]) +delete.empty (program 1.0.0 []) +delete.only (program 1.0.0 []) +delete.miss (program 1.0.0 [(#436b6579, #182a)]) +delete.new (program 1.0.0 [(#436b6579, #182a)]) +delete.old (program 1.0.0 [(#466e65776b6579, #06)]) +difference.emptyLeft (program 1.0.0 []) +difference.emptyRight (program 1.0.0 [(#436b6579, #182a)]) +difference.emptyResult (program 1.0.0 []) +unionWith.const (program 1.0.0 [(#436b6579, #182a)]) +unionWith.double (program 1.0.0 [(#436b6579, #1854)]) +unionWith.(+) (program 1.0.0 [(#436b6579, #182a), (#466e65776b6579, #06)]) +unionWith.flip (+) (program 1.0.0 [(#436b6579, #182a), (#466e65776b6579, #06)]) +unionWithData.const (program 1.0.0 [(#436b6579, #182a)]) +unionWithData.emptyLeft (program 1.0.0 [(#436b6579, #182a)]) +unionWithData.emptyRight (program 1.0.0 [(#436b6579, #182a)]) \ No newline at end of file diff --git a/plutarch-test/goldens/api.map.uplc.golden b/plutarch-test/goldens/api.map.uplc.golden new file mode 100644 index 000000000..67e5340a9 --- /dev/null +++ b/plutarch-test/goldens/api.map.uplc.golden @@ -0,0 +1,28 @@ +lookup.itself (program 1.0.0 ((\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (force ifThenElse (equalsData (force (force fstPair) (i7 i1)) i4) (delay (i5 (i7 i1))) (delay (i2 (force tailList i1)))))))) i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (unIData (force (force sndPair) i1))) (bData i1)) (force headList))) +lookup.hit (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (force ifThenElse (equalsData (force (force fstPair) (i6 i1)) i4) (delay (i5 (i6 i1))) (delay (i2 (force tailList i1)))))))) i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (unIData (force (force sndPair) i1))) (bData i2) ((\i0 -> (\i0 -> \i0 -> force mkCons (mkPairData i2 i1) [ ]) (bData i3) (iData i1)) 42)) (force headList)) #6b6579)) +lookup.miss (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (force ifThenElse (equalsData (force (force fstPair) (i7 i1)) i4) (delay (i5 (i7 i1))) (delay (i2 (force tailList i1)))))))) i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (unIData (force (force sndPair) i1))) (bData i1)) #6e6f6b6579 ((\i0 -> \i0 -> (\i0 -> \i0 -> force mkCons (mkPairData i2 i1) [ ]) (bData i2) (iData i1)) #6b6579 42)) (force headList))) +lookupData.hit (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (force ifThenElse (equalsData (force (force fstPair) (i6 i1)) i4) (delay (i5 (i6 i1))) (delay (i2 (force tailList i1)))))))) i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (force (force sndPair) i1)) (bData i2) ((\i0 -> (\i0 -> \i0 -> force mkCons (mkPairData i2 i1) [ ]) (bData i3) (iData i1)) 42)) (force headList)) #6b6579)) +lookupData.miss (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (force ifThenElse (equalsData (force (force fstPair) (i6 i1)) i4) (delay (i5 (i6 i1))) (delay (i2 (force tailList i1)))))))) i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (force (force sndPair) i1)) (bData #6e6f6b6579) ((\i0 -> \i0 -> (\i0 -> \i0 -> force mkCons (mkPairData i2 i1) [ ]) (bData i2) (iData i1)) #6b6579 42)) (force headList))) +findWithDefault.itself (program 1.0.0 ((\i0 -> \i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i5) (delay (force (force ifThenElse (equalsData (force (force fstPair) (i9 i1)) i6) (delay (i4 (force (force sndPair) (i9 i1)))) (delay (i2 (force tailList i1)))))))) i1) (bData i1) i2 unIData) (force headList))) +findWithDefault.hit (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i5) (delay (force (force ifThenElse (equalsData (force (force fstPair) (i9 i1)) i6) (delay (i4 (force (force sndPair) (i9 i1)))) (delay (i2 (force tailList i1)))))))) i1) (bData i1) i2 unIData) 12 i2 ((\i0 -> (\i0 -> \i0 -> force mkCons (mkPairData i2 i1) [ ]) (bData i3) (iData i1)) 42)) (force headList)) #6b6579)) +findWithDefault.hit2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> i7 (\i0 -> \i0 -> force (i13 i1 (delay i5) (delay (force (i11 (equalsData (i12 (i14 i1)) i6) (delay (i4 (i10 (i14 i1)))) (delay (i2 (i15 i1)))))))) i1) (bData i1) i2 unIData) 12 i12 ((\i0 -> (\i0 -> \i0 -> \i0 -> i5 (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i14 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i15 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i11 (i14 i6) (i14 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i19 i4)))) (delay (force (i15 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i19 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i19 i4))))))))) (i15 i2)) (i14 i4)) (i15 i1)))))) (\i0 -> \i0 -> force (i12 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i13 i2) (i14 i2) i1))))) (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1)))) (\i0 -> \i0 -> i2) (i8 #6b6579 42) (i8 i12 6))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #6e65776b6579)) +findWithDefault.miss (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i5) (delay (force (force ifThenElse (equalsData (force (force fstPair) (i9 i1)) i6) (delay (i4 (force (force sndPair) (i9 i1)))) (delay (i2 (force tailList i1)))))))) i1) (bData i1) i2 unIData) 12 #6e6f6b6579 ((\i0 -> \i0 -> (\i0 -> \i0 -> force mkCons (mkPairData i2 i1) [ ]) (bData i2) (iData i1)) #6b6579 42)) (force headList))) +singleton (program 1.0.0 ((\i0 -> \i0 -> (\i0 -> \i0 -> force mkCons (mkPairData i2 i1) [ ]) (bData i2) (iData i1)) #6b6579 42)) +singletonData (program 1.0.0 ((\i0 -> \i0 -> force mkCons (mkPairData i2 i1) [ ]) (bData #6b6579) (iData 42))) +insert.empty (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> i1 (i6 i13))) (delay ((\i0 -> \i0 -> force (i10 (lessThanByteString i2 i6) (delay (i4 (i11 i3) (\i0 -> i2 (i14 (i13 i4) i1)))) (delay (force (i10 (equalsByteString i2 i6) (delay (i1 (i7 (i11 i3)))) (delay (i1 (i7 (i13 (i12 i3) (i11 i3)))))))))) (unBData (force (force fstPair) (i10 i1))))))) i1 (\i0 -> i1)) (\i0 -> i7 (mkPairData (bData i3) (iData i2)) i1) i2) #6b6579 42 i5) (force ifThenElse)) (force tailList)) (force headList)) (force mkCons)) [ ])) +insert.replace (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> i1 (i6 i12))) (delay ((\i0 -> \i0 -> force (i9 (lessThanByteString i2 i6) (delay (i4 (i10 i3) (\i0 -> i2 (i13 (i12 i4) i1)))) (delay (force (i9 (equalsByteString i2 i6) (delay (i1 (i7 (i10 i3)))) (delay (i1 (i7 (i12 (i11 i3) (i10 i3)))))))))) (unBData (force (force fstPair) (i9 i1))))))) i1 (\i0 -> i1)) (\i0 -> i6 (mkPairData (bData i8) (iData i2)) i1) i7) 84 ((\i0 -> (\i0 -> \i0 -> i7 (mkPairData i2 i1) i8) (bData i7) (iData i1)) 42)) (force ifThenElse)) (force tailList)) (force headList)) (force mkCons)) [ ]) #6b6579)) +delete.empty (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> i1 (i6 i11))) (delay ((\i0 -> \i0 -> force (i8 (lessThanByteString i2 i6) (delay (i4 (i10 i3) (\i0 -> i2 (i10 (i12 i4) i1)))) (delay (force (i8 (equalsByteString i2 i6) (delay (i1 (i7 (i10 i3)))) (delay (i1 (i7 (i9 (i11 i3) (i10 i3)))))))))) (unBData (force (force fstPair) (i9 i1))))))) i1 (\i0 -> i1)) (\i0 -> i1) #6b6579 i5) (force ifThenElse)) (force mkCons)) (force tailList)) (force headList)) [ ])) +delete.only (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> i1 (i6 i11))) (delay ((\i0 -> \i0 -> force (i8 (lessThanByteString i2 i6) (delay (i4 (i9 i3) (\i0 -> i2 (i12 (i11 i4) i1)))) (delay (force (i8 (equalsByteString i2 i6) (delay (i1 (i7 (i9 i3)))) (delay (i1 (i7 (i11 (i10 i3) (i9 i3)))))))))) (unBData (force (force fstPair) (i8 i1))))))) i1 (\i0 -> i1)) (\i0 -> i1) i6 ((\i0 -> (\i0 -> \i0 -> i7 (mkPairData i2 i1) i8) (bData i7) (iData i1)) 42)) (force ifThenElse)) (force tailList)) (force headList)) (force mkCons)) [ ]) #6b6579)) +delete.miss (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> i1 (i6 i11))) (delay ((\i0 -> \i0 -> force (i8 (lessThanByteString i2 i6) (delay (i4 (i9 i3) (\i0 -> i2 (i12 (i11 i4) i1)))) (delay (force (i8 (equalsByteString i2 i6) (delay (i1 (i7 (i9 i3)))) (delay (i1 (i7 (i11 (i10 i3) (i9 i3)))))))))) (unBData (force (force fstPair) (i8 i1))))))) i1 (\i0 -> i1)) (\i0 -> i1) #6e6f6b6579 ((\i0 -> \i0 -> (\i0 -> \i0 -> i8 (mkPairData i2 i1) i9) (bData i2) (iData i1)) #6b6579 42)) (force ifThenElse)) (force tailList)) (force headList)) (force mkCons)) [ ])) +delete.new (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> i1) i8 ((\i0 -> i2 (\i0 -> i11 (mkPairData (bData i10) (iData i2)) i1) i9) 6 ((\i0 -> \i0 -> (\i0 -> \i0 -> i13 (mkPairData i2 i1) i14) (bData i2) (iData i1)) #6b6579 42))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> force (i7 i1 (delay (\i0 -> i1 (i6 i15))) (delay ((\i0 -> \i0 -> force (i10 (lessThanByteString i2 i6) (delay (i4 (i11 i3) (\i0 -> i2 (i16 (i14 i4) i1)))) (delay (force (i10 (equalsByteString i2 i6) (delay (i1 (i7 (i11 i3)))) (delay (i1 (i7 (i15 (i13 i3) (i11 i3)))))))))) (unBData (i10 (i11 i1))))))) i1 (\i0 -> i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force ifThenElse)) (force tailList)) (force (force fstPair))) (force headList)) #6e65776b6579) (force mkCons)) [ ])) +delete.old (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> i1) i10 ((\i0 -> \i0 -> i3 (\i0 -> i11 (mkPairData (bData i3) (iData i2)) i1) i2) #6e65776b6579 6 ((\i0 -> (\i0 -> \i0 -> i11 (mkPairData i2 i1) i12) (bData i11) (iData i1)) 42))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> force (i7 i1 (delay (\i0 -> i1 (i6 i14))) (delay ((\i0 -> \i0 -> force (i10 (lessThanByteString i2 i6) (delay (i4 (i11 i3) (\i0 -> i2 (i15 (i14 i4) i1)))) (delay (force (i10 (equalsByteString i2 i6) (delay (i1 (i7 (i11 i3)))) (delay (i1 (i7 (i14 (i13 i3) (i11 i3)))))))))) (unBData (i10 (i11 i1))))))) i1 (\i0 -> i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force ifThenElse)) (force tailList)) (force (force fstPair))) (force headList)) (force mkCons)) [ ]) #6b6579)) +difference.emptyLeft (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> \i0 -> force (i5 i1 (delay i10) (delay ((\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i13 i1 (delay i5) (delay (force (force ifThenElse (equalsData (i14 (i15 i1)) i6) (delay (i4 (force (force sndPair) (i15 i1)))) (delay (i2 (i16 i1)))))))) i1) (bData i1)) (unBData (i7 (i8 i2))) (i10 (i8 i2) i1) (\i0 -> i2) i4) (i2 (i8 i1)))))) i8) ((\i0 -> \i0 -> (\i0 -> \i0 -> i10 (mkPairData i2 i1) i11) (bData i2) (iData i1)) #6b6579 42)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force (force fstPair))) (force headList)) (force tailList)) (force mkCons)) [ ])) +difference.emptyRight (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (i6 i1 (delay i11) (delay ((\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> i11 (\i0 -> \i0 -> force (i14 i1 (delay i5) (delay (force (force ifThenElse (equalsData (i15 (i16 i1)) i6) (delay (i4 (force (force sndPair) (i16 i1)))) (delay (i2 (i17 i1)))))))) i1) (bData i1)) (unBData (i8 (i9 i2))) (i11 (i9 i2) i1) (\i0 -> i2) i4) (i2 (i9 i1)))))) i2) ((\i0 -> \i0 -> (\i0 -> \i0 -> i10 (mkPairData i2 i1) i11) (bData i2) (iData i1)) #6b6579 42) i7) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force (force fstPair))) (force headList)) (force tailList)) (force mkCons)) [ ])) +difference.emptyResult (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (i6 i1 (delay i13) (delay ((\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> i11 (\i0 -> \i0 -> force (i14 i1 (delay i5) (delay (force (force ifThenElse (equalsData (i15 (i16 i1)) i6) (delay (i4 (force (force sndPair) (i16 i1)))) (delay (i2 (i17 i1)))))))) i1) (bData i1)) (unBData (i8 (i9 i2))) (i13 (i9 i2) i1) (\i0 -> i2) i4) (i2 (i9 i1)))))) i2) (i6 i10 42) (i6 i10 84)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force (force fstPair))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #6b6579)) +unionWith.const (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i13 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i14 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i11 (i13 i6) (i13 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i18 i4)))) (delay (force (i14 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i18 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i18 i4))))))))) (i14 i2)) (i13 i4)) (i14 i1)))))) (\i0 -> \i0 -> force (i11 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i12 i2) (i13 i2) i1))))) (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1)))) (\i0 -> \i0 -> i2) (i7 i11 42) (i7 i11 42)) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #6b6579)) +unionWith.double (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i12 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i13 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i11 (i12 i6) (i12 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i17 i4)))) (delay (force (i13 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i17 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i17 i4))))))))) (i13 i2)) (i12 i4)) (i13 i1)))))) (\i0 -> \i0 -> force (i10 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i11 i2) (i12 i2) i1))))) (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) (i7 i11 42) (i7 i11 42)) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #6b6579)) +unionWith.(+) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i12 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i13 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i11 (i12 i6) (i12 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i17 i4)))) (delay (force (i13 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i17 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i17 i4))))))))) (i13 i2)) (i12 i4)) (i13 i1)))))) (\i0 -> \i0 -> force (i10 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i11 i2) (i12 i2) i1))))) (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) (i7 #6b6579 42) (i7 #6e65776b6579 6)) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +unionWith.flip (+) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i12 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i13 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i11 (i12 i6) (i12 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i17 i4)))) (delay (force (i13 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i17 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i17 i4))))))))) (i13 i2)) (i12 i4)) (i13 i1)))))) (\i0 -> \i0 -> force (i10 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i11 i2) (i12 i2) i1))))) (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) (i7 #6e65776b6579 6) (i7 #6b6579 42)) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +unionWithData.const (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i12 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i13 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i11 (i12 i6) (i12 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i17 i4)))) (delay (force (i13 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i17 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i17 i4))))))))) (i13 i2)) (i12 i4)) (i13 i1)))))) (\i0 -> \i0 -> force (i10 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i11 i2) (i12 i2) i1))))) (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> i2) (i7 i11 42) (i7 i11 42)) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #6b6579)) +unionWithData.emptyLeft (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i12 i1 (delay (i15 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i13 (equalsData i2 i1) (delay (i18 (mkPairData i2 (i11 (i12 i6) (i12 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i17 i4)))) (delay (force (i13 (lessThanByteString (unBData i2) (unBData i1)) (delay (i18 i6 (i8 (\i0 -> \i0 -> i1) i3 (i17 i4) i5))) (delay (i18 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i17 i4))))))))) (i13 i2)) (i12 i4)) (i13 i1)))))) (\i0 -> \i0 -> force (i10 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i11 i2) (i12 i2) i1))))) (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> i2) i8 ((\i0 -> \i0 -> (\i0 -> \i0 -> i11 (mkPairData i2 i1) i12) (bData i2) (iData i1)) #6b6579 42)) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (force mkCons)) [ ])) +unionWithData.emptyRight (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i12 i1 (delay (i15 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i13 (equalsData i2 i1) (delay (i18 (mkPairData i2 (i11 (i12 i6) (i12 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i17 i4)))) (delay (force (i13 (lessThanByteString (unBData i2) (unBData i1)) (delay (i18 i6 (i8 (\i0 -> \i0 -> i1) i3 (i17 i4) i5))) (delay (i18 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i17 i4))))))))) (i13 i2)) (i12 i4)) (i13 i1)))))) (\i0 -> \i0 -> force (i10 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i11 i2) (i12 i2) i1))))) (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> i2) ((\i0 -> \i0 -> (\i0 -> \i0 -> i11 (mkPairData i2 i1) i12) (bData i2) (iData i1)) #6b6579 42) i8) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (force mkCons)) [ ])) \ No newline at end of file diff --git a/plutarch-test/goldens/api.value.bench.golden b/plutarch-test/goldens/api.value.bench.golden new file mode 100644 index 000000000..1a6bb1a1b --- /dev/null +++ b/plutarch-test/goldens/api.value.bench.golden @@ -0,0 +1,89 @@ +singleton {"exBudgetCPU":1708940,"exBudgetMemory":6256,"scriptSizeBytes":68} +singletonData {"exBudgetCPU":3189793,"exBudgetMemory":7490,"scriptSizeBytes":80} +valueOf.itself {"exBudgetCPU":851100,"exBudgetMemory":3800,"scriptSizeBytes":115} +valueOf.applied {"exBudgetCPU":8887341,"exBudgetMemory":23308,"scriptSizeBytes":183} +valueOf.growing.1 {"exBudgetCPU":6189368,"exBudgetMemory":18450,"scriptSizeBytes":193} +valueOf.growing.2 {"exBudgetCPU":22282115,"exBudgetMemory":66140,"scriptSizeBytes":417} +valueOf.growing.3 {"exBudgetCPU":33723961,"exBudgetMemory":97446,"scriptSizeBytes":448} +valueOf.growing.4 {"exBudgetCPU":48921107,"exBudgetMemory":136512,"scriptSizeBytes":467} +valueOf.growing.5 {"exBudgetCPU":68218553,"exBudgetMemory":184838,"scriptSizeBytes":485} +valueOf.growing.6 {"exBudgetCPU":91616299,"exBudgetMemory":242424,"scriptSizeBytes":503} +valueOf.growing.7 {"exBudgetCPU":119114345,"exBudgetMemory":309270,"scriptSizeBytes":522} +valueOf.growing.8 {"exBudgetCPU":150712691,"exBudgetMemory":385376,"scriptSizeBytes":540} +valueOf.growing.9 {"exBudgetCPU":189165724,"exBudgetMemory":475900,"scriptSizeBytes":558} +valueOf.growing.10 {"exBudgetCPU":226546596,"exBudgetMemory":566596,"scriptSizeBytes":576} +valueOf.growing.11 {"exBudgetCPU":268027768,"exBudgetMemory":666552,"scriptSizeBytes":594} +valueOf.growing.12 {"exBudgetCPU":313609240,"exBudgetMemory":775768,"scriptSizeBytes":613} +valueOf.growing.13 {"exBudgetCPU":363291012,"exBudgetMemory":894244,"scriptSizeBytes":631} +valueOf.growing.14 {"exBudgetCPU":417073084,"exBudgetMemory":1021980,"scriptSizeBytes":649} +valueOf.growing.15 {"exBudgetCPU":474955456,"exBudgetMemory":1158976,"scriptSizeBytes":668} +valueOf.growing.16 {"exBudgetCPU":536938128,"exBudgetMemory":1305232,"scriptSizeBytes":686} +valueOf.growing.17 {"exBudgetCPU":603021100,"exBudgetMemory":1460748,"scriptSizeBytes":705} +unionWith.const {"exBudgetCPU":18572570,"exBudgetMemory":57640,"scriptSizeBytes":333} +unionWith.(+).itself {"exBudgetCPU":1012100,"exBudgetMemory":4500,"scriptSizeBytes":248} +unionWith.(+).applied {"exBudgetCPU":18664047,"exBudgetMemory":57142,"scriptSizeBytes":330} +unionWith.tokens {"exBudgetCPU":18435429,"exBudgetMemory":56646,"scriptSizeBytes":339} +unionWith.symbols {"exBudgetCPU":11422712,"exBudgetMemory":36632,"scriptSizeBytes":331} +unionWith.growing.1 {"exBudgetCPU":11491712,"exBudgetMemory":36932,"scriptSizeBytes":335} +unionWith.growing.2 {"exBudgetCPU":27515459,"exBudgetMemory":84322,"scriptSizeBytes":369} +unionWith.growing.3 {"exBudgetCPU":40363531,"exBudgetMemory":119758,"scriptSizeBytes":390} +unionWith.growing.4 {"exBudgetCPU":57242903,"exBudgetMemory":164154,"scriptSizeBytes":408} +unionWith.growing.5 {"exBudgetCPU":78222575,"exBudgetMemory":217810,"scriptSizeBytes":427} +unionWith.growing.6 {"exBudgetCPU":103302547,"exBudgetMemory":280726,"scriptSizeBytes":445} +unionWith.growing.7 {"exBudgetCPU":132482819,"exBudgetMemory":352902,"scriptSizeBytes":464} +unionWith.growing.8 {"exBudgetCPU":165763391,"exBudgetMemory":434338,"scriptSizeBytes":482} +unionWith.growing.9 {"exBudgetCPU":210282238,"exBudgetMemory":545648,"scriptSizeBytes":498} +unionWith.growing.10 {"exBudgetCPU":247663110,"exBudgetMemory":636344,"scriptSizeBytes":517} +unionWith.growing.11 {"exBudgetCPU":289144282,"exBudgetMemory":736300,"scriptSizeBytes":535} +unionWith.growing.12 {"exBudgetCPU":334725754,"exBudgetMemory":845516,"scriptSizeBytes":553} +unionWith.growing.13 {"exBudgetCPU":384407526,"exBudgetMemory":963992,"scriptSizeBytes":572} +unionWith.growing.14 {"exBudgetCPU":438189598,"exBudgetMemory":1091728,"scriptSizeBytes":590} +unionWith.growing.15 {"exBudgetCPU":496071970,"exBudgetMemory":1228724,"scriptSizeBytes":609} +unionWith.growing.16 {"exBudgetCPU":558054642,"exBudgetMemory":1374980,"scriptSizeBytes":627} +unionWith.growing.17 {"exBudgetCPU":624137614,"exBudgetMemory":1530496,"scriptSizeBytes":645} +unionWithData const.itself {"exBudgetCPU":1012100,"exBudgetMemory":4500,"scriptSizeBytes":238} +unionWithData const.applied {"exBudgetCPU":18208856,"exBudgetMemory":56344,"scriptSizeBytes":323} +inv {"exBudgetCPU":8006438,"exBudgetMemory":25962,"scriptSizeBytes":175} +equality.itself {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":15} +equality.triviallyTrue {"exBudgetCPU":5254875,"exBudgetMemory":13977,"scriptSizeBytes":100} +equality.triviallyFalse {"exBudgetCPU":5185875,"exBudgetMemory":13677,"scriptSizeBytes":109} +equality.swappedTokensTrue {"exBudgetCPU":38087299,"exBudgetMemory":111457,"scriptSizeBytes":393} +equality.swappedSymbolsTrue {"exBudgetCPU":24037139,"exBudgetMemory":70829,"scriptSizeBytes":384} +equality.growing.1 {"exBudgetCPU":5254875,"exBudgetMemory":13977,"scriptSizeBytes":100} +equality.growing.2 {"exBudgetCPU":38049229,"exBudgetMemory":111457,"scriptSizeBytes":388} +equality.growing.3 {"exBudgetCPU":55714907,"exBudgetMemory":163509,"scriptSizeBytes":423} +equality.growing.4 {"exBudgetCPU":81581185,"exBudgetMemory":234081,"scriptSizeBytes":459} +equality.growing.5 {"exBudgetCPU":115648063,"exBudgetMemory":323173,"scriptSizeBytes":494} +equality.growing.6 {"exBudgetCPU":157915541,"exBudgetMemory":430785,"scriptSizeBytes":529} +equality.growing.7 {"exBudgetCPU":208383619,"exBudgetMemory":556917,"scriptSizeBytes":564} +equality.growing.8 {"exBudgetCPU":267052297,"exBudgetMemory":701569,"scriptSizeBytes":600} +equality.growing.9 {"exBudgetCPU":333921575,"exBudgetMemory":864741,"scriptSizeBytes":635} +equality.growing.10 {"exBudgetCPU":408991453,"exBudgetMemory":1046433,"scriptSizeBytes":670} +equality.growing.11 {"exBudgetCPU":492261931,"exBudgetMemory":1246645,"scriptSizeBytes":705} +equality.growing.12 {"exBudgetCPU":583733009,"exBudgetMemory":1465377,"scriptSizeBytes":741} +equality.growing.13 {"exBudgetCPU":683404687,"exBudgetMemory":1702629,"scriptSizeBytes":776} +equality.growing.14 {"exBudgetCPU":791276965,"exBudgetMemory":1958401,"scriptSizeBytes":811} +equality.growing.15 {"exBudgetCPU":907349843,"exBudgetMemory":2232693,"scriptSizeBytes":846} +equality.growing.16 {"exBudgetCPU":1031623321,"exBudgetMemory":2525505,"scriptSizeBytes":882} +equality.growing.17 {"exBudgetCPU":1164097399,"exBudgetMemory":2836837,"scriptSizeBytes":917} +normalize.identity {"exBudgetCPU":36285548,"exBudgetMemory":108757,"scriptSizeBytes":560} +normalize.empty {"exBudgetCPU":25276001,"exBudgetMemory":75761,"scriptSizeBytes":443} +assertSorted.succeeds {"exBudgetCPU":30813271,"exBudgetMemory":97682,"scriptSizeBytes":516} +assertSorted.fails on malsorted symbols {"exBudgetCPU":20705777,"exBudgetMemory":62290,"scriptSizeBytes":340} +assertSorted.fails on zero quantities {"exBudgetCPU":21820727,"exBudgetMemory":62160,"scriptSizeBytes":515} +assertSorted.fails on empty token map {"exBudgetCPU":1240239,"exBudgetMemory":455,"scriptSizeBytes":262} +Ada.adaSymbol {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":8} +Ada.adaToken {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":8} +Ada.lovelaceValueOf {"exBudgetCPU":230100,"exBudgetMemory":1100,"scriptSizeBytes":53} +Ada.isAdaOnlyValue.itself {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":45} +Ada.isAdaOnlyValue.true on empty {"exBudgetCPU":497454,"exBudgetMemory":1532,"scriptSizeBytes":50} +Ada.isAdaOnlyValue.trivially false {"exBudgetCPU":4349105,"exBudgetMemory":10950,"scriptSizeBytes":107} +Ada.isAdaOnlyValue.less trivially false {"exBudgetCPU":13901877,"exBudgetMemory":40626,"scriptSizeBytes":366} +Ada.adaOnlyValue.itself {"exBudgetCPU":184100,"exBudgetMemory":900,"scriptSizeBytes":52} +Ada.adaOnlyValue.on empty {"exBudgetCPU":589454,"exBudgetMemory":1932,"scriptSizeBytes":51} +Ada.adaOnlyValue.on non-Ada {"exBudgetCPU":4356574,"exBudgetMemory":10950,"scriptSizeBytes":109} +Ada.adaOnlyValue.on Ada {"exBudgetCPU":4287574,"exBudgetMemory":10650,"scriptSizeBytes":95} +Ada.noAdaValue.itself {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":37} +Ada.noAdaValue.on empty {"exBudgetCPU":497454,"exBudgetMemory":1532,"scriptSizeBytes":43} +Ada.noAdaValue.on non-Ada {"exBudgetCPU":4082014,"exBudgetMemory":10018,"scriptSizeBytes":100} +Ada.noAdaValue.on Ada {"exBudgetCPU":4013014,"exBudgetMemory":9718,"scriptSizeBytes":87} \ No newline at end of file diff --git a/plutarch-test/goldens/api.value.uplc.eval.golden b/plutarch-test/goldens/api.value.uplc.eval.golden new file mode 100644 index 000000000..909f1b246 --- /dev/null +++ b/plutarch-test/goldens/api.value.uplc.eval.golden @@ -0,0 +1,220 @@ +singleton (program 1.0.0 [(#41c0, #a149736f6d65746f6b656e01)]) +singletonData (program 1.0.0 [(#41c0, #a149736f6d65746f6b656e01)]) +valueOf.itself (program 1.0.0 (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i5) (delay (force (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) i6) (delay (i4 (force (force sndPair) (force headList i1)))) (delay (i2 (force tailList i1)))))))) i1) (bData i1)) i2 0 (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i5) (delay (force (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) i6) (delay (i4 (force (force sndPair) (force headList i1)))) (delay (i2 (force tailList i1)))))))) i1) (bData i1)) i2 0 unIData (unMapData i1)) i3)) +valueOf.applied (program 1.0.0 1) +valueOf.growing.1 (program 1.0.0 0) +valueOf.growing.2 (program 1.0.0 0) +valueOf.growing.3 (program 1.0.0 0) +valueOf.growing.4 (program 1.0.0 0) +valueOf.growing.5 (program 1.0.0 0) +valueOf.growing.6 (program 1.0.0 0) +valueOf.growing.7 (program 1.0.0 0) +valueOf.growing.8 (program 1.0.0 0) +valueOf.growing.9 (program 1.0.0 1) +valueOf.growing.10 (program 1.0.0 1) +valueOf.growing.11 (program 1.0.0 1) +valueOf.growing.12 (program 1.0.0 1) +valueOf.growing.13 (program 1.0.0 1) +valueOf.growing.14 (program 1.0.0 1) +valueOf.growing.15 (program 1.0.0 1) +valueOf.growing.16 (program 1.0.0 1) +valueOf.growing.17 (program 1.0.0 1) +unionWith.const (program 1.0.0 [(#41c0, #a149736f6d65746f6b656e01)]) +unionWith.(+).itself (program 1.0.0 (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) ((\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (force (force chooseList) i1 (delay (force mkCons i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsData i2 i1) (delay (force mkCons (mkPairData i2 (i9 (force (force sndPair) i6) (force (force sndPair) i3))) (i8 (\i0 -> \i0 -> i2) i5 (force tailList i4)))) (delay (force (force ifThenElse (lessThanByteString (unBData i2) (unBData i1)) (delay (force mkCons i6 (i8 (\i0 -> \i0 -> i1) i3 (force tailList i4) i5))) (delay (force mkCons i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (force tailList i4))))))))) (force (force fstPair) i2)) (force (force fstPair) i4)) (force headList i1)))))) (\i0 -> \i0 -> force (force (force chooseList) i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (force headList i2) (force tailList i2) i1))))) i1)) i3 (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) ((\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (force (force chooseList) i1 (delay (force mkCons i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsData i2 i1) (delay (force mkCons (mkPairData i2 (i9 (force (force sndPair) i6) (force (force sndPair) i3))) (i8 (\i0 -> \i0 -> i2) i5 (force tailList i4)))) (delay (force (force ifThenElse (lessThanByteString (unBData i2) (unBData i1)) (delay (force mkCons i6 (i8 (\i0 -> \i0 -> i1) i3 (force tailList i4) i5))) (delay (force mkCons i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (force tailList i4))))))))) (force (force fstPair) i2)) (force (force fstPair) i4)) (force headList i1)))))) (\i0 -> \i0 -> force (force (force chooseList) i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (force headList i2) (force tailList i2) i1))))) i1)) i3 (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1)) +unionWith.(+).applied (program 1.0.0 [(#41c0, #a149736f6d65746f6b656e02)]) +unionWith.tokens (program 1.0.0 [(#41c0, #a24a6f74686572746f6b656e0149736f6d65746f6b656e01)]) +unionWith.symbols (program 1.0.0 [ (#41c0, #a149736f6d65746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.1 (program 1.0.0 [ (#41c0, #a149736f6d65746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.2 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.3 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.4 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.5 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.6 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.7 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.8 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +unionWith.growing.9 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) ]) +unionWith.growing.10 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c8, #a145746f6b656e01) ]) +unionWith.growing.11 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c8, #a145746f6b656e01) + , (#41c9, #a145746f6b656e01) ]) +unionWith.growing.12 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c8, #a145746f6b656e01) + , (#41c9, #a145746f6b656e01) + , (#41ca, #a145746f6b656e01) ]) +unionWith.growing.13 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c8, #a145746f6b656e01) + , (#41c9, #a145746f6b656e01) + , (#41ca, #a145746f6b656e01) + , (#41cb, #a145746f6b656e01) ]) +unionWith.growing.14 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c8, #a145746f6b656e01) + , (#41c9, #a145746f6b656e01) + , (#41ca, #a145746f6b656e01) + , (#41cb, #a145746f6b656e01) + , (#41cc, #a145746f6b656e01) ]) +unionWith.growing.15 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c8, #a145746f6b656e01) + , (#41c9, #a145746f6b656e01) + , (#41ca, #a145746f6b656e01) + , (#41cb, #a145746f6b656e01) + , (#41cc, #a145746f6b656e01) + , (#41cd, #a145746f6b656e01) ]) +unionWith.growing.16 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c8, #a145746f6b656e01) + , (#41c9, #a145746f6b656e01) + , (#41ca, #a145746f6b656e01) + , (#41cb, #a145746f6b656e01) + , (#41cc, #a145746f6b656e01) + , (#41cd, #a145746f6b656e01) + , (#41ce, #a145746f6b656e01) ]) +unionWith.growing.17 (program 1.0.0 [ (#41c0, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c1, #a145746f6b656e01) + , (#41c2, #a145746f6b656e01) + , (#41c3, #a145746f6b656e01) + , (#41c4, #a145746f6b656e01) + , (#41c5, #a145746f6b656e01) + , (#41c6, #a145746f6b656e01) + , (#41c7, #a249736f6d65746f6b656e0145746f6b656e01) + , (#41c8, #a145746f6b656e01) + , (#41c9, #a145746f6b656e01) + , (#41ca, #a145746f6b656e01) + , (#41cb, #a145746f6b656e01) + , (#41cc, #a145746f6b656e01) + , (#41cd, #a145746f6b656e01) + , (#41ce, #a145746f6b656e01) + , (#41cf, #a145746f6b656e01) ]) +unionWithData const.itself (program 1.0.0 (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) ((\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (force (force chooseList) i1 (delay (force mkCons i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsData i2 i1) (delay (force mkCons (mkPairData i2 (i9 (force (force sndPair) i6) (force (force sndPair) i3))) (i8 (\i0 -> \i0 -> i2) i5 (force tailList i4)))) (delay (force (force ifThenElse (lessThanByteString (unBData i2) (unBData i1)) (delay (force mkCons i6 (i8 (\i0 -> \i0 -> i1) i3 (force tailList i4) i5))) (delay (force mkCons i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (force tailList i4))))))))) (force (force fstPair) i2)) (force (force fstPair) i4)) (force headList i1)))))) (\i0 -> \i0 -> force (force (force chooseList) i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (force headList i2) (force tailList i2) i1))))) i1)) i3 (\i0 -> \i0 -> i2) i2 i1) (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) ((\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (force (force chooseList) i1 (delay (force mkCons i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsData i2 i1) (delay (force mkCons (mkPairData i2 (i9 (force (force sndPair) i6) (force (force sndPair) i3))) (i8 (\i0 -> \i0 -> i2) i5 (force tailList i4)))) (delay (force (force ifThenElse (lessThanByteString (unBData i2) (unBData i1)) (delay (force mkCons i6 (i8 (\i0 -> \i0 -> i1) i3 (force tailList i4) i5))) (delay (force mkCons i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (force tailList i4))))))))) (force (force fstPair) i2)) (force (force fstPair) i4)) (force headList i1)))))) (\i0 -> \i0 -> force (force (force chooseList) i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (force headList i2) (force tailList i2) i1))))) i1)) i3 (\i0 -> \i0 -> i2) i2 i1) i5 i2 i1) i2 i1)) +unionWithData const.applied (program 1.0.0 [(#41c0, #a149736f6d65746f6b656e01)]) +inv (program 1.0.0 [(#41c0, #a149736f6d65746f6b656e20)]) +equality.itself (program 1.0.0 (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1))) +equality.triviallyTrue (program 1.0.0 True) +equality.triviallyFalse (program 1.0.0 False) +equality.swappedTokensTrue (program 1.0.0 True) +equality.swappedSymbolsTrue (program 1.0.0 True) +equality.growing.1 (program 1.0.0 True) +equality.growing.2 (program 1.0.0 True) +equality.growing.3 (program 1.0.0 True) +equality.growing.4 (program 1.0.0 True) +equality.growing.5 (program 1.0.0 True) +equality.growing.6 (program 1.0.0 True) +equality.growing.7 (program 1.0.0 True) +equality.growing.8 (program 1.0.0 True) +equality.growing.9 (program 1.0.0 True) +equality.growing.10 (program 1.0.0 True) +equality.growing.11 (program 1.0.0 True) +equality.growing.12 (program 1.0.0 True) +equality.growing.13 (program 1.0.0 True) +equality.growing.14 (program 1.0.0 True) +equality.growing.15 (program 1.0.0 True) +equality.growing.16 (program 1.0.0 True) +equality.growing.17 (program 1.0.0 True) +normalize.identity (program 1.0.0 [ (#41c0, #a149736f6d65746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +normalize.empty (program 1.0.0 []) +assertSorted.succeeds (program 1.0.0 [ (#41c0, #a149736f6d65746f6b656e01) + , (#41c7, #a149736f6d65746f6b656e01) ]) +assertSorted.fails on malsorted symbols (program 1.0.0 error) +assertSorted.fails on zero quantities (program 1.0.0 error) +assertSorted.fails on empty token map (program 1.0.0 error) +Ada.adaSymbol (program 1.0.0 #) +Ada.adaToken (program 1.0.0 #) +Ada.lovelaceValueOf (program 1.0.0 (\i0 -> force (force (force chooseList) i1 (delay 0) (delay (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) (bData #)) (unIData (force (force sndPair) (force headList (unMapData (force (force sndPair) (force headList i1)))))) 0))))) +Ada.isAdaOnlyValue.itself (program 1.0.0 (\i0 -> force (force (force chooseList) i1 (delay True) (delay ((\i0 -> \i0 -> force ifThenElse i2 i1 False) (force nullList (force tailList i1)) (equalsData (force (force fstPair) (force headList i1)) (bData #))))))) +Ada.isAdaOnlyValue.true on empty (program 1.0.0 True) +Ada.isAdaOnlyValue.trivially false (program 1.0.0 False) +Ada.isAdaOnlyValue.less trivially false (program 1.0.0 False) +Ada.adaOnlyValue.itself (program 1.0.0 (\i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) (bData #)) ((\i0 -> force mkCons i1 [ ]) (force headList i1)) [ ]))))) +Ada.adaOnlyValue.on empty (program 1.0.0 []) +Ada.adaOnlyValue.on non-Ada (program 1.0.0 []) +Ada.adaOnlyValue.on Ada (program 1.0.0 [(#40, #a1401a00989680)]) +Ada.noAdaValue.itself (program 1.0.0 (\i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) (bData #)) (force tailList i1) i1))))) +Ada.noAdaValue.on empty (program 1.0.0 []) +Ada.noAdaValue.on non-Ada (program 1.0.0 [(#41c0, #a149736f6d65746f6b656e01)]) +Ada.noAdaValue.on Ada (program 1.0.0 []) \ No newline at end of file diff --git a/plutarch-test/goldens/api.value.uplc.golden b/plutarch-test/goldens/api.value.uplc.golden new file mode 100644 index 000000000..7dfc38699 --- /dev/null +++ b/plutarch-test/goldens/api.value.uplc.golden @@ -0,0 +1,89 @@ +singleton (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i3 (bData i2) (mapData i1)) #c0 ((\i0 -> \i0 -> i3 (bData i2) (iData i1)) #736f6d65746f6b656e 1)) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +singletonData (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsData i1 (iData 0)) (delay i6) (delay (i4 i3 (mapData (i4 i2 i1)))))) (bData #c0) (bData #736f6d65746f6b656e) (iData 1)) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +valueOf.itself (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i5 (\i0 -> \i0 -> force (i8 i1 (delay i5) (delay (force (i9 (equalsData (i10 (i12 i1)) i6) (delay (i4 (i11 (i12 i1)))) (delay (i2 (i13 i1)))))))) i1)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force ifThenElse)) (force (force fstPair))) (force (force sndPair))) (force headList)) (force tailList))) +valueOf.applied (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) ((\i0 -> i11 (bData i14) (mapData i1)) ((\i0 -> i11 (bData i15) (iData i1)) 1)) i13 i14) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i5 (\i0 -> \i0 -> force (i8 i1 (delay i5) (delay (force (i9 (equalsData (i10 (i12 i1)) i6) (delay (i4 (i11 (i12 i1)))) (delay (i2 (i13 i1)))))))) i1)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force ifThenElse)) (force (force fstPair))) (force (force sndPair))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c0) #736f6d65746f6b656e)) +valueOf.growing.1 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) ((\i0 -> \i0 -> i12 (bData i2) (mapData i1)) #c0 ((\i0 -> \i0 -> i12 (bData i2) (iData i1)) #736f6d65746f6b656e 1)) #c7 #746f6b656e) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i5 (\i0 -> \i0 -> force (i8 i1 (delay i5) (delay (force (i9 (equalsData (i10 (i12 i1)) i6) (delay (i4 (i11 (i12 i1)))) (delay (i2 (i13 i1)))))))) i1)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force ifThenElse)) (force (force fstPair))) (force (force sndPair))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +valueOf.growing.2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) ((\i0 -> \i0 -> (\i0 -> i6 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i7 (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i13 i14 (i15 #736f6d65746f6b656e 1)) (i13 i14 (i15 i19 1))) #c7 i19) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i7 (\i0 -> \i0 -> force (i14 i1 (delay i5) (delay (force (i12 (equalsData (i13 (i15 i1)) i6) (delay (i4 (i11 (i15 i1)))) (delay (i2 (i16 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +valueOf.growing.3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i22 1))) (i17 #c1 (i18 i22 1))) #c7 i22) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +valueOf.growing.4 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i22 1))) (i17 #c1 (i18 i22 1))) (i17 #c2 (i18 i22 1))) #c7 i22) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +valueOf.growing.5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i22 1))) (i17 #c1 (i18 i22 1))) (i17 #c2 (i18 i22 1))) (i17 #c3 (i18 i22 1))) #c7 i22) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +valueOf.growing.6 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i22 1))) (i17 #c1 (i18 i22 1))) (i17 #c2 (i18 i22 1))) (i17 #c3 (i18 i22 1))) (i17 #c4 (i18 i22 1))) #c7 i22) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +valueOf.growing.7 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i22 1))) (i17 #c1 (i18 i22 1))) (i17 #c2 (i18 i22 1))) (i17 #c3 (i18 i22 1))) (i17 #c4 (i18 i22 1))) (i17 #c5 (i18 i22 1))) #c7 i22) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +valueOf.growing.8 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i22 1))) (i17 #c1 (i18 i22 1))) (i17 #c2 (i18 i22 1))) (i17 #c3 (i18 i22 1))) (i17 #c4 (i18 i22 1))) (i17 #c5 (i18 i22 1))) (i17 #c6 (i18 i22 1))) #c7 i22) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +valueOf.growing.9 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +valueOf.growing.10 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) (i17 #c8 (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +valueOf.growing.11 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) (i17 #c8 (i18 i23 1))) (i17 #c9 (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +valueOf.growing.12 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) (i17 #c8 (i18 i23 1))) (i17 #c9 (i18 i23 1))) (i17 #ca (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +valueOf.growing.13 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) (i17 #c8 (i18 i23 1))) (i17 #c9 (i18 i23 1))) (i17 #ca (i18 i23 1))) (i17 #cb (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +valueOf.growing.14 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) (i17 #c8 (i18 i23 1))) (i17 #c9 (i18 i23 1))) (i17 #ca (i18 i23 1))) (i17 #cb (i18 i23 1))) (i17 #cc (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +valueOf.growing.15 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) (i17 #c8 (i18 i23 1))) (i17 #c9 (i18 i23 1))) (i17 #ca (i18 i23 1))) (i17 #cb (i18 i23 1))) (i17 #cc (i18 i23 1))) (i17 #cd (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +valueOf.growing.16 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) (i17 #c8 (i18 i23 1))) (i17 #c9 (i18 i23 1))) (i17 #ca (i18 i23 1))) (i17 #cb (i18 i23 1))) (i17 #cc (i18 i23 1))) (i17 #cd (i18 i23 1))) (i17 #ce (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +valueOf.growing.17 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> i4 i2 0 (\i0 -> i5 i2 0 unIData (unMapData i1)) i3) (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i3 addInteger (i17 i16 (i18 #736f6d65746f6b656e 1)) (i17 i16 (i18 i23 1))) (i17 #c1 (i18 i23 1))) (i17 #c2 (i18 i23 1))) (i17 #c3 (i18 i23 1))) (i17 #c4 (i18 i23 1))) (i17 #c5 (i18 i23 1))) (i17 #c6 (i18 i23 1))) (i17 i22 (i18 i23 1))) (i17 #c8 (i18 i23 1))) (i17 #c9 (i18 i23 1))) (i17 #ca (i18 i23 1))) (i17 #cb (i18 i23 1))) (i17 #cc (i18 i23 1))) (i17 #cd (i18 i23 1))) (i17 #ce (i18 i23 1))) (i17 #cf (i18 i23 1))) i22 i23) (\i0 -> i2 (bData i1))) (\i0 -> \i0 -> \i0 -> \i0 -> i10 (\i0 -> \i0 -> force (i17 i1 (delay i5) (delay (force (i15 (equalsData (i16 (i18 i1)) i6) (delay (i4 (i14 (i18 i1)))) (delay (i2 (i19 i1)))))))) i1)) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #c7) #746f6b656e)) +unionWith.const (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> i5 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i6 (\i0 -> \i0 -> iData (i7 (unIData i2) (unIData i1))) i2 i1) i2 i1) (\i0 -> \i0 -> i2) (i11 i12 (i13 i17 1)) (i11 i12 (i13 i17 1))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.(+).itself (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> i4 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i5 (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i11 i1 (delay (i9 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i12 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i16 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i12 i6 (i8 (\i0 -> \i0 -> i1) i3 (i16 i4) i5))) (delay (i12 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i16 i4))))))))) (i12 i2)) (i11 i4)) (i12 i1)))))) (\i0 -> \i0 -> force (i9 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i10 i2) (i11 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force mkCons)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList))) +unionWith.(+).applied (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> i4 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i5 (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i11 i12 (i13 i17 1)) (i11 i12 (i13 i17 1))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.tokens (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> i4 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i5 (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i11 i12 (i13 #736f6d65746f6b656e 1)) (i11 i12 (i13 #6f74686572746f6b656e 1))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +unionWith.symbols (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> i4 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i5 (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i11 #c0 (i12 i16 1)) (i11 #c7 (i12 i16 1))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i16 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i19 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i19 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i19 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.1 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> i5 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i6 (\i0 -> \i0 -> iData (i7 (unIData i2) (unIData i1))) i2 i1) i2 i1) (\i0 -> \i0 -> i2) (i11 #c0 (i12 i16 1)) (i11 #c7 (i12 i16 1))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i16 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i19 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i19 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i19 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i15 i14 (i16 i20 1)) (i15 i14 (i16 #746f6b656e 1))) (i15 #c7 (i16 i20 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i16 i14 (i17 i21 1)) (i16 i14 (i17 i15 1))) (i16 #c1 (i17 i15 1))) (i16 #c7 (i17 i21 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.4 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i17 i21 1)) (i16 i14 (i17 i15 1))) (i16 #c1 (i17 i15 1))) (i16 #c2 (i17 i15 1))) (i16 #c7 (i17 i21 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i17 i21 1)) (i16 i14 (i17 i15 1))) (i16 #c1 (i17 i15 1))) (i16 #c2 (i17 i15 1))) (i16 #c3 (i17 i15 1))) (i16 #c7 (i17 i21 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.6 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i17 i21 1)) (i16 i14 (i17 i15 1))) (i16 #c1 (i17 i15 1))) (i16 #c2 (i17 i15 1))) (i16 #c3 (i17 i15 1))) (i16 #c4 (i17 i15 1))) (i16 #c7 (i17 i21 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.7 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i17 i21 1)) (i16 i14 (i17 i15 1))) (i16 #c1 (i17 i15 1))) (i16 #c2 (i17 i15 1))) (i16 #c3 (i17 i15 1))) (i16 #c4 (i17 i15 1))) (i16 #c5 (i17 i15 1))) (i16 #c7 (i17 i21 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.8 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i17 i21 1)) (i16 i14 (i17 i15 1))) (i16 #c1 (i17 i15 1))) (i16 #c2 (i17 i15 1))) (i16 #c3 (i17 i15 1))) (i16 #c4 (i17 i15 1))) (i16 #c5 (i17 i15 1))) (i16 #c6 (i17 i15 1))) (i16 #c7 (i17 i21 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.9 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.10 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 #c8 (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.11 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 #c8 (i18 i15 1))) (i16 #c9 (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.12 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 #c8 (i18 i15 1))) (i16 #c9 (i18 i15 1))) (i16 #ca (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.13 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 #c8 (i18 i15 1))) (i16 #c9 (i18 i15 1))) (i16 #ca (i18 i15 1))) (i16 #cb (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.14 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 #c8 (i18 i15 1))) (i16 #c9 (i18 i15 1))) (i16 #ca (i18 i15 1))) (i16 #cb (i18 i15 1))) (i16 #cc (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.15 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 #c8 (i18 i15 1))) (i16 #c9 (i18 i15 1))) (i16 #ca (i18 i15 1))) (i16 #cb (i18 i15 1))) (i16 #cc (i18 i15 1))) (i16 #cd (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.16 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 #c8 (i18 i15 1))) (i16 #c9 (i18 i15 1))) (i16 #ca (i18 i15 1))) (i16 #cb (i18 i15 1))) (i16 #cc (i18 i15 1))) (i16 #cd (i18 i15 1))) (i16 #ce (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWith.growing.17 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> i2) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i16 i14 (i18 i22 1)) (i16 i14 (i18 i15 1))) (i16 #c1 (i18 i15 1))) (i16 #c2 (i18 i15 1))) (i16 #c3 (i18 i15 1))) (i16 #c4 (i18 i15 1))) (i16 #c5 (i18 i15 1))) (i16 #c6 (i18 i15 1))) (i16 i17 (i18 i15 1))) (i16 #c8 (i18 i15 1))) (i16 #c9 (i18 i15 1))) (i16 #ca (i18 i15 1))) (i16 #cb (i18 i15 1))) (i16 #cc (i18 i15 1))) (i16 #cd (i18 i15 1))) (i16 #ce (i18 i15 1))) (i16 #cf (i18 i15 1))) (i16 i17 (i18 i22 1))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c0) #746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +unionWithData const.itself (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> (\i0 -> i5 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i6 i5 i2 i1) i2 i1) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i11 i1 (delay (i9 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i12 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i16 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i12 i6 (i8 (\i0 -> \i0 -> i1) i3 (i16 i4) i5))) (delay (i12 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i16 i4))))))))) (i12 i2)) (i11 i4)) (i12 i1)))))) (\i0 -> \i0 -> force (i9 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i10 i2) (i11 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force mkCons)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList))) +unionWithData const.applied (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> i5 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i6 i5 i2 i1) i2 i1) (\i0 -> \i0 -> i2) (i11 i12 (i13 i17 1)) (i11 i12 (i13 i17 1))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +inv (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> i4 (\i0 -> mapData (i2 (unMapData i1)))) (\i0 -> i4 (\i0 -> iData (i4 (unIData i1))) i1) i1) (\i0 -> subtractInteger 0 i1) ((\i0 -> \i0 -> i10 (bData i2) (mapData i1)) #c0 ((\i0 -> \i0 -> i10 (bData i2) (iData i1)) #736f6d65746f6b656e 1))) (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (i6 i1 (delay i13) (delay (i12 (mkPairData (i7 (i9 i1)) (i4 (i8 (i9 i1)))) (i2 (i10 i1)))))) i1)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force (force fstPair))) (force (force sndPair))) (force headList)) (force tailList)) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +equality.itself (program 1.0.0 (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1))) +equality.triviallyTrue (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 i2 (i3 i7 1)) (i1 i2 (i3 i7 1))) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +equality.triviallyFalse (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 i2 (i3 #736f6d65746f6b656e 1)) (i1 i2 (i3 #6f74686572746f6b656e 1))) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +equality.swappedTokensTrue (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i15 i16 (i17 i21 1)) (i15 i16 (i17 i14 1))) (i1 addInteger (i15 i16 (i17 i14 1)) (i15 i16 (i17 i21 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #6f74686572746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +equality.swappedSymbolsTrue (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i15 i16 (i17 i21 1)) (i15 i14 (i17 i21 1))) (i1 addInteger (i15 i14 (i17 i21 1)) (i15 i16 (i17 i21 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #c7) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +equality.growing.1 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 i2 (i3 i7 1)) (i1 i2 (i3 i7 1))) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +equality.growing.2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i15 i16 (i17 i14 1)) (i15 i16 (i17 i21 1))) (i1 addInteger (i15 i16 (i17 i14 1)) (i15 i16 (i17 i21 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i18 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i21 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i21 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i21 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i16 i15 (i18 i14 1)) (i16 i15 (i18 i22 1))) (i16 i17 (i18 i22 1))) (i1 addInteger (i1 addInteger (i16 i15 (i18 i14 1)) (i16 i15 (i18 i22 1))) (i16 i17 (i18 i22 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i19 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i22 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i22 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i22 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c1) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.4 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i17 i15 (i19 i14 1)) (i17 i15 (i19 i23 1))) (i17 i16 (i19 i23 1))) (i17 i18 (i19 i23 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i17 i15 (i19 i14 1)) (i17 i15 (i19 i23 1))) (i17 i16 (i19 i23 1))) (i17 i18 (i19 i23 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i20 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i23 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i23 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i23 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c2) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i18 i15 (i20 i14 1)) (i18 i15 (i20 i24 1))) (i18 i16 (i20 i24 1))) (i18 i17 (i20 i24 1))) (i18 i19 (i20 i24 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i18 i15 (i20 i14 1)) (i18 i15 (i20 i24 1))) (i18 i16 (i20 i24 1))) (i18 i17 (i20 i24 1))) (i18 i19 (i20 i24 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i21 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i24 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i24 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i24 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c3) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.6 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i19 i15 (i21 i14 1)) (i19 i15 (i21 i25 1))) (i19 i16 (i21 i25 1))) (i19 i17 (i21 i25 1))) (i19 i18 (i21 i25 1))) (i19 i20 (i21 i25 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i19 i15 (i21 i14 1)) (i19 i15 (i21 i25 1))) (i19 i16 (i21 i25 1))) (i19 i17 (i21 i25 1))) (i19 i18 (i21 i25 1))) (i19 i20 (i21 i25 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i22 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i25 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i25 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i25 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c4) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.7 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i20 i15 (i22 i14 1)) (i20 i15 (i22 i26 1))) (i20 i16 (i22 i26 1))) (i20 i17 (i22 i26 1))) (i20 i18 (i22 i26 1))) (i20 i19 (i22 i26 1))) (i20 i21 (i22 i26 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i20 i15 (i22 i14 1)) (i20 i15 (i22 i26 1))) (i20 i16 (i22 i26 1))) (i20 i17 (i22 i26 1))) (i20 i18 (i22 i26 1))) (i20 i19 (i22 i26 1))) (i20 i21 (i22 i26 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i23 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i26 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i26 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i26 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c5) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.8 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i21 i15 (i23 i14 1)) (i21 i15 (i23 i27 1))) (i21 i16 (i23 i27 1))) (i21 i17 (i23 i27 1))) (i21 i18 (i23 i27 1))) (i21 i19 (i23 i27 1))) (i21 i20 (i23 i27 1))) (i21 i22 (i23 i27 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i21 i15 (i23 i14 1)) (i21 i15 (i23 i27 1))) (i21 i16 (i23 i27 1))) (i21 i17 (i23 i27 1))) (i21 i18 (i23 i27 1))) (i21 i19 (i23 i27 1))) (i21 i20 (i23 i27 1))) (i21 i22 (i23 i27 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i24 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i27 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i27 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i27 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c6) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.9 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i22 i15 (i24 i14 1)) (i22 i15 (i24 i28 1))) (i22 i16 (i24 i28 1))) (i22 i17 (i24 i28 1))) (i22 i18 (i24 i28 1))) (i22 i19 (i24 i28 1))) (i22 i20 (i24 i28 1))) (i22 i21 (i24 i28 1))) (i22 i23 (i24 i28 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i22 i15 (i24 i14 1)) (i22 i15 (i24 i28 1))) (i22 i16 (i24 i28 1))) (i22 i17 (i24 i28 1))) (i22 i18 (i24 i28 1))) (i22 i19 (i24 i28 1))) (i22 i20 (i24 i28 1))) (i22 i21 (i24 i28 1))) (i22 i23 (i24 i28 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i25 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i28 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i28 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i28 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c7) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.10 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i23 i15 (i25 i14 1)) (i23 i15 (i25 i29 1))) (i23 i16 (i25 i29 1))) (i23 i17 (i25 i29 1))) (i23 i18 (i25 i29 1))) (i23 i19 (i25 i29 1))) (i23 i20 (i25 i29 1))) (i23 i21 (i25 i29 1))) (i23 i22 (i25 i29 1))) (i23 i24 (i25 i29 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i23 i15 (i25 i14 1)) (i23 i15 (i25 i29 1))) (i23 i16 (i25 i29 1))) (i23 i17 (i25 i29 1))) (i23 i18 (i25 i29 1))) (i23 i19 (i25 i29 1))) (i23 i20 (i25 i29 1))) (i23 i21 (i25 i29 1))) (i23 i22 (i25 i29 1))) (i23 i24 (i25 i29 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i26 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i29 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i29 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i29 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) #c7) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c8) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.11 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i24 i15 (i26 i14 1)) (i24 i15 (i26 i30 1))) (i24 i16 (i26 i30 1))) (i24 i17 (i26 i30 1))) (i24 i18 (i26 i30 1))) (i24 i19 (i26 i30 1))) (i24 i20 (i26 i30 1))) (i24 i21 (i26 i30 1))) (i24 i22 (i26 i30 1))) (i24 i23 (i26 i30 1))) (i24 i25 (i26 i30 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i24 i15 (i26 i14 1)) (i24 i15 (i26 i30 1))) (i24 i16 (i26 i30 1))) (i24 i17 (i26 i30 1))) (i24 i18 (i26 i30 1))) (i24 i19 (i26 i30 1))) (i24 i20 (i26 i30 1))) (i24 i21 (i26 i30 1))) (i24 i22 (i26 i30 1))) (i24 i23 (i26 i30 1))) (i24 i25 (i26 i30 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i27 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i30 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i30 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i30 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) #c7) #c8) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c9) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.12 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i25 i15 (i27 i14 1)) (i25 i15 (i27 i31 1))) (i25 i16 (i27 i31 1))) (i25 i17 (i27 i31 1))) (i25 i18 (i27 i31 1))) (i25 i19 (i27 i31 1))) (i25 i20 (i27 i31 1))) (i25 i21 (i27 i31 1))) (i25 i22 (i27 i31 1))) (i25 i23 (i27 i31 1))) (i25 i24 (i27 i31 1))) (i25 i26 (i27 i31 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i25 i15 (i27 i14 1)) (i25 i15 (i27 i31 1))) (i25 i16 (i27 i31 1))) (i25 i17 (i27 i31 1))) (i25 i18 (i27 i31 1))) (i25 i19 (i27 i31 1))) (i25 i20 (i27 i31 1))) (i25 i21 (i27 i31 1))) (i25 i22 (i27 i31 1))) (i25 i23 (i27 i31 1))) (i25 i24 (i27 i31 1))) (i25 i26 (i27 i31 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i28 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i31 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i31 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i31 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) #c7) #c8) #c9) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #ca) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.13 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i26 i15 (i28 i14 1)) (i26 i15 (i28 i32 1))) (i26 i16 (i28 i32 1))) (i26 i17 (i28 i32 1))) (i26 i18 (i28 i32 1))) (i26 i19 (i28 i32 1))) (i26 i20 (i28 i32 1))) (i26 i21 (i28 i32 1))) (i26 i22 (i28 i32 1))) (i26 i23 (i28 i32 1))) (i26 i24 (i28 i32 1))) (i26 i25 (i28 i32 1))) (i26 i27 (i28 i32 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i26 i15 (i28 i14 1)) (i26 i15 (i28 i32 1))) (i26 i16 (i28 i32 1))) (i26 i17 (i28 i32 1))) (i26 i18 (i28 i32 1))) (i26 i19 (i28 i32 1))) (i26 i20 (i28 i32 1))) (i26 i21 (i28 i32 1))) (i26 i22 (i28 i32 1))) (i26 i23 (i28 i32 1))) (i26 i24 (i28 i32 1))) (i26 i25 (i28 i32 1))) (i26 i27 (i28 i32 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i29 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i32 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i32 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i32 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) #c7) #c8) #c9) #ca) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #cb) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.14 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i27 i15 (i29 i14 1)) (i27 i15 (i29 i33 1))) (i27 i16 (i29 i33 1))) (i27 i17 (i29 i33 1))) (i27 i18 (i29 i33 1))) (i27 i19 (i29 i33 1))) (i27 i20 (i29 i33 1))) (i27 i21 (i29 i33 1))) (i27 i22 (i29 i33 1))) (i27 i23 (i29 i33 1))) (i27 i24 (i29 i33 1))) (i27 i25 (i29 i33 1))) (i27 i26 (i29 i33 1))) (i27 i28 (i29 i33 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i27 i15 (i29 i14 1)) (i27 i15 (i29 i33 1))) (i27 i16 (i29 i33 1))) (i27 i17 (i29 i33 1))) (i27 i18 (i29 i33 1))) (i27 i19 (i29 i33 1))) (i27 i20 (i29 i33 1))) (i27 i21 (i29 i33 1))) (i27 i22 (i29 i33 1))) (i27 i23 (i29 i33 1))) (i27 i24 (i29 i33 1))) (i27 i25 (i29 i33 1))) (i27 i26 (i29 i33 1))) (i27 i28 (i29 i33 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i30 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i33 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i33 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i33 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) #c7) #c8) #c9) #ca) #cb) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #cc) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.15 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i28 i15 (i30 i14 1)) (i28 i15 (i30 i34 1))) (i28 i16 (i30 i34 1))) (i28 i17 (i30 i34 1))) (i28 i18 (i30 i34 1))) (i28 i19 (i30 i34 1))) (i28 i20 (i30 i34 1))) (i28 i21 (i30 i34 1))) (i28 i22 (i30 i34 1))) (i28 i23 (i30 i34 1))) (i28 i24 (i30 i34 1))) (i28 i25 (i30 i34 1))) (i28 i26 (i30 i34 1))) (i28 i27 (i30 i34 1))) (i28 i29 (i30 i34 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i28 i15 (i30 i14 1)) (i28 i15 (i30 i34 1))) (i28 i16 (i30 i34 1))) (i28 i17 (i30 i34 1))) (i28 i18 (i30 i34 1))) (i28 i19 (i30 i34 1))) (i28 i20 (i30 i34 1))) (i28 i21 (i30 i34 1))) (i28 i22 (i30 i34 1))) (i28 i23 (i30 i34 1))) (i28 i24 (i30 i34 1))) (i28 i25 (i30 i34 1))) (i28 i26 (i30 i34 1))) (i28 i27 (i30 i34 1))) (i28 i29 (i30 i34 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i31 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i34 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i34 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i34 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) #c7) #c8) #c9) #ca) #cb) #cc) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #cd) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.16 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i29 i15 (i31 i14 1)) (i29 i15 (i31 i35 1))) (i29 i16 (i31 i35 1))) (i29 i17 (i31 i35 1))) (i29 i18 (i31 i35 1))) (i29 i19 (i31 i35 1))) (i29 i20 (i31 i35 1))) (i29 i21 (i31 i35 1))) (i29 i22 (i31 i35 1))) (i29 i23 (i31 i35 1))) (i29 i24 (i31 i35 1))) (i29 i25 (i31 i35 1))) (i29 i26 (i31 i35 1))) (i29 i27 (i31 i35 1))) (i29 i28 (i31 i35 1))) (i29 i30 (i31 i35 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i29 i15 (i31 i14 1)) (i29 i15 (i31 i35 1))) (i29 i16 (i31 i35 1))) (i29 i17 (i31 i35 1))) (i29 i18 (i31 i35 1))) (i29 i19 (i31 i35 1))) (i29 i20 (i31 i35 1))) (i29 i21 (i31 i35 1))) (i29 i22 (i31 i35 1))) (i29 i23 (i31 i35 1))) (i29 i24 (i31 i35 1))) (i29 i25 (i31 i35 1))) (i29 i26 (i31 i35 1))) (i29 i27 (i31 i35 1))) (i29 i28 (i31 i35 1))) (i29 i30 (i31 i35 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i32 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i35 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i35 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i35 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) #c7) #c8) #c9) #ca) #cb) #cc) #cd) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #ce) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +equality.growing.17 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> equalsData (mapData i2) (mapData i1)) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i30 i15 (i32 i14 1)) (i30 i15 (i32 i36 1))) (i30 i16 (i32 i36 1))) (i30 i17 (i32 i36 1))) (i30 i18 (i32 i36 1))) (i30 i19 (i32 i36 1))) (i30 i20 (i32 i36 1))) (i30 i21 (i32 i36 1))) (i30 i22 (i32 i36 1))) (i30 i23 (i32 i36 1))) (i30 i24 (i32 i36 1))) (i30 i25 (i32 i36 1))) (i30 i26 (i32 i36 1))) (i30 i27 (i32 i36 1))) (i30 i28 (i32 i36 1))) (i30 i29 (i32 i36 1))) (i30 i31 (i32 i36 1))) (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i1 addInteger (i30 i15 (i32 i14 1)) (i30 i15 (i32 i36 1))) (i30 i16 (i32 i36 1))) (i30 i17 (i32 i36 1))) (i30 i18 (i32 i36 1))) (i30 i19 (i32 i36 1))) (i30 i20 (i32 i36 1))) (i30 i21 (i32 i36 1))) (i30 i22 (i32 i36 1))) (i30 i23 (i32 i36 1))) (i30 i24 (i32 i36 1))) (i30 i25 (i32 i36 1))) (i30 i26 (i32 i36 1))) (i30 i27 (i32 i36 1))) (i30 i28 (i32 i36 1))) (i30 i29 (i32 i36 1))) (i30 i31 (i32 i36 1)))) (\i0 -> \i0 -> \i0 -> i4 (\i0 -> \i0 -> i7 i5 i2 i1) i2 i1)) (\i0 -> i3 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1))))) (\i0 -> i2 (\i0 -> \i0 -> iData (i3 (unIData i2) (unIData i1))))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i33 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i36 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i36 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i36 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) #736f6d65746f6b656e) #c0) #c1) #c2) #c3) #c4) #c5) #c6) #c7) #c8) #c9) #ca) #cb) #cc) #cd) #ce) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #cf) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #746f6b656e)) +normalize.identity (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i11 ((\i0 -> \i0 -> i4 (\i0 -> i3 (unMapData (i13 i1))) i1) (\i0 -> (\i0 -> \i0 -> i5 (\i0 -> i3 (unIData (i14 i1))) i1) (\i0 -> lessThanInteger 0 i1) i1) i1) (delay i1) (delay (force (force trace "Negative amount in Value" (delay error)))))) ((\i0 -> (\i0 -> i6 (\i0 -> i2 (unMapData i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (mapData i1)) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> (\i0 -> force (i13 (force nullList i1) (delay (\i0 -> \i0 -> force i1)) (delay (\i0 -> \i0 -> i2 i3)))) (i6 (\i0 -> force (i13 (equalsData i1 (iData 0)) (delay (\i0 -> \i0 -> force i1)) (delay (\i0 -> \i0 -> i2 i3)))) i1)) i1) ((\i0 -> \i0 -> (\i0 -> i8 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i9 (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i15 #c0 (i16 i20 1)) (i15 #c7 (i16 i20 1))))) (\i0 -> i7 (\i0 -> \i0 -> force (i14 i1 (delay True) (delay (force (i4 (i3 (i15 i1)) (delay (i2 (i16 i1)))))))))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> \i0 -> i5 (\i0 -> \i0 -> force (i12 i1 (delay i19) (delay ((\i0 -> i5 (i10 (i14 i2)) (\i0 -> i20 (mkPairData (i13 (i15 i3)) i1) i2) (delay i1)) (i2 (i14 i1)))))) i1)) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i16 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i19 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i19 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i19 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +normalize.empty (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i3 (\i0 -> i2 (unMapData i1) (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) (mapData i1)) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> (\i0 -> force (i10 (force nullList i1) (delay (\i0 -> \i0 -> force i1)) (delay (\i0 -> \i0 -> i2 i3)))) (i3 (\i0 -> force (i10 (equalsData i1 (iData 0)) (delay (\i0 -> \i0 -> force i1)) (delay (\i0 -> \i0 -> i2 i3)))) i1)) i1) ((\i0 -> \i0 -> (\i0 -> i5 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i6 (\i0 -> \i0 -> iData (subtractInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i12 i13 (i14 i18 1)) (i12 i13 (i14 i18 1)))) (\i0 -> \i0 -> i5 (\i0 -> \i0 -> force (i12 i1 (delay i20) (delay ((\i0 -> i5 (i10 (i14 i2)) (\i0 -> i21 (mkPairData (i13 (i15 i3)) i1) i2) (delay i1)) (i2 (i14 i1)))))) i1)) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +assertSorted.succeeds (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i13 ((\i0 -> \i0 -> i4 (\i0 -> i3 (unMapData (i15 i1))) i1) (\i0 -> force (i4 (force nullList (i6 i1)) (delay ((\i0 -> \i0 -> i5 (\i0 -> i3 (unIData (i16 i1))) i1) (\i0 -> equalsInteger i1 0) i1)))) i1) (delay (force (i6 "Abnormal Value" (delay error)))) (delay (i5 i1)))) ((\i0 -> \i0 -> (\i0 -> i10 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i11 (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i17 #c0 (i18 i22 1)) (i17 #c7 (i18 i22 1)))) (\i0 -> i9 (\i0 -> \i0 -> force (i16 i1 (delay False) (delay (force (i4 (i3 (i17 i1)) (delay (i2 (i18 i1)))))))))) (\i0 -> i11 i1 i2)) (delay True)) (\i0 -> i6 (\i0 -> \i0 -> force (i13 i1 (delay (\i0 -> i4)) (delay ((\i0 -> \i0 -> force (i13 (i1 i2) (delay (force (i6 i7 (delay error)))) (delay (i4 (i17 i3) (\i0 -> lessThanByteString i1 i3))))) (unBData (i12 (i14 i1))))))) i1 (\i0 -> False))) (force trace)) "unsorted map") (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i16 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i19 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i19 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i19 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +assertSorted.fails on malsorted symbols (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 ((\i0 -> \i0 -> i4 (\i0 -> i3 (unMapData (i8 i1))) i1) (\i0 -> force (i4 (force nullList (i7 i1)) (delay ((\i0 -> \i0 -> i5 (\i0 -> i3 (unIData (i9 i1))) i1) (\i0 -> equalsInteger i1 0) i1)))) i1) (delay (force (i8 "Abnormal Value" (delay error)))) (delay (i6 i1)))) ((\i0 -> \i0 -> i12 (\i0 -> \i0 -> force (i15 i1 (delay i3) (delay (i21 (i16 i1) (i2 (i17 i1)))))) i2) (i14 #c7 (i15 i19 1)) (i14 #c0 (i15 i19 1)))) (\i0 -> i10 (\i0 -> \i0 -> force (i13 i1 (delay False) (delay (force (i4 (i3 (i14 i1)) (delay (i2 (i15 i1)))))))))) (\i0 -> i5 i1 i2)) (delay True)) (force (force sndPair))) (\i0 -> i6 (\i0 -> \i0 -> force (i9 i1 (delay (\i0 -> i4)) (delay ((\i0 -> \i0 -> force (i6 (i1 i2) (delay (force (i7 i8 (delay error)))) (delay (i4 (i13 i3) (\i0 -> lessThanByteString i1 i3))))) (unBData (i7 (i10 i1))))))) i1 (\i0 -> False))) (force ifThenElse)) (force trace)) "unsorted map") (force (force fstPair))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +assertSorted.fails on zero quantities (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i13 ((\i0 -> \i0 -> i4 (\i0 -> i3 (unMapData (i15 i1))) i1) (\i0 -> force (i4 (force nullList (i6 i1)) (delay ((\i0 -> \i0 -> i5 (\i0 -> i3 (unIData (i16 i1))) i1) (\i0 -> equalsInteger i1 0) i1)))) i1) (delay (force (i6 "Abnormal Value" (delay error)))) (delay (i5 i1)))) ((\i0 -> \i0 -> (\i0 -> i10 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i11 (\i0 -> \i0 -> iData (subtractInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i17 i18 (i19 i23 1)) (i17 i18 (i19 i23 1)))) (\i0 -> i9 (\i0 -> \i0 -> force (i16 i1 (delay False) (delay (force (i4 (i3 (i17 i1)) (delay (i2 (i18 i1)))))))))) (\i0 -> i11 i1 i2)) (delay True)) (\i0 -> i6 (\i0 -> \i0 -> force (i13 i1 (delay (\i0 -> i4)) (delay ((\i0 -> \i0 -> force (i13 (i1 i2) (delay (force (i6 i7 (delay error)))) (delay (i4 (i17 i3) (\i0 -> lessThanByteString i1 i3))))) (unBData (i12 (i14 i1))))))) i1 (\i0 -> False))) (force trace)) "unsorted map") (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i17 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i20 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i20 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i20 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i5 (bData i2) (mapData i1))) #c0) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #736f6d65746f6b656e)) +assertSorted.fails on empty token map (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i9 ((\i0 -> \i0 -> i4 (\i0 -> i3 (unMapData (i8 i1))) i1) (\i0 -> force (i4 (force nullList (i7 i1)) (delay ((\i0 -> \i0 -> i5 (\i0 -> i3 (unIData (i9 i1))) i1) (\i0 -> equalsInteger i1 0) i1)))) i1) (delay (force (i10 "Abnormal Value" (delay error)))) (delay (i6 i1)))) ((\i0 -> \i0 -> (\i0 -> \i0 -> force mkCons (mkPairData i2 i1) i18) (bData i2) (mapData i1)) #c0 i14)) (\i0 -> i6 (\i0 -> \i0 -> force (i9 i1 (delay False) (delay (force (i4 (i3 (i15 i1)) (delay (i2 (i13 i1)))))))))) (\i0 -> i7 i1 i2)) (delay True)) (force (force sndPair))) (\i0 -> i2 (\i0 -> \i0 -> force (i5 i1 (delay (\i0 -> i4)) (delay ((\i0 -> \i0 -> force (i8 (i1 i2) (delay (force (i9 i10 (delay error)))) (delay (i4 (i11 i3) (\i0 -> lessThanByteString i1 i3))))) (unBData (i10 (i11 i1))))))) i1 (\i0 -> False))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force ifThenElse)) (force trace)) "unsorted map") (force tailList)) (force (force fstPair))) (force headList)) [ ])) +Ada.adaSymbol (program 1.0.0 #) +Ada.adaToken (program 1.0.0 #) +Ada.lovelaceValueOf (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> force (force (force chooseList) i1 (delay 0) (delay (force ifThenElse (equalsData (force (force fstPair) (i3 i1)) (bData #)) (unIData (i2 (i3 (unMapData (i2 (i3 i1)))))) 0)))) (force (force sndPair))) (force headList))) +Ada.isAdaOnlyValue.itself (program 1.0.0 (\i0 -> force (force (force chooseList) i1 (delay True) (delay ((\i0 -> \i0 -> force ifThenElse i2 i1 False) (force nullList (force tailList i1)) (equalsData (force (force fstPair) (force headList i1)) (bData #))))))) +Ada.isAdaOnlyValue.true on empty (program 1.0.0 ((\i0 -> force (force (force chooseList) i1 (delay True) (delay ((\i0 -> \i0 -> force ifThenElse i2 i1 False) (force nullList (force tailList i1)) (equalsData (force (force fstPair) (force headList i1)) (bData #)))))) [ ])) +Ada.isAdaOnlyValue.trivially false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force (force chooseList) i1 (delay True) (delay ((\i0 -> \i0 -> force ifThenElse i2 i1 False) (force nullList (force tailList i1)) (equalsData (force (force fstPair) (force headList i1)) (bData #)))))) ((\i0 -> \i0 -> i3 (bData i2) (mapData i1)) #c0 ((\i0 -> \i0 -> i3 (bData i2) (iData i1)) #736f6d65746f6b656e 1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +Ada.isAdaOnlyValue.less trivially false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i9 i1 (delay True) (delay ((\i0 -> \i0 -> i9 i2 i1 False) (force nullList (i11 i1)) (equalsData (i8 (i10 i1)) (bData i17)))))) ((\i0 -> \i0 -> (\i0 -> i4 (\i0 -> \i0 -> mapData (i3 (unMapData i2) (unMapData i1)))) (\i0 -> \i0 -> i5 (\i0 -> \i0 -> iData (addInteger (unIData i2) (unIData i1))) i2 i1) i2 i1) (i11 #c0 (i12 #736f6d65746f6b656e 1)) (i11 i16 (i12 i16 10000000)))) (\i0 -> \i0 -> \i0 -> i4 i3 (\i0 -> \i0 -> i2) i2 i1)) (\i0 -> i2 (i3 i1))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (\i0 -> \i0 -> \i0 -> force (i10 i1 (delay (i16 i3 i2)) (delay ((\i0 -> (\i0 -> (\i0 -> force (i11 (equalsData i2 i1) (delay (i19 (mkPairData i2 (i9 (i10 i6) (i10 i3))) (i8 (\i0 -> \i0 -> i2) i5 (i15 i4)))) (delay (force (i11 (lessThanByteString (unBData i2) (unBData i1)) (delay (i19 i6 (i8 (\i0 -> \i0 -> i1) i3 (i15 i4) i5))) (delay (i19 i3 (i8 (\i0 -> \i0 -> i1) i6 i5 (i15 i4))))))))) (i11 i2)) (i10 i4)) (i11 i1)))))) (\i0 -> \i0 -> force (i8 i2 (delay i1) (delay (i3 (\i0 -> \i0 -> i1) (i9 i2) (i10 i2) i1)))))) (force (force sndPair))) (force ifThenElse)) (force (force fstPair))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> \i0 -> i4 (bData i2) (mapData i1))) (\i0 -> \i0 -> i3 (bData i2) (iData i1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #)) +Ada.adaOnlyValue.itself (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (i2 i1)) (bData #)) ((\i0 -> force mkCons i1 i4) (i2 i1)) i3)))) (force headList)) [ ])) +Ada.adaOnlyValue.on empty (program 1.0.0 ((\i0 -> (\i0 -> force (force (force chooseList) i2 (delay i2) (delay (force ifThenElse (equalsData (force (force fstPair) (i1 i2)) (bData #)) ((\i0 -> force mkCons i1 i3) (i1 i2)) i2)))) (force headList)) [ ])) +Ada.adaOnlyValue.on non-Ada (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (i2 i1)) (bData #)) ((\i0 -> i5 i1 i6) (i2 i1)) i5)))) ((\i0 -> \i0 -> i4 (bData i2) (mapData i1)) #c0 ((\i0 -> \i0 -> i4 (bData i2) (iData i1)) #736f6d65746f6b656e 1))) (force headList)) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +Ada.adaOnlyValue.on Ada (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (i2 i1)) (bData i6)) ((\i0 -> i5 i1 i6) (i2 i1)) i5)))) ((\i0 -> i3 (bData i6) (mapData i1)) ((\i0 -> i3 (bData i6) (iData i1)) 10000000))) (force headList)) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #)) +Ada.noAdaValue.itself (program 1.0.0 (\i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) (bData #)) (force tailList i1) i1))))) +Ada.noAdaValue.on empty (program 1.0.0 ((\i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) (bData #)) (force tailList i1) i1)))) [ ])) +Ada.noAdaValue.on non-Ada (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) (bData #)) (force tailList i1) i1)))) ((\i0 -> \i0 -> i3 (bData i2) (mapData i1)) #c0 ((\i0 -> \i0 -> i3 (bData i2) (iData i1)) #736f6d65746f6b656e 1))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ])) +Ada.noAdaValue.on Ada (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force (force chooseList) i1 (delay i1) (delay (force ifThenElse (equalsData (force (force fstPair) (force headList i1)) (bData i5)) (force tailList i1) i1)))) ((\i0 -> i2 (bData i5) (mapData i1)) ((\i0 -> i2 (bData i5) (iData i1)) 10000000))) (\i0 -> \i0 -> i3 (mkPairData i2 i1) i4)) (force mkCons)) [ ]) #)) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.bench.golden b/plutarch-test/goldens/bool.bench.golden new file mode 100644 index 000000000..18bfaecc2 --- /dev/null +++ b/plutarch-test/goldens/bool.bench.golden @@ -0,0 +1,17 @@ +pnot.lam {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":13} +pnot.app {"exBudgetCPU":333656,"exBudgetMemory":1201,"scriptSizeBytes":15} +pand.tf {"exBudgetCPU":448656,"exBudgetMemory":1701,"scriptSizeBytes":19} +pand.ft {"exBudgetCPU":448656,"exBudgetMemory":1701,"scriptSizeBytes":19} +pand.tt {"exBudgetCPU":448656,"exBudgetMemory":1701,"scriptSizeBytes":19} +pand.ff {"exBudgetCPU":448656,"exBudgetMemory":1701,"scriptSizeBytes":19} +pand.laziness.pand {"exBudgetCPU":402656,"exBudgetMemory":1501,"scriptSizeBytes":17} +pand.laziness.op {"exBudgetCPU":448656,"exBudgetMemory":1701,"scriptSizeBytes":18} +pand.laziness.pand.perror.op {"exBudgetCPU":80656,"exBudgetMemory":101,"scriptSizeBytes":18} +por.tf {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":16} +por.ft {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":16} +por.tt {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":16} +por.ff {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":16} +por.laziness.por {"exBudgetCPU":333656,"exBudgetMemory":1201,"scriptSizeBytes":15} +por.laziness.op {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":15} +por.laziness.pand.perror.op.true {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":15} +por.laziness.pand.perror.op.false {"exBudgetCPU":80656,"exBudgetMemory":101,"scriptSizeBytes":15} \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pand.bench.golden b/plutarch-test/goldens/bool.pand.bench.golden deleted file mode 100644 index e6b134eec..000000000 --- a/plutarch-test/goldens/bool.pand.bench.golden +++ /dev/null @@ -1,4 +0,0 @@ -tf {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":19} -ft {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":19} -tt {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":19} -ff {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":19} \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pand.laziness.bench.golden b/plutarch-test/goldens/bool.pand.laziness.bench.golden deleted file mode 100644 index dc2ec382c..000000000 --- a/plutarch-test/goldens/bool.pand.laziness.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -pand {"exBudgetCPU":416923,"exBudgetMemory":1501,"scriptSizeBytes":17} -op {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":18} \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pand.laziness.uplc.eval.golden b/plutarch-test/goldens/bool.pand.laziness.uplc.eval.golden deleted file mode 100644 index ffb471430..000000000 --- a/plutarch-test/goldens/bool.pand.laziness.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -pand (program 1.0.0 (delay False)) -op (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pand.laziness.uplc.golden b/plutarch-test/goldens/bool.pand.laziness.uplc.golden deleted file mode 100644 index 9c7692e99..000000000 --- a/plutarch-test/goldens/bool.pand.laziness.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -pand (program 1.0.0 ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) False (delay error))) -op (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) False (delay error)))) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pand.uplc.eval.golden b/plutarch-test/goldens/bool.pand.uplc.eval.golden deleted file mode 100644 index 3b74b8afe..000000000 --- a/plutarch-test/goldens/bool.pand.uplc.eval.golden +++ /dev/null @@ -1,4 +0,0 @@ -tf (program 1.0.0 False) -ft (program 1.0.0 False) -tt (program 1.0.0 True) -ff (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pand.uplc.golden b/plutarch-test/goldens/bool.pand.uplc.golden deleted file mode 100644 index e59d781e5..000000000 --- a/plutarch-test/goldens/bool.pand.uplc.golden +++ /dev/null @@ -1,4 +0,0 @@ -tf (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) True (delay False)))) -ft (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) False (delay True)))) -tt (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) True (delay True)))) -ff (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) False (delay False)))) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pnot.bench.golden b/plutarch-test/goldens/bool.pnot.bench.golden deleted file mode 100644 index 7bd18a8b3..000000000 --- a/plutarch-test/goldens/bool.pnot.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -lam {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":14} -app {"exBudgetCPU":387150,"exBudgetMemory":1401,"scriptSizeBytes":16} \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pnot.uplc.eval.golden b/plutarch-test/goldens/bool.pnot.uplc.eval.golden deleted file mode 100644 index f9a2f86f0..000000000 --- a/plutarch-test/goldens/bool.pnot.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -lam (program 1.0.0 (\i0 -> force (force ifThenElse i1 (delay False) (delay True)))) -app (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.pnot.uplc.golden b/plutarch-test/goldens/bool.pnot.uplc.golden deleted file mode 100644 index 8426644c8..000000000 --- a/plutarch-test/goldens/bool.pnot.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -lam (program 1.0.0 (\i0 -> force (force ifThenElse i1 (delay False) (delay True)))) -app (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay False) (delay True))) True)) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.por.bench.golden b/plutarch-test/goldens/bool.por.bench.golden deleted file mode 100644 index e6b134eec..000000000 --- a/plutarch-test/goldens/bool.por.bench.golden +++ /dev/null @@ -1,4 +0,0 @@ -tf {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":19} -ft {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":19} -tt {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":19} -ff {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":19} \ No newline at end of file diff --git a/plutarch-test/goldens/bool.por.laziness.bench.golden b/plutarch-test/goldens/bool.por.laziness.bench.golden deleted file mode 100644 index c12676d85..000000000 --- a/plutarch-test/goldens/bool.por.laziness.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -por {"exBudgetCPU":416923,"exBudgetMemory":1501,"scriptSizeBytes":17} -op {"exBudgetCPU":476469,"exBudgetMemory":1701,"scriptSizeBytes":18} \ No newline at end of file diff --git a/plutarch-test/goldens/bool.por.laziness.uplc.eval.golden b/plutarch-test/goldens/bool.por.laziness.uplc.eval.golden deleted file mode 100644 index ae0c94093..000000000 --- a/plutarch-test/goldens/bool.por.laziness.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -por (program 1.0.0 (delay True)) -op (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.por.laziness.uplc.golden b/plutarch-test/goldens/bool.por.laziness.uplc.golden deleted file mode 100644 index f66bc7186..000000000 --- a/plutarch-test/goldens/bool.por.laziness.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -por (program 1.0.0 ((\i0 -> \i0 -> force ifThenElse i2 (delay True) i1) True (delay error))) -op (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 (delay True) i1) True (delay error)))) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.por.uplc.eval.golden b/plutarch-test/goldens/bool.por.uplc.eval.golden deleted file mode 100644 index 376cf2bb7..000000000 --- a/plutarch-test/goldens/bool.por.uplc.eval.golden +++ /dev/null @@ -1,4 +0,0 @@ -tf (program 1.0.0 True) -ft (program 1.0.0 True) -tt (program 1.0.0 True) -ff (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.por.uplc.golden b/plutarch-test/goldens/bool.por.uplc.golden deleted file mode 100644 index bcdd4ba13..000000000 --- a/plutarch-test/goldens/bool.por.uplc.golden +++ /dev/null @@ -1,4 +0,0 @@ -tf (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 (delay True) i1) True (delay False)))) -ft (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 (delay True) i1) False (delay True)))) -tt (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 (delay True) i1) True (delay True)))) -ff (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 (delay True) i1) False (delay False)))) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.uplc.eval.golden b/plutarch-test/goldens/bool.uplc.eval.golden new file mode 100644 index 000000000..bcb8a5b68 --- /dev/null +++ b/plutarch-test/goldens/bool.uplc.eval.golden @@ -0,0 +1,17 @@ +pnot.lam (program 1.0.0 (\i0 -> force ifThenElse i1 False True)) +pnot.app (program 1.0.0 False) +pand.tf (program 1.0.0 False) +pand.ft (program 1.0.0 False) +pand.tt (program 1.0.0 True) +pand.ff (program 1.0.0 False) +pand.laziness.pand (program 1.0.0 (delay False)) +pand.laziness.op (program 1.0.0 False) +pand.laziness.pand.perror.op (program 1.0.0 error) +por.tf (program 1.0.0 True) +por.ft (program 1.0.0 True) +por.tt (program 1.0.0 True) +por.ff (program 1.0.0 False) +por.laziness.por (program 1.0.0 (delay True)) +por.laziness.op (program 1.0.0 True) +por.laziness.pand.perror.op.true (program 1.0.0 True) +por.laziness.pand.perror.op.false (program 1.0.0 error) \ No newline at end of file diff --git a/plutarch-test/goldens/bool.uplc.golden b/plutarch-test/goldens/bool.uplc.golden new file mode 100644 index 000000000..b2e70c98a --- /dev/null +++ b/plutarch-test/goldens/bool.uplc.golden @@ -0,0 +1,17 @@ +pnot.lam (program 1.0.0 (\i0 -> force ifThenElse i1 False True)) +pnot.app (program 1.0.0 ((\i0 -> force ifThenElse i1 False True) True)) +pand.tf (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) True (delay False)))) +pand.ft (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) False (delay True)))) +pand.tt (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) True (delay True)))) +pand.ff (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) False (delay False)))) +pand.laziness.pand (program 1.0.0 ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) False (delay error))) +pand.laziness.op (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) False (delay error)))) +pand.laziness.pand.perror.op (program 1.0.0 (force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) True (delay error)))) +por.tf (program 1.0.0 (force ((\i0 -> force ifThenElse i1 (delay True)) True (delay False)))) +por.ft (program 1.0.0 (force ((\i0 -> force ifThenElse i1 (delay True)) False (delay True)))) +por.tt (program 1.0.0 (force ((\i0 -> force ifThenElse i1 (delay True)) True (delay True)))) +por.ff (program 1.0.0 (force ((\i0 -> force ifThenElse i1 (delay True)) False (delay False)))) +por.laziness.por (program 1.0.0 ((\i0 -> force ifThenElse i1 (delay True)) True (delay error))) +por.laziness.op (program 1.0.0 (force ((\i0 -> force ifThenElse i1 (delay True)) True (delay error)))) +por.laziness.pand.perror.op.true (program 1.0.0 (force ((\i0 -> force ifThenElse i1 (delay True)) True (delay error)))) +por.laziness.pand.perror.op.false (program 1.0.0 (force ((\i0 -> force ifThenElse i1 (delay True)) False (delay error)))) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.bench.golden b/plutarch-test/goldens/bytestring.bench.golden new file mode 100644 index 000000000..99da4b615 --- /dev/null +++ b/plutarch-test/goldens/bytestring.bench.golden @@ -0,0 +1,10 @@ +empty {"exBudgetCPU":400935,"exBudgetMemory":901,"scriptSizeBytes":14} +phexByteStr {"exBudgetCPU":400935,"exBudgetMemory":901,"scriptSizeBytes":19} +plengthByteStr {"exBudgetCPU":371033,"exBudgetMemory":811,"scriptSizeBytes":17} +pconsBS {"exBudgetCPU":1099994,"exBudgetMemory":2125,"scriptSizeBytes":33} +pindexByteStr {"exBudgetCPU":172767,"exBudgetMemory":604,"scriptSizeBytes":16} +psliceByteStr {"exBudgetCPU":426418,"exBudgetMemory":804,"scriptSizeBytes":22} +eq {"exBudgetCPU":400935,"exBudgetMemory":901,"scriptSizeBytes":16} +semigroup.concats {"exBudgetCPU":117242,"exBudgetMemory":602,"scriptSizeBytes":17} +semigroup.laws.id.1 {"exBudgetCPU":495077,"exBudgetMemory":1303,"scriptSizeBytes":22} +semigroup.laws.id.2 {"exBudgetCPU":495077,"exBudgetMemory":1303,"scriptSizeBytes":21} \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.eq.bench.golden b/plutarch-test/goldens/bytestring.eq.bench.golden deleted file mode 100644 index 88df2c300..000000000 --- a/plutarch-test/goldens/bytestring.eq.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":351067,"exBudgetMemory":901,"scriptSizeBytes":16} \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.eq.uplc.eval.golden b/plutarch-test/goldens/bytestring.eq.uplc.eval.golden deleted file mode 100644 index 6f6141e6e..000000000 --- a/plutarch-test/goldens/bytestring.eq.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.eq.uplc.golden b/plutarch-test/goldens/bytestring.eq.uplc.golden deleted file mode 100644 index ffa36da0d..000000000 --- a/plutarch-test/goldens/bytestring.eq.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> equalsByteString i1 i1) #12)) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.phexByteStr.bench.golden b/plutarch-test/goldens/bytestring.phexByteStr.bench.golden deleted file mode 100644 index 78caf852c..000000000 --- a/plutarch-test/goldens/bytestring.phexByteStr.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":351067,"exBudgetMemory":901,"scriptSizeBytes":19} \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.pindexByteStr.bench.golden b/plutarch-test/goldens/bytestring.pindexByteStr.bench.golden deleted file mode 100644 index ba7e3d462..000000000 --- a/plutarch-test/goldens/bytestring.pindexByteStr.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":555925,"exBudgetMemory":1002,"scriptSizeBytes":21} \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.pindexByteStr.uplc.eval.golden b/plutarch-test/goldens/bytestring.pindexByteStr.uplc.eval.golden deleted file mode 100644 index 6f6141e6e..000000000 --- a/plutarch-test/goldens/bytestring.pindexByteStr.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.pindexByteStr.uplc.golden b/plutarch-test/goldens/bytestring.pindexByteStr.uplc.golden deleted file mode 100644 index 601ba1807..000000000 --- a/plutarch-test/goldens/bytestring.pindexByteStr.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (equalsInteger (indexByteString #4102af 1) 2)) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.plengthByteStr.bench.golden b/plutarch-test/goldens/bytestring.plengthByteStr.bench.golden deleted file mode 100644 index 04ee115ab..000000000 --- a/plutarch-test/goldens/bytestring.plengthByteStr.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":496379,"exBudgetMemory":805,"scriptSizeBytes":17} \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.bench.golden b/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.bench.golden deleted file mode 100644 index d78a7e10c..000000000 --- a/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":1381637,"exBudgetMemory":2113,"scriptSizeBytes":33} \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.uplc.eval.golden b/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.uplc.eval.golden deleted file mode 100644 index 6f6141e6e..000000000 --- a/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.uplc.golden b/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.uplc.golden deleted file mode 100644 index e45e93136..000000000 --- a/plutarch-test/goldens/bytestring.plengthByteStr.pconsBS.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> equalsInteger (lengthOfByteString (consByteString 91 i1)) (addInteger 1 (lengthOfByteString i1))) #48fcd1)) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.plengthByteStr.uplc.eval.golden b/plutarch-test/goldens/bytestring.plengthByteStr.uplc.eval.golden deleted file mode 100644 index 6f6141e6e..000000000 --- a/plutarch-test/goldens/bytestring.plengthByteStr.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.plengthByteStr.uplc.golden b/plutarch-test/goldens/bytestring.plengthByteStr.uplc.golden deleted file mode 100644 index 45a52a44a..000000000 --- a/plutarch-test/goldens/bytestring.plengthByteStr.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (equalsInteger (lengthOfByteString #012f) 2)) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.psliceByteStr.bench.golden b/plutarch-test/goldens/bytestring.psliceByteStr.bench.golden deleted file mode 100644 index 7c57b7d58..000000000 --- a/plutarch-test/goldens/bytestring.psliceByteStr.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":595386,"exBudgetMemory":1202,"scriptSizeBytes":33} \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.psliceByteStr.uplc.eval.golden b/plutarch-test/goldens/bytestring.psliceByteStr.uplc.eval.golden deleted file mode 100644 index 6f6141e6e..000000000 --- a/plutarch-test/goldens/bytestring.psliceByteStr.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.psliceByteStr.uplc.golden b/plutarch-test/goldens/bytestring.psliceByteStr.uplc.golden deleted file mode 100644 index ba2ca0703..000000000 --- a/plutarch-test/goldens/bytestring.psliceByteStr.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (equalsByteString (sliceByteString 2 3 #4102afde5b2a) #afde5b)) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.semigroup.bench.golden b/plutarch-test/goldens/bytestring.semigroup.bench.golden deleted file mode 100644 index 3e62faa19..000000000 --- a/plutarch-test/goldens/bytestring.semigroup.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":546438,"exBudgetMemory":602,"scriptSizeBytes":17} \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.semigroup.uplc.eval.golden b/plutarch-test/goldens/bytestring.semigroup.uplc.eval.golden deleted file mode 100644 index 1ed73a1ec..000000000 --- a/plutarch-test/goldens/bytestring.semigroup.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 #1234) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.semigroup.uplc.golden b/plutarch-test/goldens/bytestring.semigroup.uplc.golden deleted file mode 100644 index 7de833223..000000000 --- a/plutarch-test/goldens/bytestring.semigroup.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (appendByteString #12 #34)) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.uplc.eval.golden b/plutarch-test/goldens/bytestring.uplc.eval.golden new file mode 100644 index 000000000..f675e1599 --- /dev/null +++ b/plutarch-test/goldens/bytestring.uplc.eval.golden @@ -0,0 +1,10 @@ +empty (program 1.0.0 True) +phexByteStr (program 1.0.0 True) +plengthByteStr (program 1.0.0 True) +pconsBS (program 1.0.0 True) +pindexByteStr (program 1.0.0 2) +psliceByteStr (program 1.0.0 #afde5b) +eq (program 1.0.0 True) +semigroup.concats (program 1.0.0 #1234) +semigroup.laws.id.1 (program 1.0.0 True) +semigroup.laws.id.2 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/bytestring.uplc.golden b/plutarch-test/goldens/bytestring.uplc.golden new file mode 100644 index 000000000..e111d8201 --- /dev/null +++ b/plutarch-test/goldens/bytestring.uplc.golden @@ -0,0 +1,10 @@ +empty (program 1.0.0 ((\i0 -> equalsByteString i1 i1) #)) +phexByteStr (program 1.0.0 ((\i0 -> equalsByteString i1 i1) #42abdfc9)) +plengthByteStr (program 1.0.0 (equalsInteger (lengthOfByteString #012f) 2)) +pconsBS (program 1.0.0 ((\i0 -> equalsInteger (lengthOfByteString (consByteString 91 i1)) (addInteger 1 (lengthOfByteString i1))) #48fcd1)) +pindexByteStr (program 1.0.0 (indexByteString #4102af 1)) +psliceByteStr (program 1.0.0 (sliceByteString 2 3 #4102afde5b2a)) +eq (program 1.0.0 ((\i0 -> equalsByteString i1 i1) #12)) +semigroup.concats (program 1.0.0 (appendByteString #12 #34)) +semigroup.laws.id.1 (program 1.0.0 ((\i0 -> equalsByteString (appendByteString # i1) i1) #12)) +semigroup.laws.id.2 (program 1.0.0 ((\i0 -> equalsByteString i1 (appendByteString # i1)) #12)) \ No newline at end of file diff --git a/plutarch-test/goldens/data-verif.bench.golden b/plutarch-test/goldens/data-verif.bench.golden new file mode 100644 index 000000000..a4bf20d66 --- /dev/null +++ b/plutarch-test/goldens/data-verif.bench.golden @@ -0,0 +1,34 @@ +erroneous.(String, Integer) /= (String, String) {"exBudgetCPU":911716,"exBudgetMemory":612,"scriptSizeBytes":123} +erroneous.[String] /= [Integer] {"exBudgetCPU":467623,"exBudgetMemory":388,"scriptSizeBytes":101} +erroneous.A { test := Integer, test2 := Integer } /= { test := String, test2 := Integer } {"exBudgetCPU":304406,"exBudgetMemory":356,"scriptSizeBytes":153} +erroneous.PDataSum constr 2 {"exBudgetCPU":700994,"exBudgetMemory":230,"scriptSizeBytes":222} +erroneous.PDataSum wrong record type {"exBudgetCPU":990483,"exBudgetMemory":232,"scriptSizeBytes":282} +erroneous.[ByteString] (with length == 2) /= PRational {"exBudgetCPU":1682971,"exBudgetMemory":486,"scriptSizeBytes":210} +erroneous.[Integer] (with length == 0) /= PRational {"exBudgetCPU":125996,"exBudgetMemory":196,"scriptSizeBytes":172} +erroneous.[Integer] (with length == 3) /= PRational {"exBudgetCPU":1872200,"exBudgetMemory":422,"scriptSizeBytes":217} +erroneous.[Integer] (with length == 2, with 0 denominator) /= PRational {"exBudgetCPU":2179266,"exBudgetMemory":456,"scriptSizeBytes":203} +working.(String, String) == (String, String) {"exBudgetCPU":4806613,"exBudgetMemory":14428,"scriptSizeBytes":123} +working.[String] == [String] {"exBudgetCPU":4994603,"exBudgetMemory":16904,"scriptSizeBytes":114} +working.[Integer] (with length == 2) == PRational {"exBudgetCPU":7549502,"exBudgetMemory":19484,"scriptSizeBytes":355} +working.A { test := Integer, test2 := Integer } == { test := Integer, test2 := Integer } {"exBudgetCPU":2950183,"exBudgetMemory":9876,"scriptSizeBytes":147} +working.A { test := Integer, test2 := Integer } == [Integer] {"exBudgetCPU":2950183,"exBudgetMemory":9876,"scriptSizeBytes":147} +working.A { test := String, test2 := Integer } == { test := String, test2 := Integer } {"exBudgetCPU":3007046,"exBudgetMemory":10176,"scriptSizeBytes":153} +working.PDataSum constr 0 {"exBudgetCPU":3276445,"exBudgetMemory":10722,"scriptSizeBytes":282} +working.PDataSum constr 1 {"exBudgetCPU":3841934,"exBudgetMemory":11924,"scriptSizeBytes":282} +working.recover PWrapInt {"exBudgetCPU":460390,"exBudgetMemory":1065,"scriptSizeBytes":15} +recovering a record partially vs completely.partially {"exBudgetCPU":2860826,"exBudgetMemory":9644,"scriptSizeBytes":149} +recovering a record partially vs completely.completely {"exBudgetCPU":3007046,"exBudgetMemory":10176,"scriptSizeBytes":153} +removing the data wrapper.erroneous.(String, Integer) /= (String, String) {"exBudgetCPU":899579,"exBudgetMemory":612,"scriptSizeBytes":117} +removing the data wrapper.erroneous.[String] /= [Integer] {"exBudgetCPU":479760,"exBudgetMemory":388,"scriptSizeBytes":114} +removing the data wrapper.working.(String, String) == (String, String) {"exBudgetCPU":4806613,"exBudgetMemory":14428,"scriptSizeBytes":123} +removing the data wrapper.working.[String] == [String] {"exBudgetCPU":4994603,"exBudgetMemory":16904,"scriptSizeBytes":114} +removing the data wrapper.partial checks.check whole structure {"exBudgetCPU":167380333,"exBudgetMemory":531268,"scriptSizeBytes":1524} +removing the data wrapper.partial checks.check structure partly {"exBudgetCPU":44823600,"exBudgetMemory":145544,"scriptSizeBytes":1494} +removing the data wrapper.recovering a nested record.succeeds {"exBudgetCPU":3700361,"exBudgetMemory":12008,"scriptSizeBytes":167} +removing the data wrapper.recovering a nested record.fails {"exBudgetCPU":419232,"exBudgetMemory":420,"scriptSizeBytes":167} +removing the data wrapper.recovering a nested record.sample usage contains the right value {"exBudgetCPU":3442374,"exBudgetMemory":10849,"scriptSizeBytes":157} +example.concatenate two lists, legal {"exBudgetCPU":40490231,"exBudgetMemory":108115,"scriptSizeBytes":893} +example.concatenate two lists, illegal (list too short) {"exBudgetCPU":34624552,"exBudgetMemory":84921,"scriptSizeBytes":886} +example.concatenate two lists, illegal (wrong elements in list) {"exBudgetCPU":40012573,"exBudgetMemory":105147,"scriptSizeBytes":893} +example.concatenate two lists, illegal (more than one output) {"exBudgetCPU":26315696,"exBudgetMemory":63576,"scriptSizeBytes":914} +example2.recovering a record succeeds {"exBudgetCPU":4617699,"exBudgetMemory":14942,"scriptSizeBytes":366} \ No newline at end of file diff --git a/plutarch-test/goldens/data-verif.uplc.eval.golden b/plutarch-test/goldens/data-verif.uplc.eval.golden new file mode 100644 index 000000000..3c42e3b49 --- /dev/null +++ b/plutarch-test/goldens/data-verif.uplc.eval.golden @@ -0,0 +1,34 @@ +erroneous.(String, Integer) /= (String, String) (program 1.0.0 error) +erroneous.[String] /= [Integer] (program 1.0.0 error) +erroneous.A { test := Integer, test2 := Integer } /= { test := String, test2 := Integer } (program 1.0.0 error) +erroneous.PDataSum constr 2 (program 1.0.0 error) +erroneous.PDataSum wrong record type (program 1.0.0 error) +erroneous.[ByteString] (with length == 2) /= PRational (program 1.0.0 error) +erroneous.[Integer] (with length == 0) /= PRational (program 1.0.0 error) +erroneous.[Integer] (with length == 3) /= PRational (program 1.0.0 error) +erroneous.[Integer] (with length == 2, with 0 denominator) /= PRational (program 1.0.0 error) +working.(String, String) == (String, String) (program 1.0.0 #d8799f43666f6f43626172ff) +working.[String] == [String] (program 1.0.0 #9f43666f6f43626172ff) +working.[Integer] (with length == 2) == PRational (program 1.0.0 ()) +working.A { test := Integer, test2 := Integer } == { test := Integer, test2 := Integer } (program 1.0.0 #9f07182aff) +working.A { test := Integer, test2 := Integer } == [Integer] (program 1.0.0 #9f07182aff) +working.A { test := String, test2 := Integer } == { test := String, test2 := Integer } (program 1.0.0 #9f4362617a182aff) +working.PDataSum constr 0 (program 1.0.0 #d8799f0543666f6fff) +working.PDataSum constr 1 (program 1.0.0 #d87a9f0543666f6fff) +working.recover PWrapInt (program 1.0.0 True) +recovering a record partially vs completely.partially (program 1.0.0 #9f034362617aff) +recovering a record partially vs completely.completely (program 1.0.0 #9f034362617aff) +removing the data wrapper.erroneous.(String, Integer) /= (String, String) (program 1.0.0 error) +removing the data wrapper.erroneous.[String] /= [Integer] (program 1.0.0 error) +removing the data wrapper.working.(String, String) == (String, String) (program 1.0.0 #d8799f43666f6f43626172ff) +removing the data wrapper.working.[String] == [String] (program 1.0.0 #9f43666f6f43626172ff) +removing the data wrapper.partial checks.check whole structure (program 1.0.0 #9f9f9f0102030405060708090a0b0c0d0e0f101112131415161718181819181a181b181c181d181e181f1820182118221823182418251826182718281829182a182b182c182d182e182f1830183118321833183418351836183718381839183a183b183c183d183e183f1840184118421843184418451846184718481849184a184b184c184d184e184f1850185118521853185418551856185718581859185a185b185c185d185e185f18601861186218631864ffffff) +removing the data wrapper.partial checks.check structure partly (program 1.0.0 #9f9f9f0102030405060708090a0b0c0d0e0f101112131415161718181819181a181b181c181d181e181f1820182118221823182418251826182718281829182a182b182c182d182e182f1830183118321833183418351836183718381839183a183b183c183d183e183f1840184118421843184418451846184718481849184a184b184c184d184e184f1850185118521853185418551856185718581859185a185b185c185d185e185f18601861186218631864ffffff) +removing the data wrapper.recovering a nested record.succeeds (program 1.0.0 #9f9f182affff) +removing the data wrapper.recovering a nested record.fails (program 1.0.0 error) +removing the data wrapper.recovering a nested record.sample usage contains the right value (program 1.0.0 True) +example.concatenate two lists, legal (program 1.0.0 ()) +example.concatenate two lists, illegal (list too short) (program 1.0.0 error) +example.concatenate two lists, illegal (wrong elements in list) (program 1.0.0 error) +example.concatenate two lists, illegal (more than one output) (program 1.0.0 error) +example2.recovering a record succeeds (program 1.0.0 #d8799f0443666f6fff) \ No newline at end of file diff --git a/plutarch-test/goldens/data-verif.uplc.golden b/plutarch-test/goldens/data-verif.uplc.golden new file mode 100644 index 000000000..a76911a68 --- /dev/null +++ b/plutarch-test/goldens/data-verif.uplc.golden @@ -0,0 +1,34 @@ +erroneous.(String, Integer) /= (String, String) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i4 (mkPairData (bData i9) (bData i10))) (mkPairData ((\i0 -> i5 i2) (unIData (i4 i1))) ((\i0 -> i7 i2) (unBData (i6 i1))))) ((\i0 -> (\i0 -> mkPairData (i3 i1) (i3 (force tailList i1))) (i6 (unConstrData i1))) (i2 (mkPairData (bData i7) (bData i8))))) (force headList)) (\i0 -> constrData 0 (i3 (i2 i1) (i3 (i4 i1) i5)))) (force (force fstPair))) (force mkCons)) (force (force sndPair))) [ ]) #666f6f) #626172)) +erroneous.[String] /= [Integer] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i3 (iData 3) (i2 (iData 4)))) ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i6) (delay (i5 (i3 (force headList i1)) (i2 (force tailList i1))))))) (\i0 -> (\i0 -> i2) (unBData i1)) (unListData (listData (i2 (iData 3) (i1 (iData 4))))))) (\i0 -> i2 i1 i3)) (force mkCons)) [ ])) +erroneous.A { test := Integer, test2 := Integer } /= { test := String, test2 := Integer } (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i12 (bData i11) (i12 (iData 42) i13))) (force (force (force chooseList) i1 (delay ()) (delay (force (force trace "ptryFrom(PDataRecord[]): list is longer than zero" (delay error))))))) (i7 i3)) (unIData i1)) (i6 i1)) (i4 i3)) (unIData i1)) (i3 i1)) (unListData (listData (i4 (bData i3) (i4 (iData 42) i5))))) (force tailList)) (force headList)) #62617a) (force mkCons)) [ ])) +erroneous.PDataSum constr 2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i8) (force (force ifThenElse (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (force (force chooseList) i1 (delay ()) (delay (force (i12 "ptryFrom(PDataRecord[]): list is longer than zero" (delay error))))))) (i9 i3)) (unBData i1)) (i8 i1)) (i6 i3)) (unIData i1)) (i5 i1))) (delay (force (i6 "reached end of sum while still not having found the constructor" (delay error))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i4)) (force tailList)) (force headList)) (force trace)) #d87a9f0543666f6fff)) +erroneous.PDataSum wrong record type (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i11) (force (i4 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (i11 i1 (delay ()) (delay (force (i15 i12 (delay error))))))) (i12 i3)) (unBData i1)) (i11 i1)) (i9 i3)) (unIData i1)) (i8 i1))) (delay (force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (i11 i1 (delay ()) (delay (force (i15 i12 (delay error))))))) (i12 i3)) (unBData i1)) (i11 i1)) (i9 i3)) (unBData i1)) (i8 i1))) (delay (force (i9 "reached end of sum while still not having found the constructor" (delay error)))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i7)) (force ifThenElse)) (force (force chooseList))) "ptryFrom(PDataRecord[]): list is longer than zero") (force tailList)) (force headList)) (force trace)) #d87b9f0543666f6fff)) +erroneous.[ByteString] (with length == 2) /= PRational (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i3 (equalsData (listData (i5 i1)) (listData i9)) (delay ((\i0 -> (\i0 -> listData (i9 (bData i8) (i9 (bData i10) i11))) (force (i4 (lessThanEqualsInteger i1 0) (delay (force (i5 "ptryPositive: building with non positive" (delay error)))) (delay i1)))) (unIData (force headList i1)))) (delay (force (i4 "ptryFrom(PRational): data list length should be 2" (delay error)))))) (i4 i1)) (unListData (listData (i5 (bData i4) (i5 (bData i6) i7))))) (force ifThenElse)) (force trace)) (force tailList)) #41) (force mkCons)) #2b) [ ])) +erroneous.[Integer] (with length == 0) /= PRational (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i3 (equalsData (listData (i5 i1)) (listData i6)) (delay ((\i0 -> (\i0 -> listData i8) (force (i4 (lessThanEqualsInteger i1 0) (delay (force (i5 "ptryPositive: building with non positive" (delay error)))) (delay i1)))) (unIData (force headList i1)))) (delay (force (i4 "ptryFrom(PRational): data list length should be 2" (delay error)))))) (i4 i1)) (unListData (listData i4))) (force ifThenElse)) (force trace)) (force tailList)) [ ])) +erroneous.[Integer] (with length == 3) /= PRational (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i3 (equalsData (listData (i5 i1)) (listData i10)) (delay ((\i0 -> (\i0 -> listData (i10 i8 (i10 i9 (i10 i11 i12)))) (force (i4 (lessThanEqualsInteger i1 0) (delay (force (i5 "ptryPositive: building with non positive" (delay error)))) (delay i1)))) (unIData (force headList i1)))) (delay (force (i4 "ptryFrom(PRational): data list length should be 2" (delay error)))))) (i4 i1)) (unListData (listData (i6 i4 (i6 i5 (i6 i7 i8)))))) (force ifThenElse)) (force trace)) (force tailList)) #182a) #07) (force mkCons)) #00) [ ])) +erroneous.[Integer] (with length == 2, with 0 denominator) /= PRational (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i3 (equalsData (listData (i5 i1)) (listData i9)) (delay ((\i0 -> (\i0 -> listData (i9 i8 (i9 i10 i11))) (force (i4 (lessThanEqualsInteger i1 0) (delay (force (i5 "ptryPositive: building with non positive" (delay error)))) (delay i1)))) (unIData (force headList i1)))) (delay (force (i4 "ptryFrom(PRational): data list length should be 2" (delay error)))))) (i4 i1)) (unListData (listData (i5 i4 (i5 i6 i7))))) (force ifThenElse)) (force trace)) (force tailList)) #182a) (force mkCons)) #00) [ ])) +working.(String, String) == (String, String) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i4 (mkPairData (bData i9) (bData i10))) (mkPairData ((\i0 -> i5 i2) (unBData (i4 i1))) ((\i0 -> i7 i2) (unBData (i6 i1))))) ((\i0 -> (\i0 -> mkPairData (i3 i1) (i3 (force tailList i1))) (i6 (unConstrData i1))) (i2 (mkPairData (bData i7) (bData i8))))) (force headList)) (\i0 -> constrData 0 (i3 (i2 i1) (i3 (i4 i1) i5)))) (force (force fstPair))) (force mkCons)) (force (force sndPair))) [ ]) #666f6f) #626172)) +working.[String] == [String] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i4 (bData i2) (i3 (bData i6)))) ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i7) (delay (i6 (i3 (force headList i1)) (i2 (force tailList i1))))))) (\i0 -> (\i0 -> i2) (unBData i1)) (unListData (listData (i3 (bData i1) (i2 (bData i5))))))) #666f6f) (\i0 -> i2 i1 i3)) (force mkCons)) [ ]) #626172)) +working.[Integer] (with length == 2) == PRational (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i3 (equalsData (listData (i6 i1)) (listData i10)) (delay ((\i0 -> (\i0 -> force (i5 (equalsInteger i1 (unIData i11)) (delay (force (i5 ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> equalsInteger (multiplyInteger i1 i4) (multiplyInteger i2 i3)))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (unIData (i9 (i11 i2)))) (unIData (i8 i1))) (unListData i1)) (listData (i10 i9 (i10 i11 i12)))) ((\i0 -> \i0 -> i1 i2 i3) (unIData i9))) (delay ()) (delay (force (i7 "drat should be as expected" (delay error))))))) (delay (force (i7 "non-zero should be as expected" (delay error)))))) (force (i4 (lessThanEqualsInteger i1 0) (delay (force (i6 "ptryPositive: building with non positive" (delay error)))) (delay i1)))) (unIData (i4 i1)))) (delay (force (i5 "ptryFrom(PRational): data list length should be 2" (delay error)))))) (i5 i1)) (unListData (listData (i6 i5 (i6 i7 i8))))) (force ifThenElse)) (force headList)) (force trace)) (force tailList)) #182a) (force mkCons)) #181f) [ ])) +working.A { test := Integer, test2 := Integer } == { test := Integer, test2 := Integer } (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i11 (iData 7) (i11 (iData 42) i12))) (force (force (force chooseList) i1 (delay ()) (delay (force (force trace "ptryFrom(PDataRecord[]): list is longer than zero" (delay error))))))) (i7 i3)) (unIData i1)) (i6 i1)) (i4 i3)) (unIData i1)) (i3 i1)) (unListData (listData (i3 (iData 7) (i3 (iData 42) i4))))) (force tailList)) (force headList)) (force mkCons)) [ ])) +working.A { test := Integer, test2 := Integer } == [Integer] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i11 (iData 7) (i11 (iData 42) i12))) (force (force (force chooseList) i1 (delay ()) (delay (force (force trace "ptryFrom(PDataRecord[]): list is longer than zero" (delay error))))))) (i7 i3)) (unIData i1)) (i6 i1)) (i4 i3)) (unIData i1)) (i3 i1)) (unListData (listData (i3 (iData 7) (i3 (iData 42) i4))))) (force tailList)) (force headList)) (force mkCons)) [ ])) +working.A { test := String, test2 := Integer } == { test := String, test2 := Integer } (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i12 (bData i11) (i12 (iData 42) i13))) (force (force (force chooseList) i1 (delay ()) (delay (force (force trace "ptryFrom(PDataRecord[]): list is longer than zero" (delay error))))))) (i7 i3)) (unIData i1)) (i6 i1)) (i4 i3)) (unBData i1)) (i3 i1)) (unListData (listData (i4 (bData i3) (i4 (iData 42) i5))))) (force tailList)) (force headList)) #62617a) (force mkCons)) [ ])) +working.PDataSum constr 0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i11) (force (i4 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (i11 i1 (delay ()) (delay (force (i15 i12 (delay error))))))) (i12 i3)) (unBData i1)) (i11 i1)) (i9 i3)) (unIData i1)) (i8 i1))) (delay (force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (i11 i1 (delay ()) (delay (force (i15 i12 (delay error))))))) (i12 i3)) (unBData i1)) (i11 i1)) (i9 i3)) (unIData i1)) (i8 i1))) (delay (force (i9 "reached end of sum while still not having found the constructor" (delay error)))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i7)) (force ifThenElse)) (force (force chooseList))) "ptryFrom(PDataRecord[]): list is longer than zero") (force tailList)) (force headList)) (force trace)) #d8799f0543666f6fff)) +working.PDataSum constr 1 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i11) (force (i4 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (i11 i1 (delay ()) (delay (force (i15 i12 (delay error))))))) (i12 i3)) (unBData i1)) (i11 i1)) (i9 i3)) (unIData i1)) (i8 i1))) (delay (force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (i11 i1 (delay ()) (delay (force (i15 i12 (delay error))))))) (i12 i3)) (unBData i1)) (i11 i1)) (i9 i3)) (unIData i1)) (i8 i1))) (delay (force (i9 "reached end of sum while still not having found the constructor" (delay error)))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i7)) (force ifThenElse)) (force (force chooseList))) "ptryFrom(PDataRecord[]): list is longer than zero") (force tailList)) (force headList)) (force trace)) #d87a9f0543666f6fff)) +working.recover PWrapInt (program 1.0.0 (equalsInteger 42 (unIData (iData 42)))) +recovering a record partially vs completely.partially (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i10 (iData 3) (i10 (bData i11) i12))) (force (force (force chooseList) i1 (delay ()) (delay (force (force trace "ptryFrom(PDataRecord[]): list is longer than zero" (delay error))))))) (i6 i2)) (i6 i1)) (i4 i3)) (unIData i1)) (i3 i1)) (unListData (listData (i3 (iData 3) (i3 (bData i4) i5))))) (force tailList)) (force headList)) (force mkCons)) #62617a) [ ])) +recovering a record partially vs completely.completely (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i11 (iData 3) (i11 (bData i12) i13))) (force (force (force chooseList) i1 (delay ()) (delay (force (force trace "ptryFrom(PDataRecord[]): list is longer than zero" (delay error))))))) (i7 i3)) (unBData i1)) (i6 i1)) (i4 i3)) (unIData i1)) (i3 i1)) (unListData (listData (i3 (iData 3) (i3 (bData i4) i5))))) (force tailList)) (force headList)) (force mkCons)) #62617a) [ ])) +removing the data wrapper.erroneous.(String, Integer) /= (String, String) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i4 (mkPairData (iData 42) (bData i9))) (mkPairData ((\i0 -> i5 i2) (unBData (i4 i1))) ((\i0 -> i7 i2) (unBData (i6 i1))))) ((\i0 -> (\i0 -> mkPairData (i3 i1) (i3 (force tailList i1))) (i6 (unConstrData i1))) (i2 (mkPairData (iData 42) (bData i7))))) (force headList)) (\i0 -> constrData 0 (i3 (i2 i1) (i3 (i4 i1) i5)))) (force (force fstPair))) (force mkCons)) (force (force sndPair))) [ ]) #626172)) +removing the data wrapper.erroneous.[String] /= [Integer] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i4 (bData i2) (i3 (bData i6)))) ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i7) (delay (i6 (i3 (force headList i1)) (i2 (force tailList i1))))))) (\i0 -> (\i0 -> i2) (unIData i1)) (unListData (listData (i3 (bData i1) (i2 (bData i5))))))) #666f6f) (\i0 -> i2 i1 i3)) (force mkCons)) [ ]) #62617a)) +removing the data wrapper.working.(String, String) == (String, String) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i4 (mkPairData (bData i9) (bData i10))) (mkPairData ((\i0 -> i5 i2) (unBData (i4 i1))) ((\i0 -> i7 i2) (unBData (i6 i1))))) ((\i0 -> (\i0 -> mkPairData (i3 i1) (i3 (force tailList i1))) (i6 (unConstrData i1))) (i2 (mkPairData (bData i7) (bData i8))))) (force headList)) (\i0 -> constrData 0 (i3 (i2 i1) (i3 (i4 i1) i5)))) (force (force fstPair))) (force mkCons)) (force (force sndPair))) [ ]) #666f6f) #626172)) +removing the data wrapper.working.[String] == [String] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i4 (bData i2) (i3 (bData i6)))) ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i7) (delay (i6 (i3 (force headList i1)) (i2 (force tailList i1))))))) (\i0 -> (\i0 -> i2) (unBData i1)) (unListData (listData (i3 (bData i1) (i2 (bData i5))))))) #666f6f) (\i0 -> i2 i1 i3)) (force mkCons)) [ ]) #626172)) +removing the data wrapper.partial checks.check whole structure (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i7 (listData (i7 (listData (i8 (iData 1) (i8 (iData 2) (i8 (iData 3) (i8 (iData 4) (i8 (iData 5) (i8 (iData 6) (i8 (iData 7) (i8 (iData 8) (i8 (iData 9) (i8 (iData 10) (i8 (iData 11) (i8 (iData 12) (i8 (iData 13) (i8 (iData 14) (i8 (iData 15) (i8 (iData 16) (i8 (iData 17) (i8 (iData 18) (i8 (iData 19) (i8 (iData 20) (i8 (iData 21) (i8 (iData 22) (i8 (iData 23) (i8 (iData 24) (i8 (iData 25) (i8 (iData 26) (i8 (iData 27) (i8 (iData 28) (i8 (iData 29) (i8 (iData 30) (i8 (iData 31) (i8 (iData 32) (i8 (iData 33) (i8 (iData 34) (i8 (iData 35) (i8 (iData 36) (i8 (iData 37) (i8 (iData 38) (i8 (iData 39) (i8 (iData 40) (i8 (iData 41) (i8 (iData 42) (i8 (iData 43) (i8 (iData 44) (i8 (iData 45) (i8 (iData 46) (i8 (iData 47) (i8 (iData 48) (i8 (iData 49) (i8 (iData 50) (i8 (iData 51) (i8 (iData 52) (i8 (iData 53) (i8 (iData 54) (i8 (iData 55) (i8 (iData 56) (i8 (iData 57) (i8 (iData 58) (i8 (iData 59) (i8 (iData 60) (i8 (iData 61) (i8 (iData 62) (i8 (iData 63) (i8 (iData 64) (i8 (iData 65) (i8 (iData 66) (i8 (iData 67) (i8 (iData 68) (i8 (iData 69) (i8 (iData 70) (i8 (iData 71) (i8 (iData 72) (i8 (iData 73) (i8 (iData 74) (i8 (iData 75) (i8 (iData 76) (i8 (iData 77) (i8 (iData 78) (i8 (iData 79) (i8 (iData 80) (i8 (iData 81) (i8 (iData 82) (i8 (iData 83) (i8 (iData 84) (i8 (iData 85) (i8 (iData 86) (i8 (iData 87) (i8 (iData 88) (i8 (iData 89) (i8 (iData 90) (i8 (iData 91) (i8 (iData 92) (i8 (iData 93) (i8 (iData 94) (i8 (iData 95) (i8 (iData 96) (i8 (iData 97) (i8 (iData 98) (i8 (iData 99) (i8 (iData 100) i9))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (i1 (\i0 -> (\i0 -> i2) (i2 (\i0 -> (\i0 -> i2) (i3 (\i0 -> (\i0 -> i2) (unIData i1)) (unListData i1))) (unListData i1))) (unListData (listData (i6 (listData (i6 (listData (i7 (iData 1) (i7 (iData 2) (i7 (iData 3) (i7 (iData 4) (i7 (iData 5) (i7 (iData 6) (i7 (iData 7) (i7 (iData 8) (i7 (iData 9) (i7 (iData 10) (i7 (iData 11) (i7 (iData 12) (i7 (iData 13) (i7 (iData 14) (i7 (iData 15) (i7 (iData 16) (i7 (iData 17) (i7 (iData 18) (i7 (iData 19) (i7 (iData 20) (i7 (iData 21) (i7 (iData 22) (i7 (iData 23) (i7 (iData 24) (i7 (iData 25) (i7 (iData 26) (i7 (iData 27) (i7 (iData 28) (i7 (iData 29) (i7 (iData 30) (i7 (iData 31) (i7 (iData 32) (i7 (iData 33) (i7 (iData 34) (i7 (iData 35) (i7 (iData 36) (i7 (iData 37) (i7 (iData 38) (i7 (iData 39) (i7 (iData 40) (i7 (iData 41) (i7 (iData 42) (i7 (iData 43) (i7 (iData 44) (i7 (iData 45) (i7 (iData 46) (i7 (iData 47) (i7 (iData 48) (i7 (iData 49) (i7 (iData 50) (i7 (iData 51) (i7 (iData 52) (i7 (iData 53) (i7 (iData 54) (i7 (iData 55) (i7 (iData 56) (i7 (iData 57) (i7 (iData 58) (i7 (iData 59) (i7 (iData 60) (i7 (iData 61) (i7 (iData 62) (i7 (iData 63) (i7 (iData 64) (i7 (iData 65) (i7 (iData 66) (i7 (iData 67) (i7 (iData 68) (i7 (iData 69) (i7 (iData 70) (i7 (iData 71) (i7 (iData 72) (i7 (iData 73) (i7 (iData 74) (i7 (iData 75) (i7 (iData 76) (i7 (iData 77) (i7 (iData 78) (i7 (iData 79) (i7 (iData 80) (i7 (iData 81) (i7 (iData 82) (i7 (iData 83) (i7 (iData 84) (i7 (iData 85) (i7 (iData 86) (i7 (iData 87) (i7 (iData 88) (i7 (iData 89) (i7 (iData 90) (i7 (iData 91) (i7 (iData 92) (i7 (iData 93) (i7 (iData 94) (i7 (iData 95) (i7 (iData 96) (i7 (iData 97) (i7 (iData 98) (i7 (iData 99) (i7 (iData 100) i8)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (\i0 -> i2 (\i0 -> \i0 -> force (i5 i1 (delay i10) (delay (i9 (i3 (i6 i1)) (i2 (i7 i1)))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force headList)) (force tailList)) (\i0 -> i2 i1 i3)) (force mkCons)) [ ])) +removing the data wrapper.partial checks.check structure partly (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i2 (listData (i2 (listData (i3 (iData 1) (i3 (iData 2) (i3 (iData 3) (i3 (iData 4) (i3 (iData 5) (i3 (iData 6) (i3 (iData 7) (i3 (iData 8) (i3 (iData 9) (i3 (iData 10) (i3 (iData 11) (i3 (iData 12) (i3 (iData 13) (i3 (iData 14) (i3 (iData 15) (i3 (iData 16) (i3 (iData 17) (i3 (iData 18) (i3 (iData 19) (i3 (iData 20) (i3 (iData 21) (i3 (iData 22) (i3 (iData 23) (i3 (iData 24) (i3 (iData 25) (i3 (iData 26) (i3 (iData 27) (i3 (iData 28) (i3 (iData 29) (i3 (iData 30) (i3 (iData 31) (i3 (iData 32) (i3 (iData 33) (i3 (iData 34) (i3 (iData 35) (i3 (iData 36) (i3 (iData 37) (i3 (iData 38) (i3 (iData 39) (i3 (iData 40) (i3 (iData 41) (i3 (iData 42) (i3 (iData 43) (i3 (iData 44) (i3 (iData 45) (i3 (iData 46) (i3 (iData 47) (i3 (iData 48) (i3 (iData 49) (i3 (iData 50) (i3 (iData 51) (i3 (iData 52) (i3 (iData 53) (i3 (iData 54) (i3 (iData 55) (i3 (iData 56) (i3 (iData 57) (i3 (iData 58) (i3 (iData 59) (i3 (iData 60) (i3 (iData 61) (i3 (iData 62) (i3 (iData 63) (i3 (iData 64) (i3 (iData 65) (i3 (iData 66) (i3 (iData 67) (i3 (iData 68) (i3 (iData 69) (i3 (iData 70) (i3 (iData 71) (i3 (iData 72) (i3 (iData 73) (i3 (iData 74) (i3 (iData 75) (i3 (iData 76) (i3 (iData 77) (i3 (iData 78) (i3 (iData 79) (i3 (iData 80) (i3 (iData 81) (i3 (iData 82) (i3 (iData 83) (i3 (iData 84) (i3 (iData 85) (i3 (iData 86) (i3 (iData 87) (i3 (iData 88) (i3 (iData 89) (i3 (iData 90) (i3 (iData 91) (i3 (iData 92) (i3 (iData 93) (i3 (iData 94) (i3 (iData 95) (i3 (iData 96) (i3 (iData 97) (i3 (iData 98) (i3 (iData 99) (i3 (iData 100) i4))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay i6) (delay (i5 (i3 (force headList i1)) (i2 (force tailList i1))))))) (\i0 -> (\i0 -> i2) (unListData i1)) (unListData (listData (i1 (listData (i1 (listData (i2 (iData 1) (i2 (iData 2) (i2 (iData 3) (i2 (iData 4) (i2 (iData 5) (i2 (iData 6) (i2 (iData 7) (i2 (iData 8) (i2 (iData 9) (i2 (iData 10) (i2 (iData 11) (i2 (iData 12) (i2 (iData 13) (i2 (iData 14) (i2 (iData 15) (i2 (iData 16) (i2 (iData 17) (i2 (iData 18) (i2 (iData 19) (i2 (iData 20) (i2 (iData 21) (i2 (iData 22) (i2 (iData 23) (i2 (iData 24) (i2 (iData 25) (i2 (iData 26) (i2 (iData 27) (i2 (iData 28) (i2 (iData 29) (i2 (iData 30) (i2 (iData 31) (i2 (iData 32) (i2 (iData 33) (i2 (iData 34) (i2 (iData 35) (i2 (iData 36) (i2 (iData 37) (i2 (iData 38) (i2 (iData 39) (i2 (iData 40) (i2 (iData 41) (i2 (iData 42) (i2 (iData 43) (i2 (iData 44) (i2 (iData 45) (i2 (iData 46) (i2 (iData 47) (i2 (iData 48) (i2 (iData 49) (i2 (iData 50) (i2 (iData 51) (i2 (iData 52) (i2 (iData 53) (i2 (iData 54) (i2 (iData 55) (i2 (iData 56) (i2 (iData 57) (i2 (iData 58) (i2 (iData 59) (i2 (iData 60) (i2 (iData 61) (i2 (iData 62) (i2 (iData 63) (i2 (iData 64) (i2 (iData 65) (i2 (iData 66) (i2 (iData 67) (i2 (iData 68) (i2 (iData 69) (i2 (iData 70) (i2 (iData 71) (i2 (iData 72) (i2 (iData 73) (i2 (iData 74) (i2 (iData 75) (i2 (iData 76) (i2 (iData 77) (i2 (iData 78) (i2 (iData 79) (i2 (iData 80) (i2 (iData 81) (i2 (iData 82) (i2 (iData 83) (i2 (iData 84) (i2 (iData 85) (i2 (iData 86) (i2 (iData 87) (i2 (iData 88) (i2 (iData 89) (i2 (iData 90) (i2 (iData 91) (i2 (iData 92) (i2 (iData 93) (i2 (iData 94) (i2 (iData 95) (i2 (iData 96) (i2 (iData 97) (i2 (iData 98) (i2 (iData 99) (i2 (iData 100) i3)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (\i0 -> i2 i1 i3)) (force mkCons)) [ ])) +removing the data wrapper.recovering a nested record.succeeds (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i15 (listData (i15 (iData 42) i16)) i16)) (force (i9 i1 (delay ()) (delay (force (i10 i11 (delay error))))))) (i11 i7)) (force (i7 i1 (delay ()) (delay (force (i8 i9 (delay error))))))) (i9 i3)) (unIData i1)) (i8 i1)) (unListData i1)) (i6 i1)) (unListData (listData (i6 (listData (i6 (iData 42) i7)) i7)))) (force (force chooseList))) (force trace)) "ptryFrom(PDataRecord[]): list is longer than zero") (force tailList)) (force headList)) (force mkCons)) [ ])) +removing the data wrapper.recovering a nested record.fails (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> listData (i15 (listData (i15 (iData 42) i16)) i16)) (force (i9 i1 (delay ()) (delay (force (i10 i11 (delay error))))))) (i11 i7)) (force (i7 i1 (delay ()) (delay (force (i8 i9 (delay error))))))) (i9 i3)) (unBData i1)) (i8 i1)) (unListData i1)) (i6 i1)) (unListData (listData (i6 (listData (i6 (iData 42) i7)) i7)))) (force (force chooseList))) (force trace)) "ptryFrom(PDataRecord[]): list is longer than zero") (force tailList)) (force headList)) (force mkCons)) [ ])) +removing the data wrapper.recovering a nested record.sample usage contains the right value (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> equalsInteger 42 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i5) (force (i9 i1 (delay ()) (delay (force (i10 i11 (delay error))))))) (i11 i7)) (force (i7 i1 (delay ()) (delay (force (i8 i9 (delay error))))))) (i9 i3)) (unIData i1)) (i8 i1)) (unListData i1)) (i6 i1)) (unListData (listData (i6 (listData (i6 (iData 42) i7)) i7))))) (force (force chooseList))) (force trace)) "ptryFrom(PDataRecord[]): list is longer than zero") (force tailList)) (force headList)) (force mkCons)) [ ])) +example.concatenate two lists, legal (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i18 (equalsInteger 1 i2) (delay (i14 (\i0 -> \i0 -> \i0 -> force (i18 i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (i21 (i2 (i19 i1)) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (i19 i1))) (delay (i3 i2 (i20 i1)))))))) (\i0 -> (\i0 -> \i0 -> equalsData (listData (i15 i2)) (listData (i15 i1))) (i17 i2) (i17 (i13 i1))) ((\i0 -> unListData (i17 (i13 i1))) (i16 i4)))) (delay (force (i19 i11 (delay error)))))) (i12 i2)) (i8 i1)) (unConstrData (i13 (i14 i1)))) (i8 i3) (\i0 -> (\i0 -> force (i16 (force (i16 (force nullList (i15 ((\i0 -> i13 (\i0 -> \i0 -> force (i16 i1 (delay i22) (delay ((\i0 -> force (i20 (i4 i1) (delay (i22 i1 (i3 (i19 i2)))) (delay (i3 (i19 i2))))) (i17 i1)))))) (\i0 -> equalsData (i15 (i11 i1)) (i15 i2)) (unListData (i14 (i15 (i10 i3))))))) (delay (equalsData (i14 (i12 (\i0 -> \i0 -> force (i15 i1 (delay i21) (delay ((\i0 -> force (i20 "iteration" (delay (force (i19 (equalsByteString (unBData (i17 i1)) ((\i0 -> (\i0 -> (\i0 -> force (i22 (equalsInteger 0 i2) (delay (unBData (i20 i1))) (delay (force (i23 i15 (delay error)))))) (i16 i2)) (i12 i1)) (unConstrData (i17 (i18 (i18 i4)))))) (delay (force (i20 "appended something" (delay i21)) (i17 (i18 i1)) (i3 (i18 i2)))) (delay (force (i20 "called without appending" (delay i3)) (i18 i2)))))))) (i12 (i16 i1)))))) (unListData (i14 ((\i0 -> i16 (i16 (i16 (i16 (i16 (i16 (i16 (i16 i1)))))))) (i10 i3)))))) (listData ((\i0 -> \i0 -> i14 (\i0 -> \i0 -> force (i17 i1 (delay i3) (delay (i22 (i18 i1) (i2 (i19 i1)))))) i2) (unListData i7) i4)))) (delay False))) (delay ()) (delay (force (i17 "not valid" (delay error)))))) (i9 (i13 (i14 (i9 i1))))) (delay (force (i15 i7 (delay error))))) (i11 (i7 i2))) ((\i0 -> i9 (\i0 -> \i0 -> force (i12 i1 (delay i18) (delay (i17 (i3 (i13 i1)) (i2 (i14 i1))))))) (\i0 -> (\i0 -> (\i0 -> i3) (force (i14 (lessThanInteger i1 0) (delay (force (i15 "could not make natural" (delay error)))) (delay i1)))) (unIData i1)) (unListData i2))) (listData (i11 (iData 1) (i11 (iData 2) (i11 (iData 3) (i11 (iData 4) (i11 (iData 5) i12)))))) (listData (i11 (iData 6) (i11 (iData 7) (i11 (iData 8) (i11 (iData 9) (i11 (iData 10) i12)))))) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff9fd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffa0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff9fd8799f41d09f0102030405060708090affffffd8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force (force fstPair))) "Pattern matching failure in TermCont") (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force headList)) (force tailList)) (force ifThenElse)) (force trace)) (force mkCons)) [ ])) +example.concatenate two lists, illegal (list too short) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i18 (equalsInteger 1 i2) (delay (i14 (\i0 -> \i0 -> \i0 -> force (i18 i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (i21 (i2 (i19 i1)) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (i19 i1))) (delay (i3 i2 (i20 i1)))))))) (\i0 -> (\i0 -> \i0 -> equalsData (listData (i15 i2)) (listData (i15 i1))) (i17 i2) (i17 (i13 i1))) ((\i0 -> unListData (i17 (i13 i1))) (i16 i4)))) (delay (force (i19 i11 (delay error)))))) (i12 i2)) (i8 i1)) (unConstrData (i13 (i14 i1)))) (i8 i3) (\i0 -> (\i0 -> force (i16 (force (i16 (force nullList (i15 ((\i0 -> i13 (\i0 -> \i0 -> force (i16 i1 (delay i22) (delay ((\i0 -> force (i20 (i4 i1) (delay (i22 i1 (i3 (i19 i2)))) (delay (i3 (i19 i2))))) (i17 i1)))))) (\i0 -> equalsData (i15 (i11 i1)) (i15 i2)) (unListData (i14 (i15 (i10 i3))))))) (delay (equalsData (i14 (i12 (\i0 -> \i0 -> force (i15 i1 (delay i21) (delay ((\i0 -> force (i20 "iteration" (delay (force (i19 (equalsByteString (unBData (i17 i1)) ((\i0 -> (\i0 -> (\i0 -> force (i22 (equalsInteger 0 i2) (delay (unBData (i20 i1))) (delay (force (i23 i15 (delay error)))))) (i16 i2)) (i12 i1)) (unConstrData (i17 (i18 (i18 i4)))))) (delay (force (i20 "appended something" (delay i21)) (i17 (i18 i1)) (i3 (i18 i2)))) (delay (force (i20 "called without appending" (delay i3)) (i18 i2)))))))) (i12 (i16 i1)))))) (unListData (i14 ((\i0 -> i16 (i16 (i16 (i16 (i16 (i16 (i16 (i16 i1)))))))) (i10 i3)))))) (listData ((\i0 -> \i0 -> i14 (\i0 -> \i0 -> force (i17 i1 (delay i3) (delay (i22 (i18 i1) (i2 (i19 i1)))))) i2) (unListData i7) i4)))) (delay False))) (delay ()) (delay (force (i17 "not valid" (delay error)))))) (i9 (i13 (i14 (i9 i1))))) (delay (force (i15 i7 (delay error))))) (i11 (i7 i2))) ((\i0 -> i9 (\i0 -> \i0 -> force (i12 i1 (delay i18) (delay (i17 (i3 (i13 i1)) (i2 (i14 i1))))))) (\i0 -> (\i0 -> (\i0 -> i3) (force (i14 (lessThanInteger i1 0) (delay (force (i15 "could not make natural" (delay error)))) (delay i1)))) (unIData i1)) (unListData i2))) (listData (i11 (iData 1) (i11 (iData 2) (i11 (iData 3) (i11 (iData 4) (i11 (iData 5) i12)))))) (listData (i11 (iData 6) (i11 (iData 7) (i11 (iData 8) (i11 (iData 9) i12))))) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff9fd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffa0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff9fd8799f41d09f0102030405060708090affffffd8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force (force fstPair))) "Pattern matching failure in TermCont") (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force headList)) (force tailList)) (force ifThenElse)) (force trace)) (force mkCons)) [ ])) +example.concatenate two lists, illegal (wrong elements in list) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i18 (equalsInteger 1 i2) (delay (i14 (\i0 -> \i0 -> \i0 -> force (i18 i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (i21 (i2 (i19 i1)) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (i19 i1))) (delay (i3 i2 (i20 i1)))))))) (\i0 -> (\i0 -> \i0 -> equalsData (listData (i15 i2)) (listData (i15 i1))) (i17 i2) (i17 (i13 i1))) ((\i0 -> unListData (i17 (i13 i1))) (i16 i4)))) (delay (force (i19 i11 (delay error)))))) (i12 i2)) (i8 i1)) (unConstrData (i13 (i14 i1)))) (i8 i3) (\i0 -> (\i0 -> force (i16 (force (i16 (force nullList (i15 ((\i0 -> i13 (\i0 -> \i0 -> force (i16 i1 (delay i22) (delay ((\i0 -> force (i20 (i4 i1) (delay (i22 i1 (i3 (i19 i2)))) (delay (i3 (i19 i2))))) (i17 i1)))))) (\i0 -> equalsData (i15 (i11 i1)) (i15 i2)) (unListData (i14 (i15 (i10 i3))))))) (delay (equalsData (i14 (i12 (\i0 -> \i0 -> force (i15 i1 (delay i21) (delay ((\i0 -> force (i20 "iteration" (delay (force (i19 (equalsByteString (unBData (i17 i1)) ((\i0 -> (\i0 -> (\i0 -> force (i22 (equalsInteger 0 i2) (delay (unBData (i20 i1))) (delay (force (i23 i15 (delay error)))))) (i16 i2)) (i12 i1)) (unConstrData (i17 (i18 (i18 i4)))))) (delay (force (i20 "appended something" (delay i21)) (i17 (i18 i1)) (i3 (i18 i2)))) (delay (force (i20 "called without appending" (delay i3)) (i18 i2)))))))) (i12 (i16 i1)))))) (unListData (i14 ((\i0 -> i16 (i16 (i16 (i16 (i16 (i16 (i16 (i16 i1)))))))) (i10 i3)))))) (listData ((\i0 -> \i0 -> i14 (\i0 -> \i0 -> force (i17 i1 (delay i3) (delay (i22 (i18 i1) (i2 (i19 i1)))))) i2) (unListData i7) i4)))) (delay False))) (delay ()) (delay (force (i17 "not valid" (delay error)))))) (i9 (i13 (i14 (i9 i1))))) (delay (force (i15 i7 (delay error))))) (i11 (i7 i2))) ((\i0 -> i9 (\i0 -> \i0 -> force (i12 i1 (delay i18) (delay (i17 (i3 (i13 i1)) (i2 (i14 i1))))))) (\i0 -> (\i0 -> (\i0 -> i3) (force (i14 (lessThanInteger i1 0) (delay (force (i15 "could not make natural" (delay error)))) (delay i1)))) (unIData i1)) (unListData i2))) (listData (i11 (iData 1) (i11 (iData 2) (i11 (iData 3) (i11 (iData 4) (i11 (iData 5) i12)))))) (listData (i11 (iData 6) (i11 (iData 8) (i11 (iData 8) (i11 (iData 9) (i11 (iData 10) i12)))))) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff9fd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffa0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff9fd8799f41d09f0102030405060708090affffffd8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force (force fstPair))) "Pattern matching failure in TermCont") (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force headList)) (force tailList)) (force ifThenElse)) (force trace)) (force mkCons)) [ ])) +example.concatenate two lists, illegal (more than one output) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i18 (equalsInteger 1 i2) (delay (i14 (\i0 -> \i0 -> \i0 -> force (i18 i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (i21 (i2 (i19 i1)) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (i19 i1))) (delay (i3 i2 (i20 i1)))))))) (\i0 -> (\i0 -> \i0 -> equalsData (listData (i15 i2)) (listData (i15 i1))) (i17 i2) (i17 (i13 i1))) ((\i0 -> unListData (i17 (i13 i1))) (i16 i4)))) (delay (force (i19 i11 (delay error)))))) (i12 i2)) (i8 i1)) (unConstrData (i13 (i14 i1)))) (i8 i3) (\i0 -> (\i0 -> force (i16 (force (i16 (force nullList (i15 ((\i0 -> i13 (\i0 -> \i0 -> force (i16 i1 (delay i22) (delay ((\i0 -> force (i20 (i4 i1) (delay (i22 i1 (i3 (i19 i2)))) (delay (i3 (i19 i2))))) (i17 i1)))))) (\i0 -> equalsData (i15 (i11 i1)) (i15 i2)) (unListData (i14 (i15 (i10 i3))))))) (delay (equalsData (i14 (i12 (\i0 -> \i0 -> force (i15 i1 (delay i21) (delay ((\i0 -> force (i20 "iteration" (delay (force (i19 (equalsByteString (unBData (i17 i1)) ((\i0 -> (\i0 -> (\i0 -> force (i22 (equalsInteger 0 i2) (delay (unBData (i20 i1))) (delay (force (i23 i15 (delay error)))))) (i16 i2)) (i12 i1)) (unConstrData (i17 (i18 (i18 i4)))))) (delay (force (i20 "appended something" (delay i21)) (i17 (i18 i1)) (i3 (i18 i2)))) (delay (force (i20 "called without appending" (delay i3)) (i18 i2)))))))) (i12 (i16 i1)))))) (unListData (i14 ((\i0 -> i16 (i16 (i16 (i16 (i16 (i16 (i16 (i16 i1)))))))) (i10 i3)))))) (listData ((\i0 -> \i0 -> i14 (\i0 -> \i0 -> force (i17 i1 (delay i3) (delay (i22 (i18 i1) (i2 (i19 i1)))))) i2) (unListData i7) i4)))) (delay False))) (delay ()) (delay (force (i17 "not valid" (delay error)))))) (i9 (i13 (i14 (i9 i1))))) (delay (force (i15 i7 (delay error))))) (i11 (i7 i2))) ((\i0 -> i9 (\i0 -> \i0 -> force (i12 i1 (delay i18) (delay (i17 (i3 (i13 i1)) (i2 (i14 i1))))))) (\i0 -> (\i0 -> (\i0 -> i3) (force (i14 (lessThanInteger i1 0) (delay (force (i15 "could not make natural" (delay error)))) (delay i1)))) (unIData i1)) (unListData i2))) (listData (i11 (iData 1) (i11 (iData 2) (i11 (iData 3) (i11 (iData 4) (i11 (iData 5) i12)))))) (listData (i11 (iData 6) (i11 (iData 7) (i11 (iData 8) (i11 (iData 9) (i11 (iData 10) i12)))))) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff9fd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffd8799fd8799fd87a9f41a1ffd87a80ffa0d87a80ffffa0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff9fd8799f41d09f0102030405060708090affffffd8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force (force fstPair))) "Pattern matching failure in TermCont") (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force headList)) (force tailList)) (force ifThenElse)) (force trace)) (force mkCons)) [ ])) +example2.recovering a record succeeds (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> constrData 0 (i11 (iData 4) (i11 (bData i12) i13))) (force (i4 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (i12 i1 (delay ()) (delay (force (i15 i11 (delay error))))))) (i12 i3)) (unBData i1)) (i11 i1)) (i9 i3)) (unIData i1)) (i8 i1))) (delay (force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> ()) (force (i12 i1 (delay ()) (delay (force (i15 i11 (delay error))))))) (i12 i3)) (unBData i1)) (i11 i1)) (i9 i3)) ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (i10 i1 (delay i16) (delay (i14 (i3 (i12 i1)) (i2 (i11 i1))))))) (\i0 -> (\i0 -> i2) (unIData i1)) (unListData i1))) (i8 i1))) (delay (force (i9 "reached end of sum while still not having found the constructor" (delay error)))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData (constrData 0 (i7 (iData 4) (i7 (bData i8) i9))))) (force ifThenElse)) "ptryFrom(PDataRecord[]): list is longer than zero") (force (force chooseList))) (force tailList)) (force headList)) (force trace)) (force mkCons)) #666f6f) [ ])) \ No newline at end of file diff --git a/plutarch-test/goldens/either.bench.golden b/plutarch-test/goldens/either.bench.golden new file mode 100644 index 000000000..92d18aaa2 --- /dev/null +++ b/plutarch-test/goldens/either.bench.golden @@ -0,0 +1,5 @@ +eq.true.left {"exBudgetCPU":1014033,"exBudgetMemory":3601,"scriptSizeBytes":47} +eq.true.right {"exBudgetCPU":1014033,"exBudgetMemory":3601,"scriptSizeBytes":47} +eq.false.left-right {"exBudgetCPU":713100,"exBudgetMemory":3200,"scriptSizeBytes":47} +eq.false.left-left {"exBudgetCPU":1014033,"exBudgetMemory":3601,"scriptSizeBytes":47} +eq.false.right-right {"exBudgetCPU":1014033,"exBudgetMemory":3601,"scriptSizeBytes":47} \ No newline at end of file diff --git a/plutarch-test/goldens/either.uplc.eval.golden b/plutarch-test/goldens/either.uplc.eval.golden new file mode 100644 index 000000000..7d8b63ad6 --- /dev/null +++ b/plutarch-test/goldens/either.uplc.eval.golden @@ -0,0 +1,5 @@ +eq.true.left (program 1.0.0 True) +eq.true.right (program 1.0.0 True) +eq.false.left-right (program 1.0.0 False) +eq.false.left-left (program 1.0.0 False) +eq.false.right-right (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/either.uplc.golden b/plutarch-test/goldens/either.uplc.golden new file mode 100644 index 000000000..e36de994e --- /dev/null +++ b/plutarch-test/goldens/either.uplc.golden @@ -0,0 +1,5 @@ +eq.true.left (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (\i0 -> False)) (\i0 -> i2 (\i0 -> False) (\i0 -> equalsInteger i2 i1))) ((\i0 -> \i0 -> \i0 -> i2 i3) 42) ((\i0 -> \i0 -> \i0 -> i2 i3) 42))) +eq.true.right (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (\i0 -> False)) (\i0 -> i2 (\i0 -> False) (\i0 -> equalsInteger i2 i1))) ((\i0 -> \i0 -> \i0 -> i1 i3) 42) ((\i0 -> \i0 -> \i0 -> i1 i3) 42))) +eq.false.left-right (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (\i0 -> False)) (\i0 -> i2 (\i0 -> False) (\i0 -> equalsInteger i2 i1))) ((\i0 -> \i0 -> \i0 -> i2 i3) 42) ((\i0 -> \i0 -> \i0 -> i1 i3) 42))) +eq.false.left-left (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (\i0 -> False)) (\i0 -> i2 (\i0 -> False) (\i0 -> equalsInteger i2 i1))) ((\i0 -> \i0 -> \i0 -> i2 i3) 24) ((\i0 -> \i0 -> \i0 -> i2 i3) 42))) +eq.false.right-right (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (\i0 -> False)) (\i0 -> i2 (\i0 -> False) (\i0 -> equalsInteger i2 i1))) ((\i0 -> \i0 -> \i0 -> i1 i3) 24) ((\i0 -> \i0 -> \i0 -> i1 i3) 42))) \ No newline at end of file diff --git a/plutarch-test/goldens/extra.api.bench.golden b/plutarch-test/goldens/extra.api.bench.golden new file mode 100644 index 000000000..8c386c3a8 --- /dev/null +++ b/plutarch-test/goldens/extra.api.bench.golden @@ -0,0 +1,3 @@ +pfindOwnInput {"exBudgetCPU":6900718,"exBudgetMemory":17404,"scriptSizeBytes":332} +pgetContinuingOutputs {"exBudgetCPU":13974787,"exBudgetMemory":35970,"scriptSizeBytes":462} +pparseDatum {"exBudgetCPU":18732961,"exBudgetMemory":59226,"scriptSizeBytes":378} \ No newline at end of file diff --git a/plutarch-test/goldens/extra.api.uplc.eval.golden b/plutarch-test/goldens/extra.api.uplc.eval.golden new file mode 100644 index 000000000..bd18c98bb --- /dev/null +++ b/plutarch-test/goldens/extra.api.uplc.eval.golden @@ -0,0 +1,3 @@ +pfindOwnInput (program 1.0.0 (\i0 -> \i0 -> i2 #d8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffff)) +pgetContinuingOutputs (program 1.0.0 [#d8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffff]) +pparseDatum (program 1.0.0 (\i0 -> \i0 -> i2 #9f0102030405060708090aff)) \ No newline at end of file diff --git a/plutarch-test/goldens/extra.api.uplc.golden b/plutarch-test/goldens/extra.api.uplc.golden new file mode 100644 index 000000000..85bdbaf83 --- /dev/null +++ b/plutarch-test/goldens/extra.api.uplc.golden @@ -0,0 +1,3 @@ +pfindOwnInput (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay ((\i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (i10 (i2 (i11 i1)) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (i11 i1))) (delay (i3 i2 (i12 i1)))))))) (\i0 -> (\i0 -> equalsData (listData (i12 i3)) (listData (i12 i1))) (i9 (i11 i1))) i2) ((\i0 -> unListData (i7 (i9 i1))) (i6 i4)) (i6 i1))) (delay error))) (i8 i2)) (force (force fstPair) i1)) (unConstrData (i3 (i4 i1)))) (i4 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff9fd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffa0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff9fd8799f41d09f0102030405060708090affffffd8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff)) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +pgetContinuingOutputs (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay ((\i0 -> \i0 -> \i0 -> i8 (\i0 -> \i0 -> \i0 -> force (i12 i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (i13 (i2 (i16 i1)) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (i16 i1))) (delay (i3 i2 (i17 i1)))))))) (i11 i1) i3 (\i0 -> (\i0 -> i10 (\i0 -> \i0 -> force (i13 i1 (delay [ ]) (delay ((\i0 -> force (i15 (i4 i1) (delay (force mkCons i1 (i3 (i19 i2)))) (delay (i3 (i19 i2))))) (i17 i1)))))) (i12 ((\i0 -> i15 (i17 i1)) (i14 (i15 (i16 i1))))) i3) (delay (force (force trace "can't get any continuing outputs" (delay error))))) ((\i0 -> unListData (i11 (i13 i1))) (i10 i4)) ((\i0 -> unListData (i11 (i12 (i13 i1)))) (i10 i4)) (i10 i1))) (delay error))) (i12 i2)) (force (force fstPair) i1)) (unConstrData (i7 (i8 i1)))) (i8 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff9fd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffa0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff9fd8799f41d09f0102030405060708090affffffd8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force ifThenElse)) (\i0 -> \i0 -> i3 i2 (i4 (i6 i1)))) (\i0 -> \i0 -> equalsData (listData (i5 i2)) (listData (i5 i1)))) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +pparseDatum (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> force (i7 i1 (delay (\i0 -> \i0 -> force i1)) (delay (force (force ifThenElse (i2 (i9 i1)) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (i9 i1))) (delay (i3 i2 (i8 i1)))))))) (\i0 -> equalsByteString i3 (unBData (i7 (i8 i1)))) i1 (\i0 -> (\i0 -> \i0 -> \i0 -> i2 i3) ((\i0 -> i8 (i7 (i9 i2))) ((\i0 -> i5 (\i0 -> \i0 -> force (i8 i1 (delay [ ]) (delay (force mkCons (i3 (i10 i1)) (i2 (i9 i1))))))) (\i0 -> (\i0 -> i2) (unIData i1)) (unListData (i7 (i6 (i8 i1))))))) (delay (\i0 -> \i0 -> force i1))) #d0 ((\i0 -> unListData (i5 ((\i0 -> i5 (i5 (i5 (i5 (i5 (i5 (i5 (i5 i1)))))))) (i6 i1)))) ((\i0 -> i5 (i6 i1)) #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff9fd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffa0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff9fd8799f41d09f0102030405060708090affffffd8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/extra.bytestring.bench.golden b/plutarch-test/goldens/extra.bytestring.bench.golden new file mode 100644 index 000000000..ad97bf814 --- /dev/null +++ b/plutarch-test/goldens/extra.bytestring.bench.golden @@ -0,0 +1,6 @@ +allandhexdigit.allas {"exBudgetCPU":26230811,"exBudgetMemory":65342,"scriptSizeBytes":94} +allandhexdigit.not all as {"exBudgetCPU":13542795,"exBudgetMemory":34278,"scriptSizeBytes":93} +allandhexdigit.allhex {"exBudgetCPU":72712677,"exBudgetMemory":190507,"scriptSizeBytes":175} +allandhexdigit.notallhex {"exBudgetCPU":51813964,"exBudgetMemory":136919,"scriptSizeBytes":175} +allandhexdigit.pisHexDigit {"exBudgetCPU":66411178,"exBudgetMemory":209278,"scriptSizeBytes":187} +allandhexdigit.pisNoneHexDigit {"exBudgetCPU":192490411,"exBudgetMemory":586255,"scriptSizeBytes":235} \ No newline at end of file diff --git a/plutarch-test/goldens/extra.bytestring.uplc.eval.golden b/plutarch-test/goldens/extra.bytestring.uplc.eval.golden new file mode 100644 index 000000000..a4391afb5 --- /dev/null +++ b/plutarch-test/goldens/extra.bytestring.uplc.eval.golden @@ -0,0 +1,6 @@ +allandhexdigit.allas (program 1.0.0 True) +allandhexdigit.not all as (program 1.0.0 False) +allandhexdigit.allhex (program 1.0.0 True) +allandhexdigit.notallhex (program 1.0.0 False) +allandhexdigit.pisHexDigit (program 1.0.0 True) +allandhexdigit.pisNoneHexDigit (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/extra.bytestring.uplc.golden b/plutarch-test/goldens/extra.bytestring.uplc.golden new file mode 100644 index 000000000..197b5f203 --- /dev/null +++ b/plutarch-test/goldens/extra.bytestring.uplc.golden @@ -0,0 +1,6 @@ +allandhexdigit.allas (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (i6 (lessThanInteger i1 i3) (delay (force (i6 (i5 (indexByteString i4 i1)) (delay (i2 (addInteger i1 1))) (delay False)))) (delay True))) 0) (lengthOfByteString i1)) (\i0 -> equalsInteger i1 97) #61616161616161616161616161) (force ifThenElse))) +allandhexdigit.not all as (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (i6 (lessThanInteger i1 i3) (delay (force (i6 (i5 (indexByteString i4 i1)) (delay (i2 (addInteger i1 1))) (delay False)))) (delay True))) 0) (lengthOfByteString i1)) (\i0 -> equalsInteger i1 97) #616161616161626161616161) (force ifThenElse))) +allandhexdigit.allhex (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (i9 (lessThanInteger i1 i3) (delay (force (i9 (i5 (indexByteString i4 i1)) (delay (i2 (addInteger i1 1))) (delay False)))) (delay True))) 0) (lengthOfByteString i1)) (\i0 -> force (i2 (force (i4 (lessThanEqualsInteger i1 57) (delay (lessThanEqualsInteger 48 i1)))) (delay (force (i2 (force (i4 (lessThanEqualsInteger i1 70) (delay (lessThanEqualsInteger 65 i1)))) (delay (force (i4 (lessThanEqualsInteger i1 102) (delay (lessThanEqualsInteger 97 i1)))))))))) #3561376331386561653837373864313533343466) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False))) +allandhexdigit.notallhex (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (i9 (lessThanInteger i1 i3) (delay (force (i9 (i5 (indexByteString i4 i1)) (delay (i2 (addInteger i1 1))) (delay False)))) (delay True))) 0) (lengthOfByteString i1)) (\i0 -> force (i2 (force (i4 (lessThanEqualsInteger i1 57) (delay (lessThanEqualsInteger 48 i1)))) (delay (force (i2 (force (i4 (lessThanEqualsInteger i1 70) (delay (lessThanEqualsInteger 65 i1)))) (delay (force (i4 (lessThanEqualsInteger i1 102) (delay (lessThanEqualsInteger 97 i1)))))))))) #3561376331386561653837373867313533343466) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False))) +allandhexdigit.pisHexDigit (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i7 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> force (i8 (i5 i2) (delay (i4 i1)))) (delay True))) (\i0 -> force (i2 (force (i4 (lessThanEqualsInteger i1 57) (delay (lessThanEqualsInteger 48 i1)))) (delay (force (i2 (force (i4 (lessThanEqualsInteger i1 70) (delay (lessThanEqualsInteger 65 i1)))) (delay (force (i4 (lessThanEqualsInteger i1 102) (delay (lessThanEqualsInteger 97 i1)))))))))) (i6 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [49,50,51,52,53,54,55,56,57,48,97,98,99,100,101,102])) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +allandhexdigit.pisNoneHexDigit (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i7 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> force (i6 (i5 i2) (delay (i4 i1)))) (delay False))) (\i0 -> force (i2 (force (i4 (lessThanEqualsInteger i1 57) (delay (lessThanEqualsInteger 48 i1)))) (delay (force (i2 (force (i4 (lessThanEqualsInteger i1 70) (delay (lessThanEqualsInteger 65 i1)))) (delay (force (i4 (lessThanEqualsInteger i1 102) (delay (lessThanEqualsInteger 97 i1)))))))))) (i6 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [103,104,105,107,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,32,33,64,35,36,37,94,38,42,40,41,91,93,123,125,96,126])) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) \ No newline at end of file diff --git a/plutarch-test/goldens/extra.intervalutils.fixtures.bench.golden b/plutarch-test/goldens/extra.intervalutils.fixtures.bench.golden new file mode 100644 index 000000000..3eb6b59a3 --- /dev/null +++ b/plutarch-test/goldens/extra.intervalutils.fixtures.bench.golden @@ -0,0 +1,16 @@ +constants.always {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":34} +constants.never {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":34} +contains.in interval {"exBudgetCPU":25338906,"exBudgetMemory":72519,"scriptSizeBytes":558} +contains.out interval {"exBudgetCPU":20362113,"exBudgetMemory":58635,"scriptSizeBytes":557} +contains.always {"exBudgetCPU":18925489,"exBudgetMemory":56043,"scriptSizeBytes":566} +contains.never {"exBudgetCPU":15555211,"exBudgetMemory":45859,"scriptSizeBytes":566} +member.[b,c], a < b {"exBudgetCPU":19885479,"exBudgetMemory":57171,"scriptSizeBytes":567} +member.[b,c], a = b {"exBudgetCPU":28443010,"exBudgetMemory":79782,"scriptSizeBytes":561} +member.[b,c], a > b, a < c {"exBudgetCPU":24862272,"exBudgetMemory":71055,"scriptSizeBytes":567} +member.[b,c], a = c {"exBudgetCPU":28512010,"exBudgetMemory":80082,"scriptSizeBytes":563} +member.[b,c], a > c {"exBudgetCPU":28512010,"exBudgetMemory":80082,"scriptSizeBytes":567} +hull.hull 3 5 contains 3 5 {"exBudgetCPU":54095236,"exBudgetMemory":149209,"scriptSizeBytes":645} +hull.2 not member of hull 3 5 {"exBudgetCPU":41549333,"exBudgetMemory":116707,"scriptSizeBytes":627} +hull.6 not member of hull 3 5 {"exBudgetCPU":41549333,"exBudgetMemory":116707,"scriptSizeBytes":627} +intersection.intesection [2,4] [3,5] contains [3,4] {"exBudgetCPU":54910504,"exBudgetMemory":151537,"scriptSizeBytes":645} +intersection.intesection [3,5] [2,4] contains [3,4] {"exBudgetCPU":62209980,"exBudgetMemory":169591,"scriptSizeBytes":645} \ No newline at end of file diff --git a/plutarch-test/goldens/extra.intervalutils.fixtures.uplc.eval.golden b/plutarch-test/goldens/extra.intervalutils.fixtures.uplc.eval.golden new file mode 100644 index 000000000..ff1e4456c --- /dev/null +++ b/plutarch-test/goldens/extra.intervalutils.fixtures.uplc.eval.golden @@ -0,0 +1,16 @@ +constants.always (program 1.0.0 #d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff) +constants.never (program 1.0.0 #d8799fd8799fd87b80d87a80ffd8799fd87980d87a80ffff) +contains.in interval (program 1.0.0 True) +contains.out interval (program 1.0.0 False) +contains.always (program 1.0.0 True) +contains.never (program 1.0.0 False) +member.[b,c], a < b (program 1.0.0 False) +member.[b,c], a = b (program 1.0.0 True) +member.[b,c], a > b, a < c (program 1.0.0 True) +member.[b,c], a = c (program 1.0.0 True) +member.[b,c], a > c (program 1.0.0 False) +hull.hull 3 5 contains 3 5 (program 1.0.0 True) +hull.2 not member of hull 3 5 (program 1.0.0 False) +hull.6 not member of hull 3 5 (program 1.0.0 False) +intersection.intesection [2,4] [3,5] contains [3,4] (program 1.0.0 True) +intersection.intesection [3,5] [2,4] contains [3,4] (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/extra.intervalutils.fixtures.uplc.golden b/plutarch-test/goldens/extra.intervalutils.fixtures.uplc.golden new file mode 100644 index 000000000..ba22911b5 --- /dev/null +++ b/plutarch-test/goldens/extra.intervalutils.fixtures.uplc.golden @@ -0,0 +1,16 @@ +constants.always (program 1.0.0 #d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff) +constants.never (program 1.0.0 #d8799fd8799fd87b80d87a80ffd8799fd87980d87a80ffff) +contains.in interval (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) (i18 #03 #05) (i18 i24 i24)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> \i0 -> i3 (constrData 1 (i6 i2 i7)) (constrData 1 (i6 i1 i7)))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ]) #04)) +contains.out interval (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) (i19 i18 i18) (i19 #03 #05)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) #04) (\i0 -> \i0 -> i3 (constrData 1 (i6 i2 i7)) (constrData 1 (i6 i1 i7)))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ])) +contains.always (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) #d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff ((\i0 -> \i0 -> (\i0 -> \i0 -> (\i0 -> \i0 -> constrData 0 (i25 i2 (i25 i1 i26))) (constrData 0 (i23 i2 (i23 i22 i24))) (constrData 0 (i23 i1 (i23 i22 i24)))) (constrData 1 (i21 i2 i22)) (constrData 1 (i21 i1 i22))) #01 #02)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) #d87a80) (force mkCons)) [ ])) +contains.never (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) #d8799fd8799fd87b80d87a80ffd8799fd87980d87a80ffff ((\i0 -> \i0 -> (\i0 -> \i0 -> (\i0 -> \i0 -> constrData 0 (i25 i2 (i25 i1 i26))) (constrData 0 (i23 i2 (i23 i22 i24))) (constrData 0 (i23 i1 (i23 i22 i24)))) (constrData 1 (i21 i2 i22)) (constrData 1 (i21 i1 i22))) #01 #02)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) #d87a80) (force mkCons)) [ ])) +member.[b,c], a < b (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (i6 (i18 (i19 i2)) (i18 (i19 i1))) (delay (i6 (i18 (i19 (i20 i1))) (i18 (i19 (i20 i2))))))) (i20 i2)) (i19 i2)) ((\i0 -> i21 i1 i1) (constrData 1 (i23 i2 i24)))) #01 ((\i0 -> \i0 -> i20 (constrData 1 (i23 i2 i24)) (constrData 1 (i23 i1 i24))) #02 #04)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ])) +member.[b,c], a = b (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) ((\i0 -> i20 i1 i1) (constrData 1 (i22 i24 i23)))) ((\i0 -> i19 (constrData 1 (i22 i24 i23)) (constrData 1 (i22 i1 i23))) #04)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ]) #02)) +member.[b,c], a > b, a < c (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (i6 (i18 (i19 i2)) (i18 (i19 i1))) (delay (i6 (i18 (i19 (i20 i1))) (i18 (i19 (i20 i2))))))) (i20 i2)) (i19 i2)) ((\i0 -> i21 i1 i1) (constrData 1 (i23 i2 i24)))) #03 ((\i0 -> \i0 -> i20 (constrData 1 (i23 i2 i24)) (constrData 1 (i23 i1 i24))) #02 #04)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ])) +member.[b,c], a = c (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) ((\i0 -> i20 i1 i1) (constrData 1 (i22 i24 i23)))) ((\i0 -> \i0 -> i20 (constrData 1 (i23 i2 i24)) (constrData 1 (i23 i1 i24))) #02 i23)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ]) #04)) +member.[b,c], a > c (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (i6 (i18 (i19 i2)) (i18 (i19 i1))) (delay (i6 (i18 (i19 (i20 i1))) (i18 (i19 (i20 i2))))))) (i20 i2)) (i19 i2)) ((\i0 -> i21 i1 i1) (constrData 1 (i23 i2 i24)))) #05 ((\i0 -> \i0 -> i20 (constrData 1 (i23 i2 i24)) (constrData 1 (i23 i1 i24))) #02 #04)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ])) +hull.hull 3 5 contains 3 5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) ((\i0 -> \i0 -> (\i0 -> (\i0 -> i24 (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i2 i1) (i17 (i18 i2)) (i17 (i18 i1)))) (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i1 i2) (i17 (i18 (i19 i2))) (i17 (i18 (i19 i1)))))) (i19 i2)) (i18 i2)) (i18 i24) (i18 i25)) (i19 (constrData 1 (i22 i24 i23)) (constrData 1 (i22 i25 i23)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> (\i0 -> i3 i1 i1) (constrData 1 (i5 i1 i6)))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ]) #03) #05)) +hull.2 not member of hull 3 5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (i6 (i18 (i19 i2)) (i18 (i19 i1))) (delay (i6 (i18 (i19 (i20 i1))) (i18 (i19 (i20 i2))))))) (i20 i2)) (i19 i2)) (i20 i2)) #02 ((\i0 -> \i0 -> (\i0 -> (\i0 -> i24 (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i2 i1) (i17 (i18 i2)) (i17 (i18 i1)))) (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i1 i2) (i17 (i18 (i19 i2))) (i17 (i18 (i19 i1)))))) (i19 i2)) (i18 i2)) (i18 #03) (i18 #05))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> (\i0 -> i3 i1 i1) (constrData 1 (i5 i1 i6)))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ])) +hull.6 not member of hull 3 5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (i6 (i18 (i19 i2)) (i18 (i19 i1))) (delay (i6 (i18 (i19 (i20 i1))) (i18 (i19 (i20 i2))))))) (i20 i2)) (i19 i2)) (i20 i2)) #02 ((\i0 -> \i0 -> (\i0 -> (\i0 -> i24 (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i2 i1) (i17 (i18 i2)) (i17 (i18 i1)))) (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i1 i2) (i17 (i18 (i19 i2))) (i17 (i18 (i19 i1)))))) (i19 i2)) (i18 i2)) (i18 #03) (i18 #05))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> (\i0 -> i3 i1 i1) (constrData 1 (i5 i1 i6)))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ])) +intersection.intesection [2,4] [3,5] contains [3,4] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) ((\i0 -> \i0 -> (\i0 -> (\i0 -> i24 (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i1 i2) (i17 (i18 i2)) (i17 (i18 i1)))) (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i2 i1) (i17 (i18 (i19 i2))) (i17 (i18 (i19 i1)))))) (i19 i2)) (i18 i2)) (i18 #02 i25) (i18 i24 #05)) (i18 i24 i25)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> \i0 -> i3 (constrData 1 (i6 i2 i7)) (constrData 1 (i6 i1 i7)))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ]) #03) #04)) +intersection.intesection [3,5] [2,4] contains [3,4] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (i5 (i17 (i18 i2)) (i17 (i18 i1))) (delay (i5 (i17 (i18 (i19 i1))) (i17 (i18 (i19 i2))))))) (i19 i2)) (i18 i2)) ((\i0 -> \i0 -> (\i0 -> (\i0 -> i24 (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i1 i2) (i17 (i18 i2)) (i17 (i18 i1)))) (constrData 0 ((\i0 -> \i0 -> i16 (i7 i2 i1) i2 i1) (i17 (i18 (i19 i2))) (i17 (i18 (i19 i1)))))) (i19 i2)) (i18 i2)) (i18 i24 #05) (i18 #02 i25)) (i18 i24 i25)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i15 (force (i11 (force (i7 i2 (delay i1))) (delay (force (i7 (i9 i2) (delay (i9 i1))))))) (delay (i10 i4 i3)) (delay (i14 i4 i3)))) (i15 (i18 (i19 i4)))) (i14 (i17 (i18 i4)))) (i16 i2)) (i15 i2))) (\i0 -> \i0 -> i10 i2 i1 i3)) (delay False)) (\i0 -> i7 i1 False True)) (\i0 -> \i0 -> force (i3 (i6 i2 i1) (delay (i5 i2 i1))))) (\i0 -> i5 i1 i2)) (delay True)) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 0 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay (force (i7 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 1 i2) (delay ((\i0 -> equalsInteger (unIData (i15 i5)) i1) (unIData (i14 i1)))) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i10 (equalsInteger 2 i2) (delay True) (delay False))) (i16 i2)) (i10 i1)) (unConstrData i4)))))))) (i13 i2)) (i7 i1)) (unConstrData i2))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger 0 i2) (delay True) (delay (force (i6 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 0 i2) (delay False) (delay (force (i9 (equalsInteger 2 i2) (delay True) (delay (lessThanInteger (unIData (i13 i4)) (unIData (i13 i1))))))))) (i15 i2)) (i9 i1)) (unConstrData i4))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i9 (equalsInteger 2 i2) (delay True) (delay False))) (i15 i2)) (i9 i1)) (unConstrData i4)))))))) (i12 i2)) (i6 i1)) (unConstrData i2))) (force ifThenElse)) (\i0 -> equalsInteger (i2 (unConstrData i1)) 1)) (force (force fstPair))) i3) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (\i0 -> \i0 -> i3 (constrData 1 (i6 i2 i7)) (constrData 1 (i6 i1 i7)))) (\i0 -> \i0 -> i3 (constrData 0 (i5 i2 (i5 i4 i6))) (constrData 0 (i5 i1 (i5 i4 i6))))) (\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 i5)))) #d87a80) (force mkCons)) [ ]) #03) #04)) \ No newline at end of file diff --git a/plutarch-test/goldens/extra.listutils.bench.golden b/plutarch-test/goldens/extra.listutils.bench.golden new file mode 100644 index 000000000..7b04fe4a8 --- /dev/null +++ b/plutarch-test/goldens/extra.listutils.bench.golden @@ -0,0 +1,4 @@ +reverse.reverse_[1..5] {"exBudgetCPU":5865100,"exBudgetMemory":25600,"scriptSizeBytes":87} +isSorted.[1..10] {"exBudgetCPU":16166677,"exBudgetMemory":59218,"scriptSizeBytes":115} +isSorted.reverse_[1..10] {"exBudgetCPU":3379609,"exBudgetMemory":13203,"scriptSizeBytes":126} +isSorted.reverse_[] {"exBudgetCPU":621100,"exBudgetMemory":2800,"scriptSizeBytes":56} \ No newline at end of file diff --git a/plutarch-test/goldens/extra.listutils.uplc.eval.golden b/plutarch-test/goldens/extra.listutils.uplc.eval.golden new file mode 100644 index 000000000..f33a1f36b --- /dev/null +++ b/plutarch-test/goldens/extra.listutils.uplc.eval.golden @@ -0,0 +1,4 @@ +reverse.reverse_[1..5] (program 1.0.0 (\i0 -> \i0 -> i2 5 (\i0 -> \i0 -> i2 4 (\i0 -> \i0 -> i2 3 (\i0 -> \i0 -> i2 2 (\i0 -> \i0 -> i2 1 (\i0 -> \i0 -> force i1))))))) +isSorted.[1..10] (program 1.0.0 True) +isSorted.reverse_[1..10] (program 1.0.0 True) +isSorted.reverse_[] (program 1.0.0 (\i0 -> \i0 -> force i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/extra.listutils.uplc.golden b/plutarch-test/goldens/extra.listutils.uplc.golden new file mode 100644 index 000000000..8aab48a48 --- /dev/null +++ b/plutarch-test/goldens/extra.listutils.uplc.golden @@ -0,0 +1,4 @@ +reverse.reverse_[1..5] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (i6 i4 i2) i1) (delay i2))) (\i0 -> \i0 -> i3 i1 i2) (\i0 -> \i0 -> force i1) (i1 1 (i1 2 (i1 3 (i1 4 (i1 5 (\i0 -> \i0 -> force i1))))))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3))) +isSorted.[1..10] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) (lessThanEqualsInteger i4 i2) (delay (i6 i3)))) (delay True)) (delay True)) (i1 1 (i1 2 (i1 3 (i1 4 (i1 5 (i1 6 (i1 7 (i1 8 (i1 9 (i1 10 (\i0 -> \i0 -> force i1)))))))))))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3))) +isSorted.reverse_[1..10] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 i1 False True) ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> force ((\i0 -> \i0 -> i9 i2 i1 (delay False)) (lessThanEqualsInteger i4 i2) (delay (i6 i3)))) (delay True)) (delay True)) (i2 10 (i2 9 (i2 8 (i2 7 (i2 6 (i2 5 (i2 4 (i2 3 (i2 2 (i2 1 (\i0 -> \i0 -> force i1))))))))))))) (force ifThenElse)) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3))) +isSorted.reverse_[] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (i6 i4 i2) i1) (delay i2))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i3 i4) (\i0 -> \i0 -> force i1) (\i0 -> \i0 -> force i1))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.data.bench.golden b/plutarch-test/goldens/field.data.bench.golden new file mode 100644 index 000000000..dbc24ebdd --- /dev/null +++ b/plutarch-test/goldens/field.data.bench.golden @@ -0,0 +1,4 @@ +pmatch-pfield.pmatch.newtype {"exBudgetCPU":966918,"exBudgetMemory":3092,"scriptSizeBytes":45} +pmatch-pfield.pfield.newtype {"exBudgetCPU":966918,"exBudgetMemory":3092,"scriptSizeBytes":45} +pfield-pletFields.pfield.single {"exBudgetCPU":460976,"exBudgetMemory":1496,"scriptSizeBytes":32} +pfield-pletFields.pletFields.single {"exBudgetCPU":460976,"exBudgetMemory":1496,"scriptSizeBytes":32} \ No newline at end of file diff --git a/plutarch-test/goldens/field.data.uplc.eval.golden b/plutarch-test/goldens/field.data.uplc.eval.golden new file mode 100644 index 000000000..183cfd7b7 --- /dev/null +++ b/plutarch-test/goldens/field.data.uplc.eval.golden @@ -0,0 +1,4 @@ +pmatch-pfield.pmatch.newtype (program 1.0.0 (#d8799f41abff, #d87a80)) +pmatch-pfield.pfield.newtype (program 1.0.0 (#d8799f41abff, #d87a80)) +pfield-pletFields.pfield.single (program 1.0.0 #d8799f41abff) +pfield-pletFields.pletFields.single (program 1.0.0 #d8799f41abff) \ No newline at end of file diff --git a/plutarch-test/goldens/field.data.uplc.golden b/plutarch-test/goldens/field.data.uplc.golden new file mode 100644 index 000000000..b8d5b8853 --- /dev/null +++ b/plutarch-test/goldens/field.data.uplc.golden @@ -0,0 +1,4 @@ +pmatch-pfield.pmatch.newtype (program 1.0.0 ((\i0 -> (\i0 -> mkPairData (i2 i1) (i2 (force tailList i1))) ((\i0 -> force (force sndPair) (unConstrData i1)) #d8799fd8799f41abffd87a80ff)) (force headList))) +pmatch-pfield.pfield.newtype (program 1.0.0 ((\i0 -> (\i0 -> mkPairData (i2 i1) (i2 (force tailList i1))) ((\i0 -> force (force sndPair) (unConstrData i1)) #d8799fd8799f41abffd87a80ff)) (force headList))) +pfield-pletFields.pfield.single (program 1.0.0 ((\i0 -> force headList (force (force sndPair) (unConstrData i1))) #d8799fd8799f41abffd87a80ff)) +pfield-pletFields.pletFields.single (program 1.0.0 (force headList ((\i0 -> force (force sndPair) (unConstrData i1)) #d8799fd8799f41abffd87a80ff))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.dropFields.bench.golden b/plutarch-test/goldens/field.dropFields.bench.golden new file mode 100644 index 000000000..e68db7f4d --- /dev/null +++ b/plutarch-test/goldens/field.dropFields.bench.golden @@ -0,0 +1,2 @@ +lam {"exBudgetCPU":207100,"exBudgetMemory":1000,"scriptSizeBytes":45} +app {"exBudgetCPU":1785427,"exBudgetMemory":5018,"scriptSizeBytes":88} \ No newline at end of file diff --git a/plutarch-test/goldens/field.dropFields.dropFields.bench.golden b/plutarch-test/goldens/field.dropFields.dropFields.bench.golden deleted file mode 100644 index b73ce5d12..000000000 --- a/plutarch-test/goldens/field.dropFields.dropFields.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":268057,"exBudgetMemory":1000,"scriptSizeBytes":45} \ No newline at end of file diff --git a/plutarch-test/goldens/field.dropFields.dropFields.uplc.eval.golden b/plutarch-test/goldens/field.dropFields.dropFields.uplc.eval.golden deleted file mode 100644 index 1e995ba0a..000000000 --- a/plutarch-test/goldens/field.dropFields.dropFields.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1)))) (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList i1)))))))))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.dropFields.dropFields.uplc.golden b/plutarch-test/goldens/field.dropFields.dropFields.uplc.golden deleted file mode 100644 index 27bbee0a2..000000000 --- a/plutarch-test/goldens/field.dropFields.dropFields.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (i3 (i3 (i3 (i3 (i3 (i3 (i3 i1))))))))) (force headList)) (force tailList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.dropFields.uplc.eval.golden b/plutarch-test/goldens/field.dropFields.uplc.eval.golden new file mode 100644 index 000000000..e4e3ead44 --- /dev/null +++ b/plutarch-test/goldens/field.dropFields.uplc.eval.golden @@ -0,0 +1,2 @@ +lam (program 1.0.0 (\i0 -> (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1)))) (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList i1)))))))))) +app (program 1.0.0 17) \ No newline at end of file diff --git a/plutarch-test/goldens/field.dropFields.uplc.golden b/plutarch-test/goldens/field.dropFields.uplc.golden new file mode 100644 index 000000000..5541a25de --- /dev/null +++ b/plutarch-test/goldens/field.dropFields.uplc.golden @@ -0,0 +1,11 @@ +lam (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (i3 (i3 (i3 (i3 (i3 (i3 (i3 i1))))))))) (force headList)) (force tailList))) +app (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (i3 (i3 (i3 (i3 (i3 (i3 (i3 i1))))))))) [ #00 + , #01 + , #02 + , #03 + , #04 + , #05 + , #06 + , #07 + , #08 + , #09 ]) (force headList)) (force tailList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.other.bench.golden b/plutarch-test/goldens/field.other.bench.golden new file mode 100644 index 000000000..9b73e8cd0 --- /dev/null +++ b/plutarch-test/goldens/field.other.bench.golden @@ -0,0 +1,2 @@ +by {"exBudgetCPU":1547135,"exBudgetMemory":4884,"scriptSizeBytes":49} +dotPlus {"exBudgetCPU":9879818,"exBudgetMemory":26900,"scriptSizeBytes":239} \ No newline at end of file diff --git a/plutarch-test/goldens/field.other.uplc.eval.golden b/plutarch-test/goldens/field.other.uplc.eval.golden new file mode 100644 index 000000000..b53a90f6a --- /dev/null +++ b/plutarch-test/goldens/field.other.uplc.eval.golden @@ -0,0 +1,2 @@ +by (program 1.0.0 10) +dotPlus (program 1.0.0 19010) \ No newline at end of file diff --git a/plutarch-test/goldens/field.other.uplc.golden b/plutarch-test/goldens/field.other.uplc.golden new file mode 100644 index 000000000..c99ec4f08 --- /dev/null +++ b/plutarch-test/goldens/field.other.uplc.golden @@ -0,0 +1,2 @@ +by (program 1.0.0 ((\i0 -> (\i0 -> unIData (force headList (force tailList (force (force sndPair) (unConstrData i1))))) (constrData 0 (i1 (iData 50) (i1 (iData 10) (i1 (iData 40) [ ]))))) (force mkCons))) +dotPlus (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (addInteger (addInteger (addInteger (multiplyInteger (unIData (i9 i6)) (unIData (i9 i4))) (multiplyInteger (unIData (i9 i5)) (unIData (i9 i3)))) (multiplyInteger (unIData (i9 (i10 i5))) (unIData (i9 (i10 i3))))) (unIData (i9 i2))) (unIData (i9 i1))) (unIData (i9 (i10 i1)))) (i9 i1)) (i9 (i7 (i8 i5)))) (i7 i1)) (i7 (i5 i3))) (i5 i1)) (i5 (i3 i2))) (i3 i1)) (i3 (constrData 0 (i5 (constrData 0 (i5 (iData 150) (i5 (iData 750) (i5 (iData 100) i6)))) (i5 (constrData 0 (i5 (iData 50) (i5 (iData 10) (i5 (iData 40) i6)))) (i5 (constrData 0 (i5 (iData 1) (i5 (iData 8) (i5 (iData 1) i6)))) i6)))))) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) (force mkCons)) [ ])) \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.bench.golden b/plutarch-test/goldens/field.pletFields.bench.golden new file mode 100644 index 000000000..fa7fcc031 --- /dev/null +++ b/plutarch-test/goldens/field.pletFields.bench.golden @@ -0,0 +1,5 @@ +letSomeFields.lam {"exBudgetCPU":276100,"exBudgetMemory":1300,"scriptSizeBytes":55} +letSomeFields.order {"exBudgetCPU":276100,"exBudgetMemory":1300,"scriptSizeBytes":55} +letSomeFields.app {"exBudgetCPU":2364146,"exBudgetMemory":6620,"scriptSizeBytes":97} +nFields.lam {"exBudgetCPU":115100,"exBudgetMemory":600,"scriptSizeBytes":23} +nFields.app {"exBudgetCPU":949971,"exBudgetMemory":2562,"scriptSizeBytes":68} \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.letSomeFields.bench.golden b/plutarch-test/goldens/field.pletFields.letSomeFields.bench.golden deleted file mode 100644 index 8d91d0b6d..000000000 --- a/plutarch-test/goldens/field.pletFields.letSomeFields.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":357376,"exBudgetMemory":1300,"scriptSizeBytes":55} \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.letSomeFields.uplc.eval.golden b/plutarch-test/goldens/field.pletFields.letSomeFields.uplc.eval.golden deleted file mode 100644 index f7ace1ee9..000000000 --- a/plutarch-test/goldens/field.pletFields.letSomeFields.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (force headList i2)) (unIData (force headList i1))) (unIData (force headList ((\i0 -> force tailList (force tailList i1)) (force tailList i1))))) (force tailList i1)) (force tailList ((\i0 -> force tailList (force tailList i1)) i1)))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.letSomeFields.uplc.golden b/plutarch-test/goldens/field.pletFields.letSomeFields.uplc.golden deleted file mode 100644 index cf5502e85..000000000 --- a/plutarch-test/goldens/field.pletFields.letSomeFields.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 (i6 i1))))) (i5 i1)) (i4 (i3 i1))) (force headList)) (\i0 -> i2 (i2 i1))) (force tailList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.nFields.bench.golden b/plutarch-test/goldens/field.pletFields.nFields.bench.golden deleted file mode 100644 index ba69e6b7f..000000000 --- a/plutarch-test/goldens/field.pletFields.nFields.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":148965,"exBudgetMemory":600,"scriptSizeBytes":23} \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.nFields.uplc.eval.golden b/plutarch-test/goldens/field.pletFields.nFields.uplc.eval.golden deleted file mode 100644 index 8c9a58f82..000000000 --- a/plutarch-test/goldens/field.pletFields.nFields.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1))))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.nFields.uplc.golden b/plutarch-test/goldens/field.pletFields.nFields.uplc.golden deleted file mode 100644 index f973921a7..000000000 --- a/plutarch-test/goldens/field.pletFields.nFields.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> \i0 -> addInteger (unIData (i2 i1)) (unIData (i2 (force tailList i1)))) (force headList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.uplc.eval.golden b/plutarch-test/goldens/field.pletFields.uplc.eval.golden new file mode 100644 index 000000000..395124ffd --- /dev/null +++ b/plutarch-test/goldens/field.pletFields.uplc.eval.golden @@ -0,0 +1,5 @@ +letSomeFields.lam (program 1.0.0 (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (force headList i2)) (unIData (force headList i1))) (unIData (force headList ((\i0 -> force tailList (force tailList i1)) (force tailList i1))))) (force tailList i1)) (force tailList ((\i0 -> force tailList (force tailList i1)) i1)))) +letSomeFields.order (program 1.0.0 (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (force headList i2)) (unIData (force headList i1))) (unIData (force headList ((\i0 -> force tailList (force tailList i1)) (force tailList i1))))) (force tailList i1)) (force tailList ((\i0 -> force tailList (force tailList i1)) i1)))) +letSomeFields.app (program 1.0.0 14) +nFields.lam (program 1.0.0 (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1))))) +nFields.app (program 1.0.0 1) \ No newline at end of file diff --git a/plutarch-test/goldens/field.pletFields.uplc.golden b/plutarch-test/goldens/field.pletFields.uplc.golden new file mode 100644 index 000000000..44ba7ab72 --- /dev/null +++ b/plutarch-test/goldens/field.pletFields.uplc.golden @@ -0,0 +1,23 @@ +letSomeFields.lam (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 (i6 i1))))) (i5 i1)) (i4 (i3 i1))) (force headList)) (\i0 -> i2 (i2 i1))) (force tailList))) +letSomeFields.order (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 (i6 i1))))) (i5 i1)) (i4 (i3 i1))) (force headList)) (\i0 -> i2 (i2 i1))) (force tailList))) +letSomeFields.app (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 (i6 i1))))) (i5 i1)) (i4 (i3 i1))) [ #00 + , #01 + , #02 + , #03 + , #04 + , #05 + , #06 + , #07 + , #08 + , #09 ]) (force headList)) (\i0 -> i2 (i2 i1))) (force tailList))) +nFields.lam (program 1.0.0 ((\i0 -> \i0 -> addInteger (unIData (i2 i1)) (unIData (i2 (force tailList i1)))) (force headList))) +nFields.app (program 1.0.0 ((\i0 -> (\i0 -> addInteger (unIData (i2 i1)) (unIData (i2 (force tailList i1)))) [ #00 + , #01 + , #02 + , #03 + , #04 + , #05 + , #06 + , #07 + , #08 + , #09 ]) (force headList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.rangeFields.bench.golden b/plutarch-test/goldens/field.rangeFields.bench.golden new file mode 100644 index 000000000..7c4135681 --- /dev/null +++ b/plutarch-test/goldens/field.rangeFields.bench.golden @@ -0,0 +1,2 @@ +lam {"exBudgetCPU":207100,"exBudgetMemory":1000,"scriptSizeBytes":39} +app {"exBudgetCPU":1523881,"exBudgetMemory":4322,"scriptSizeBytes":82} \ No newline at end of file diff --git a/plutarch-test/goldens/field.rangeFields.rangeFields.bench.golden b/plutarch-test/goldens/field.rangeFields.rangeFields.bench.golden deleted file mode 100644 index d3b27bdbd..000000000 --- a/plutarch-test/goldens/field.rangeFields.rangeFields.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":268057,"exBudgetMemory":1000,"scriptSizeBytes":39} \ No newline at end of file diff --git a/plutarch-test/goldens/field.rangeFields.rangeFields.uplc.eval.golden b/plutarch-test/goldens/field.rangeFields.rangeFields.uplc.eval.golden deleted file mode 100644 index 879beed7e..000000000 --- a/plutarch-test/goldens/field.rangeFields.rangeFields.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1)))) (force tailList (force tailList (force tailList (force tailList (force tailList i1))))))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.rangeFields.rangeFields.uplc.golden b/plutarch-test/goldens/field.rangeFields.rangeFields.uplc.golden deleted file mode 100644 index 0f9952f7a..000000000 --- a/plutarch-test/goldens/field.rangeFields.rangeFields.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (i3 (i3 (i3 (i3 i1)))))) (force headList)) (force tailList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.rangeFields.uplc.eval.golden b/plutarch-test/goldens/field.rangeFields.uplc.eval.golden new file mode 100644 index 000000000..16b4687d3 --- /dev/null +++ b/plutarch-test/goldens/field.rangeFields.uplc.eval.golden @@ -0,0 +1,2 @@ +lam (program 1.0.0 (\i0 -> (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1)))) (force tailList (force tailList (force tailList (force tailList (force tailList i1))))))) +app (program 1.0.0 11) \ No newline at end of file diff --git a/plutarch-test/goldens/field.rangeFields.uplc.golden b/plutarch-test/goldens/field.rangeFields.uplc.golden new file mode 100644 index 000000000..1161c974b --- /dev/null +++ b/plutarch-test/goldens/field.rangeFields.uplc.golden @@ -0,0 +1,11 @@ +lam (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (i3 (i3 (i3 (i3 i1)))))) (force headList)) (force tailList))) +app (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (i3 (i3 (i3 (i3 i1)))))) [ #00 + , #01 + , #02 + , #03 + , #04 + , #05 + , #06 + , #07 + , #08 + , #09 ]) (force headList)) (force tailList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.bench.golden b/plutarch-test/goldens/field.trips.bench.golden new file mode 100644 index 000000000..880e5cc3a --- /dev/null +++ b/plutarch-test/goldens/field.trips.bench.golden @@ -0,0 +1,7 @@ +lam.tripSum {"exBudgetCPU":207100,"exBudgetMemory":1000,"scriptSizeBytes":46} +lam.getY {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":16} +lam.tripYZ {"exBudgetCPU":207100,"exBudgetMemory":1000,"scriptSizeBytes":36} +tripSum.A {"exBudgetCPU":2864483,"exBudgetMemory":8048,"scriptSizeBytes":80} +tripSum.B {"exBudgetCPU":2864483,"exBudgetMemory":8048,"scriptSizeBytes":77} +tripSum.C {"exBudgetCPU":2864483,"exBudgetMemory":8048,"scriptSizeBytes":77} +tripYZ=tripZY {"exBudgetCPU":207100,"exBudgetMemory":1000,"scriptSizeBytes":36} \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.getY.bench.golden b/plutarch-test/goldens/field.trips.getY.bench.golden deleted file mode 100644 index 98f9bc333..000000000 --- a/plutarch-test/goldens/field.trips.getY.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":16} \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.getY.uplc.eval.golden b/plutarch-test/goldens/field.trips.getY.uplc.eval.golden deleted file mode 100644 index 4afac955e..000000000 --- a/plutarch-test/goldens/field.trips.getY.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> force headList (force tailList (force (force sndPair) (unConstrData i1))))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.getY.uplc.golden b/plutarch-test/goldens/field.trips.getY.uplc.golden deleted file mode 100644 index 4afac955e..000000000 --- a/plutarch-test/goldens/field.trips.getY.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> force headList (force tailList (force (force sndPair) (unConstrData i1))))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.tripSum.bench.golden b/plutarch-test/goldens/field.trips.tripSum.bench.golden deleted file mode 100644 index 7902ff61e..000000000 --- a/plutarch-test/goldens/field.trips.tripSum.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":268057,"exBudgetMemory":1000,"scriptSizeBytes":46} \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.tripSum.uplc.eval.golden b/plutarch-test/goldens/field.trips.tripSum.uplc.eval.golden deleted file mode 100644 index 9322cb241..000000000 --- a/plutarch-test/goldens/field.trips.tripSum.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (force headList i2)) (unIData (force headList i1))) (unIData (force headList (force tailList i1)))) (force tailList i1)) (force (force sndPair) (unConstrData i1)))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.tripSum.uplc.golden b/plutarch-test/goldens/field.trips.tripSum.uplc.golden deleted file mode 100644 index d670900a9..000000000 --- a/plutarch-test/goldens/field.trips.tripSum.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 i1)))) (i4 i1)) (force (force sndPair) (unConstrData i1))) (force headList)) (force tailList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.tripYZ.bench.golden b/plutarch-test/goldens/field.trips.tripYZ.bench.golden deleted file mode 100644 index cb5716a05..000000000 --- a/plutarch-test/goldens/field.trips.tripYZ.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":268057,"exBudgetMemory":1000,"scriptSizeBytes":36} \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.tripYZ.uplc.eval.golden b/plutarch-test/goldens/field.trips.tripYZ.uplc.eval.golden deleted file mode 100644 index 33c95036e..000000000 --- a/plutarch-test/goldens/field.trips.tripYZ.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1)))) (force tailList (force (force sndPair) (unConstrData i1))))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.tripYZ.uplc.golden b/plutarch-test/goldens/field.trips.tripYZ.uplc.golden deleted file mode 100644 index 0f34eb5df..000000000 --- a/plutarch-test/goldens/field.trips.tripYZ.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (force (force sndPair) (unConstrData i1)))) (force headList)) (force tailList))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.uplc.eval.golden b/plutarch-test/goldens/field.trips.uplc.eval.golden new file mode 100644 index 000000000..f21ca2849 --- /dev/null +++ b/plutarch-test/goldens/field.trips.uplc.eval.golden @@ -0,0 +1,7 @@ +lam.tripSum (program 1.0.0 (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (force headList i2)) (unIData (force headList i1))) (unIData (force headList (force tailList i1)))) (force tailList i1)) (force (force sndPair) (unConstrData i1)))) +lam.getY (program 1.0.0 (\i0 -> force headList (force tailList (force (force sndPair) (unConstrData i1))))) +lam.tripYZ (program 1.0.0 (\i0 -> (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1)))) (force tailList (force (force sndPair) (unConstrData i1))))) +tripSum.A (program 1.0.0 1000) +tripSum.B (program 1.0.0 100) +tripSum.C (program 1.0.0 10) +tripYZ=tripZY (program 1.0.0 (\i0 -> (\i0 -> addInteger (unIData (force headList i1)) (unIData (force headList (force tailList i1)))) (force tailList (force (force sndPair) (unConstrData i1))))) \ No newline at end of file diff --git a/plutarch-test/goldens/field.trips.uplc.golden b/plutarch-test/goldens/field.trips.uplc.golden new file mode 100644 index 000000000..04daca150 --- /dev/null +++ b/plutarch-test/goldens/field.trips.uplc.golden @@ -0,0 +1,7 @@ +lam.tripSum (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 i1)))) (i4 i1)) (force (force sndPair) (unConstrData i1))) (force headList)) (force tailList))) +lam.getY (program 1.0.0 (\i0 -> force headList (force tailList (force (force sndPair) (unConstrData i1))))) +lam.tripYZ (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (force (force sndPair) (unConstrData i1)))) (force headList)) (force tailList))) +tripSum.A (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 i1)))) (i4 i1)) (force (force sndPair) (unConstrData i1))) (constrData 0 (i3 (iData 150) (i3 (iData 750) (i3 (iData 100) [ ]))))) (force headList)) (force tailList)) (force mkCons))) +tripSum.B (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 i1)))) (i4 i1)) (force (force sndPair) (unConstrData i1))) (constrData 0 (i3 (iData 50) (i3 (iData 10) (i3 (iData 40) [ ]))))) (force headList)) (force tailList)) (force mkCons))) +tripSum.C (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> addInteger (addInteger (unIData (i4 i2)) (unIData (i4 i1))) (unIData (i4 (i5 i1)))) (i4 i1)) (force (force sndPair) (unConstrData i1))) (constrData 0 (i3 (iData 1) (i3 (iData 8) (i3 (iData 1) [ ]))))) (force headList)) (force tailList)) (force mkCons))) +tripYZ=tripZY (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> addInteger (unIData (i3 i1)) (unIData (i3 (i4 i1)))) (i3 (force (force sndPair) (unConstrData i1)))) (force headList)) (force tailList))) \ No newline at end of file diff --git a/plutarch-test/goldens/int.examples.bench.golden b/plutarch-test/goldens/int.examples.bench.golden index 2928e8042..c0620fbca 100644 --- a/plutarch-test/goldens/int.examples.bench.golden +++ b/plutarch-test/goldens/int.examples.bench.golden @@ -1,7 +1,7 @@ -add1 {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":16} -add1Hoisted {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":16} -example1 {"exBudgetCPU":2057973,"exBudgetMemory":3710,"scriptSizeBytes":34} -example2 {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":21} -fib {"exBudgetCPU":416922,"exBudgetMemory":1500,"scriptSizeBytes":72} -fib.app.9 {"exBudgetCPU":187876376,"exBudgetMemory":433318,"scriptSizeBytes":75} -uglyDouble {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":10} \ No newline at end of file +add1 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":16} +add1Hoisted {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":16} +example1 {"exBudgetCPU":1860485,"exBudgetMemory":3710,"scriptSizeBytes":34} +example2 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":21} +fib.lam {"exBudgetCPU":322100,"exBudgetMemory":1500,"scriptSizeBytes":72} +fib.app.9 {"exBudgetCPU":189953707,"exBudgetMemory":433318,"scriptSizeBytes":75} +uglyDouble {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":10} \ No newline at end of file diff --git a/plutarch-test/goldens/int.examples.uplc.eval.golden b/plutarch-test/goldens/int.examples.uplc.eval.golden index 4a5acccef..94d064400 100644 --- a/plutarch-test/goldens/int.examples.uplc.eval.golden +++ b/plutarch-test/goldens/int.examples.uplc.eval.golden @@ -2,6 +2,6 @@ add1 (program 1.0.0 (\i0 -> \i0 -> addInteger (addInteger i2 i1) 1)) add1Hoisted (program 1.0.0 (\i0 -> \i0 -> addInteger (addInteger i2 i1) 1)) example1 (program 1.0.0 55) example2 (program 1.0.0 (\i0 -> i1 (\i0 -> addInteger i1 1) (\i0 -> subtractInteger i1 1))) -fib (program 1.0.0 (\i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger ((\i0 -> (\i0 -> (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) (\i0 -> i2 i2 i1)) (\i0 -> (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) (\i0 -> i2 i2 i1)) i1) (subtractInteger i1 1)) ((\i0 -> (\i0 -> (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) (\i0 -> i2 i2 i1)) (\i0 -> (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) (\i0 -> i2 i2 i1)) i1) (subtractInteger i1 2)))))))))) +fib.lam (program 1.0.0 (\i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger ((\i0 -> (\i0 -> (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) (\i0 -> i2 i2 i1)) (\i0 -> (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) (\i0 -> i2 i2 i1)) i1) (subtractInteger i1 1)) ((\i0 -> (\i0 -> (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) (\i0 -> i2 i2 i1)) (\i0 -> (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i1 0) (delay 0) (delay (force (force ifThenElse (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) (\i0 -> i2 i2 i1)) i1) (subtractInteger i1 2)))))))))) fib.app.9 (program 1.0.0 34) uglyDouble (program 1.0.0 (\i0 -> addInteger i1 i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/int.examples.uplc.golden b/plutarch-test/goldens/int.examples.uplc.golden index ebf5e4031..41ef79cf6 100644 --- a/plutarch-test/goldens/int.examples.uplc.golden +++ b/plutarch-test/goldens/int.examples.uplc.golden @@ -2,6 +2,6 @@ add1 (program 1.0.0 (\i0 -> \i0 -> addInteger (addInteger i2 i1) 1)) add1Hoisted (program 1.0.0 (\i0 -> \i0 -> addInteger (addInteger i2 i1) 1)) example1 (program 1.0.0 ((\i0 -> addInteger (i1 12 32) (i1 5 4)) (\i0 -> \i0 -> addInteger (addInteger i2 i1) 1))) example2 (program 1.0.0 (\i0 -> i1 (\i0 -> addInteger i1 1) (\i0 -> subtractInteger i1 1))) -fib (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (i3 (equalsInteger i1 0) (delay 0) (delay (force (i3 (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2)))))))))) (force ifThenElse))) +fib.lam (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (i3 (equalsInteger i1 0) (delay 0) (delay (force (i3 (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2)))))))))) (force ifThenElse))) fib.app.9 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (i3 (equalsInteger i1 0) (delay 0) (delay (force (i3 (equalsInteger i1 1) (delay 1) (delay (addInteger (i2 (subtractInteger i1 1)) (i2 (subtractInteger i1 2))))))))) 9) (force ifThenElse))) uglyDouble (program 1.0.0 (\i0 -> addInteger i1 i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/lift.pconstantData.bench.golden b/plutarch-test/goldens/lift.pconstantData.bench.golden new file mode 100644 index 000000000..e4b5a3db3 --- /dev/null +++ b/plutarch-test/goldens/lift.pconstantData.bench.golden @@ -0,0 +1,5 @@ +bool {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":12} +int {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":11} +pkh {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":12} +minting {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":14} +txoutref {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":20} \ No newline at end of file diff --git a/plutarch-test/goldens/lift.pconstantData.uplc.eval.golden b/plutarch-test/goldens/lift.pconstantData.uplc.eval.golden new file mode 100644 index 000000000..aa6b1e15c --- /dev/null +++ b/plutarch-test/goldens/lift.pconstantData.uplc.eval.golden @@ -0,0 +1,5 @@ +bool (program 1.0.0 #d87980) +int (program 1.0.0 #182a) +pkh (program 1.0.0 #423034) +minting (program 1.0.0 #d8799f40ff) +txoutref (program 1.0.0 #d8799fd8799f4141ff0cff) \ No newline at end of file diff --git a/plutarch-test/goldens/lift.pconstantData.uplc.golden b/plutarch-test/goldens/lift.pconstantData.uplc.golden new file mode 100644 index 000000000..aa6b1e15c --- /dev/null +++ b/plutarch-test/goldens/lift.pconstantData.uplc.golden @@ -0,0 +1,5 @@ +bool (program 1.0.0 #d87980) +int (program 1.0.0 #182a) +pkh (program 1.0.0 #423034) +minting (program 1.0.0 #d8799f40ff) +txoutref (program 1.0.0 #d8799fd8799f4141ff0cff) \ No newline at end of file diff --git a/plutarch-test/goldens/list.bench.golden b/plutarch-test/goldens/list.bench.golden new file mode 100644 index 000000000..935c4fdd8 --- /dev/null +++ b/plutarch-test/goldens/list.bench.golden @@ -0,0 +1,25 @@ +pmatch {"exBudgetCPU":954809,"exBudgetMemory":420,"scriptSizeBytes":63} +phead {"exBudgetCPU":11768237,"exBudgetMemory":39293,"scriptSizeBytes":79} +ptail {"exBudgetCPU":34066124,"exBudgetMemory":115806,"scriptSizeBytes":142} +pnull.empty {"exBudgetCPU":957454,"exBudgetMemory":3532,"scriptSizeBytes":64} +pnull.nonempty {"exBudgetCPU":11777860,"exBudgetMemory":39893,"scriptSizeBytes":84} +pconcat.identity {"exBudgetCPU":80305252,"exBudgetMemory":279509,"scriptSizeBytes":188} +pmap.eg {"exBudgetCPU":47260168,"exBudgetMemory":161924,"scriptSizeBytes":163} +pmap.identity {"exBudgetCPU":1334100,"exBudgetMemory":5900,"scriptSizeBytes":97} +pfilter.evens {"exBudgetCPU":42495518,"exBudgetMemory":129344,"scriptSizeBytes":175} +pfilter.gt5 {"exBudgetCPU":37045658,"exBudgetMemory":125334,"scriptSizeBytes":170} +pzipWith.double {"exBudgetCPU":60015372,"exBudgetMemory":206316,"scriptSizeBytes":174} +pfoldl.nonempty {"exBudgetCPU":21216007,"exBudgetMemory":71413,"scriptSizeBytes":96} +pfoldl.nonempty-primed {"exBudgetCPU":21216007,"exBudgetMemory":71413,"scriptSizeBytes":96} +pfoldl.empty {"exBudgetCPU":1603387,"exBudgetMemory":5433,"scriptSizeBytes":85} +pfoldl.empty-primed {"exBudgetCPU":1603387,"exBudgetMemory":5433,"scriptSizeBytes":85} +elemAt.elemAt_3_[1..10] {"exBudgetCPU":17628654,"exBudgetMemory":56708,"scriptSizeBytes":157} +elemAt.elemAt_0_[1..10] {"exBudgetCPU":13173756,"exBudgetMemory":43796,"scriptSizeBytes":157} +elemAt.elemAt_9_[1..10] {"exBudgetCPU":26538450,"exBudgetMemory":82532,"scriptSizeBytes":157} +find.find_(==3)_[1..4] {"exBudgetCPU":8776061,"exBudgetMemory":29622,"scriptSizeBytes":100} +find.find_(==5)_[1..4] {"exBudgetCPU":10583550,"exBudgetMemory":36224,"scriptSizeBytes":100} +x1+x2.builtin {"exBudgetCPU":771257,"exBudgetMemory":2098,"scriptSizeBytes":29} +x1+x2.pmatch {"exBudgetCPU":1673965,"exBudgetMemory":4562,"scriptSizeBytes":48} +uncons.ChooseList {"exBudgetCPU":607636,"exBudgetMemory":1864,"scriptSizeBytes":26} +uncons.head-and-tail {"exBudgetCPU":383531,"exBudgetMemory":1464,"scriptSizeBytes":23} +uncons.head-and-tail-and-null {"exBudgetCPU":869178,"exBudgetMemory":2997,"scriptSizeBytes":35} \ No newline at end of file diff --git a/plutarch-test/goldens/list.pconcat.identity.bench.golden b/plutarch-test/goldens/list.pconcat.identity.bench.golden deleted file mode 100644 index 520fbab6c..000000000 --- a/plutarch-test/goldens/list.pconcat.identity.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":2054437,"exBudgetMemory":7000,"scriptSizeBytes":64} \ No newline at end of file diff --git a/plutarch-test/goldens/list.pconcat.identity.uplc.eval.golden b/plutarch-test/goldens/list.pconcat.identity.uplc.eval.golden deleted file mode 100644 index a6fe1ca52..000000000 --- a/plutarch-test/goldens/list.pconcat.identity.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> i2 0 (\i0 -> \i0 -> force i1))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pconcat.identity.uplc.golden b/plutarch-test/goldens/list.pconcat.identity.uplc.golden deleted file mode 100644 index c2c095d0d..000000000 --- a/plutarch-test/goldens/list.pconcat.identity.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i7 i2 (i4 i1)) (delay i3)) i2) ((\i0 -> i2 i1 (\i0 -> \i0 -> force i1)) 0) (\i0 -> \i0 -> force i1)) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pfilter.bench.golden b/plutarch-test/goldens/list.pfilter.bench.golden deleted file mode 100644 index fa1a61ba1..000000000 --- a/plutarch-test/goldens/list.pfilter.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -p1 {"exBudgetCPU":35949366,"exBudgetMemory":87322,"scriptSizeBytes":115} -p2 {"exBudgetCPU":30925386,"exBudgetMemory":83312,"scriptSizeBytes":110} \ No newline at end of file diff --git a/plutarch-test/goldens/list.pfilter.uplc.eval.golden b/plutarch-test/goldens/list.pfilter.uplc.eval.golden deleted file mode 100644 index 6ae3f0591..000000000 --- a/plutarch-test/goldens/list.pfilter.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -p1 (program 1.0.0 (\i0 -> \i0 -> i2 2 (\i0 -> \i0 -> i2 4 (\i0 -> \i0 -> i2 6 (\i0 -> \i0 -> i2 8 (\i0 -> \i0 -> i2 10 (\i0 -> \i0 -> force i1))))))) -p2 (program 1.0.0 (\i0 -> \i0 -> i2 6 (\i0 -> \i0 -> i2 7 (\i0 -> \i0 -> i2 8 (\i0 -> \i0 -> i2 9 (\i0 -> \i0 -> i2 10 (\i0 -> \i0 -> force i1))))))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pfilter.uplc.golden b/plutarch-test/goldens/list.pfilter.uplc.golden deleted file mode 100644 index 091b0f066..000000000 --- a/plutarch-test/goldens/list.pfilter.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -p1 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> force (force ifThenElse (i5 i2) (delay (i7 i2 (i4 i1))) (delay (i4 i1)))) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> equalsInteger (modInteger i1 2) 0) (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (i4 (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3))) -p2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> force (force ifThenElse (i5 i2) (delay (i7 i2 (i4 i1))) (delay (i4 i1)))) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> lessThanInteger 5 i1) (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (i4 (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pfoldl.bench.golden b/plutarch-test/goldens/list.pfoldl.bench.golden deleted file mode 100644 index 5f2f40417..000000000 --- a/plutarch-test/goldens/list.pfoldl.bench.golden +++ /dev/null @@ -1,4 +0,0 @@ -p1 {"exBudgetCPU":27433517,"exBudgetMemory":71012,"scriptSizeBytes":92} -p1' {"exBudgetCPU":27433517,"exBudgetMemory":71012,"scriptSizeBytes":92} -p2 {"exBudgetCPU":1608977,"exBudgetMemory":5032,"scriptSizeBytes":80} -p2' {"exBudgetCPU":1608977,"exBudgetMemory":5032,"scriptSizeBytes":80} \ No newline at end of file diff --git a/plutarch-test/goldens/list.pfoldl.uplc.eval.golden b/plutarch-test/goldens/list.pfoldl.uplc.eval.golden deleted file mode 100644 index 934031787..000000000 --- a/plutarch-test/goldens/list.pfoldl.uplc.eval.golden +++ /dev/null @@ -1,4 +0,0 @@ -p1 (program 1.0.0 -55) -p1' (program 1.0.0 -55) -p2 (program 1.0.0 0) -p2' (program 1.0.0 0) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pfoldl.uplc.golden b/plutarch-test/goldens/list.pfoldl.uplc.golden deleted file mode 100644 index 20449fe5f..000000000 --- a/plutarch-test/goldens/list.pfoldl.uplc.golden +++ /dev/null @@ -1,4 +0,0 @@ -p1 (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (subtractInteger i4 i2) i1) (delay i2)) 0 (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) -p1' (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (subtractInteger i4 i2) i1) (delay i2)) 0 (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) -p2 (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (subtractInteger i4 i2) i1) (delay i2)) 0 (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) -p2' (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (subtractInteger i4 i2) i1) (delay i2)) 0 (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.phead.bench.golden b/plutarch-test/goldens/list.phead.bench.golden deleted file mode 100644 index df2056587..000000000 --- a/plutarch-test/goldens/list.phead.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":15904294,"exBudgetMemory":38892,"scriptSizeBytes":75} \ No newline at end of file diff --git a/plutarch-test/goldens/list.phead.uplc.eval.golden b/plutarch-test/goldens/list.phead.uplc.eval.golden deleted file mode 100644 index bfe2c27c9..000000000 --- a/plutarch-test/goldens/list.phead.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 1) \ No newline at end of file diff --git a/plutarch-test/goldens/list.phead.uplc.golden b/plutarch-test/goldens/list.phead.uplc.golden deleted file mode 100644 index 5e1f40f29..000000000 --- a/plutarch-test/goldens/list.phead.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> i2) (delay error)) ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10]))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pmap.bench.golden b/plutarch-test/goldens/list.pmap.bench.golden deleted file mode 100644 index 978a33629..000000000 --- a/plutarch-test/goldens/list.pmap.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":29309216,"exBudgetMemory":77312,"scriptSizeBytes":99} \ No newline at end of file diff --git a/plutarch-test/goldens/list.pmap.uplc.eval.golden b/plutarch-test/goldens/list.pmap.uplc.eval.golden deleted file mode 100644 index f5958794f..000000000 --- a/plutarch-test/goldens/list.pmap.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> i2 2 (\i0 -> \i0 -> i2 4 (\i0 -> \i0 -> i2 6 (\i0 -> \i0 -> i2 8 (\i0 -> \i0 -> i2 10 (\i0 -> \i0 -> i2 12 (\i0 -> \i0 -> i2 14 (\i0 -> \i0 -> i2 16 (\i0 -> \i0 -> i2 18 (\i0 -> \i0 -> i2 20 (\i0 -> \i0 -> force i1)))))))))))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pmap.uplc.golden b/plutarch-test/goldens/list.pmap.uplc.golden deleted file mode 100644 index ad1169d66..000000000 --- a/plutarch-test/goldens/list.pmap.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i7 (i5 i2) (i4 i1)) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> addInteger i1 i1) (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay (i4 (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pmatch.uplc.eval.golden b/plutarch-test/goldens/list.pmatch.uplc.eval.golden deleted file mode 100644 index 046ef4db8..000000000 --- a/plutarch-test/goldens/list.pmatch.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 error) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pmatch.uplc.golden b/plutarch-test/goldens/list.pmatch.uplc.golden deleted file mode 100644 index 7c74576bf..000000000 --- a/plutarch-test/goldens/list.pmatch.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,3,1] (\i0 -> \i0 -> error) (delay error))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pnull.bench.golden b/plutarch-test/goldens/list.pnull.bench.golden deleted file mode 100644 index b1909ab24..000000000 --- a/plutarch-test/goldens/list.pnull.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -p0 {"exBudgetCPU":1162382,"exBudgetMemory":3532,"scriptSizeBytes":64} -p1 {"exBudgetCPU":15904294,"exBudgetMemory":38892,"scriptSizeBytes":75} \ No newline at end of file diff --git a/plutarch-test/goldens/list.pnull.uplc.eval.golden b/plutarch-test/goldens/list.pnull.uplc.eval.golden deleted file mode 100644 index 13f0e5ad0..000000000 --- a/plutarch-test/goldens/list.pnull.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -p0 (program 1.0.0 True) -p1 (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pnull.uplc.golden b/plutarch-test/goldens/list.pnull.uplc.golden deleted file mode 100644 index a685f05af..000000000 --- a/plutarch-test/goldens/list.pnull.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -p0 (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> False) (delay True)) ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) []))) -p1 (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> False) (delay True)) ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10]))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.ptail.bench.golden b/plutarch-test/goldens/list.ptail.bench.golden deleted file mode 100644 index df2056587..000000000 --- a/plutarch-test/goldens/list.ptail.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":15904294,"exBudgetMemory":38892,"scriptSizeBytes":75} \ No newline at end of file diff --git a/plutarch-test/goldens/list.ptail.uplc.eval.golden b/plutarch-test/goldens/list.ptail.uplc.eval.golden deleted file mode 100644 index 1dbbd6e3c..000000000 --- a/plutarch-test/goldens/list.ptail.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> i2 2 (\i0 -> \i0 -> i2 3 (\i0 -> \i0 -> i2 4 (\i0 -> \i0 -> i2 5 (\i0 -> \i0 -> i2 6 (\i0 -> \i0 -> i2 7 (\i0 -> \i0 -> i2 8 (\i0 -> \i0 -> i2 9 (\i0 -> \i0 -> i2 10 (\i0 -> \i0 -> force i1))))))))))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.ptail.uplc.golden b/plutarch-test/goldens/list.ptail.uplc.golden deleted file mode 100644 index 0d8e97d35..000000000 --- a/plutarch-test/goldens/list.ptail.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> i1) (delay error)) ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10]))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pzipWith.bench.golden b/plutarch-test/goldens/list.pzipWith.bench.golden deleted file mode 100644 index 7d51287d0..000000000 --- a/plutarch-test/goldens/list.pzipWith.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":46106600,"exBudgetMemory":119104,"scriptSizeBytes":120} \ No newline at end of file diff --git a/plutarch-test/goldens/list.pzipWith.uplc.eval.golden b/plutarch-test/goldens/list.pzipWith.uplc.eval.golden deleted file mode 100644 index f5958794f..000000000 --- a/plutarch-test/goldens/list.pzipWith.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> i2 2 (\i0 -> \i0 -> i2 4 (\i0 -> \i0 -> i2 6 (\i0 -> \i0 -> i2 8 (\i0 -> \i0 -> i2 10 (\i0 -> \i0 -> i2 12 (\i0 -> \i0 -> i2 14 (\i0 -> \i0 -> i2 16 (\i0 -> \i0 -> i2 18 (\i0 -> \i0 -> i2 20 (\i0 -> \i0 -> force i1)))))))))))) \ No newline at end of file diff --git a/plutarch-test/goldens/list.pzipWith.uplc.golden b/plutarch-test/goldens/list.pzipWith.uplc.golden deleted file mode 100644 index d44aef59c..000000000 --- a/plutarch-test/goldens/list.pzipWith.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i11 (addInteger i4 i2) (i7 i3 i1)) (delay (\i0 -> \i0 -> force i1))) (delay (\i0 -> \i0 -> force i1))) (i1 i7) (i1 i7)) (i1 (\i0 -> \i0 -> force (i4 i1 (delay (\i0 -> \i0 -> force i1)) (delay (i5 (i6 i1) (i2 (i7 i1)))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3)) (force headList)) (force tailList)) [1,2,3,4,5,6,7,8,9,10])) \ No newline at end of file diff --git a/plutarch-test/goldens/list.uplc.eval.golden b/plutarch-test/goldens/list.uplc.eval.golden new file mode 100644 index 000000000..24db9cb06 --- /dev/null +++ b/plutarch-test/goldens/list.uplc.eval.golden @@ -0,0 +1,25 @@ +pmatch (program 1.0.0 error) +phead (program 1.0.0 True) +ptail (program 1.0.0 True) +pnull.empty (program 1.0.0 True) +pnull.nonempty (program 1.0.0 True) +pconcat.identity (program 1.0.0 True) +pmap.eg (program 1.0.0 True) +pmap.identity (program 1.0.0 True) +pfilter.evens (program 1.0.0 True) +pfilter.gt5 (program 1.0.0 True) +pzipWith.double (program 1.0.0 True) +pfoldl.nonempty (program 1.0.0 True) +pfoldl.nonempty-primed (program 1.0.0 True) +pfoldl.empty (program 1.0.0 True) +pfoldl.empty-primed (program 1.0.0 True) +elemAt.elemAt_3_[1..10] (program 1.0.0 4) +elemAt.elemAt_0_[1..10] (program 1.0.0 1) +elemAt.elemAt_9_[1..10] (program 1.0.0 10) +find.find_(==3)_[1..4] (program 1.0.0 (\i0 -> \i0 -> i2 3)) +find.find_(==5)_[1..4] (program 1.0.0 (\i0 -> \i0 -> force i1)) +x1+x2.builtin (program 1.0.0 3) +x1+x2.pmatch (program 1.0.0 3) +uncons.ChooseList (program 1.0.0 [2,3,4,5]) +uncons.head-and-tail (program 1.0.0 [2,3,4,5]) +uncons.head-and-tail-and-null (program 1.0.0 [2,3,4,5]) \ No newline at end of file diff --git a/plutarch-test/goldens/list.uplc.golden b/plutarch-test/goldens/list.uplc.golden new file mode 100644 index 000000000..7027f46c2 --- /dev/null +++ b/plutarch-test/goldens/list.uplc.golden @@ -0,0 +1,25 @@ +pmatch (program 1.0.0 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,3,1] (\i0 -> \i0 -> error) (delay error))) +phead (program 1.0.0 (equalsInteger 1 ((\i0 -> i1 (\i0 -> \i0 -> i2) (delay error)) ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])))) +ptail (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i4 i2) (delay (i7 i3 i1)) (delay False))) (delay False)) (delay (i1 (\i0 -> \i0 -> False) (delay True)))) (i1 [2,3,4,5,6,7,8,9,10]) ((\i0 -> i1 (\i0 -> \i0 -> i1) (delay error)) (i1 [1,2,3,4,5,6,7,8,9,10]))) (i1 (\i0 -> \i0 -> force (i4 i1 (delay (\i0 -> \i0 -> force i1)) (delay (i5 (i6 i1) (i2 (i7 i1)))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3)) (force headList)) (force tailList))) +pnull.empty (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> False) (delay True)) ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) []))) +pnull.nonempty (program 1.0.0 ((\i0 -> force ifThenElse i1 False True) ((\i0 -> i1 (\i0 -> \i0 -> False) (delay True)) ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])))) +pconcat.identity (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force ((\i0 -> \i0 -> i4 i2 i1 (delay False)) (i1 (i3 (i4 i10) (\i0 -> \i0 -> force i1)) (i3 (\i0 -> \i0 -> force i1) (i4 i10))) (delay (i1 (i3 (\i0 -> \i0 -> force i1) (i4 i10)) (i4 i10))))) (i4 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (i8 (equalsInteger i4 i2) (delay (i7 i3 i1)) (delay False))) (delay False)) (delay (i1 (\i0 -> \i0 -> False) (delay True)))))) (force ifThenElse)) (\i0 -> \i0 -> i4 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i10 i2 (i4 i1)) (delay i3)) i2)) (i1 (\i0 -> \i0 -> force (i4 i1 (delay (\i0 -> \i0 -> force i1)) (delay (i5 (i6 i1) (i2 (i7 i1)))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3)) (force headList)) (force tailList)) [1,2,3,4,5,6,7,8,9,10])) +pmap.eg (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i4 i2) (delay (i7 i3 i1)) (delay False))) (delay False)) (delay (i1 (\i0 -> \i0 -> False) (delay True)))) ((\i0 -> i3 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i9 (i5 i2) (i4 i1)) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> addInteger i1 i1) (i1 [1,2,3,4,5,6,7,8,9,10])) (i1 [2,4,6,8,10,12,14,16,18,20])) (i1 (\i0 -> \i0 -> force (i4 i1 (delay (\i0 -> \i0 -> force i1)) (delay (i5 (i6 i1) (i2 (i7 i1)))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3)) (force headList)) (force tailList))) +pmap.identity (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i4 i2) (delay (i7 i3 i1)) (delay False))) (delay False)) (delay (i1 (\i0 -> \i0 -> False) (delay True)))) ((\i0 -> i2 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (i5 i2) (i4 i1)) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> i1) (\i0 -> \i0 -> force i1)) (\i0 -> \i0 -> force i1)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +pfilter.evens (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i3 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (i8 (equalsInteger i4 i2) (delay (i7 i3 i1)) (delay False))) (delay False)) (delay (i1 (\i0 -> \i0 -> False) (delay True)))) ((\i0 -> i4 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> force (i6 (i5 i2) (delay (i10 i2 (i4 i1))) (delay (i4 i1)))) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> equalsInteger (modInteger i1 2) 0) (i2 [1,2,3,4,5,6,7,8,9,10])) (i2 [2,4,6,8,10])) (force ifThenElse)) (i1 (\i0 -> \i0 -> force (i4 i1 (delay (\i0 -> \i0 -> force i1)) (delay (i5 (i6 i1) (i2 (i7 i1)))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3)) (force headList)) (force tailList))) +pfilter.gt5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i3 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (i8 (equalsInteger i4 i2) (delay (i7 i3 i1)) (delay False))) (delay False)) (delay (i1 (\i0 -> \i0 -> False) (delay True)))) ((\i0 -> i4 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> force (i6 (i5 i2) (delay (i10 i2 (i4 i1))) (delay (i4 i1)))) (delay (\i0 -> \i0 -> force i1)))) (\i0 -> lessThanInteger 5 i1) (i2 [1,2,3,4,5,6,7,8,9,10])) (i2 [6,7,8,9,10])) (force ifThenElse)) (i1 (\i0 -> \i0 -> force (i4 i1 (delay (\i0 -> \i0 -> force i1)) (delay (i5 (i6 i1) (i2 (i7 i1)))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3)) (force headList)) (force tailList))) +pzipWith.double (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i3 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force (force ifThenElse (equalsInteger i4 i2) (delay (i7 i3 i1)) (delay False))) (delay False)) (delay (i1 (\i0 -> \i0 -> False) (delay True)))) (i3 (\i0 -> \i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i12 (addInteger i4 i2) (i7 i3 i1)) (delay (\i0 -> \i0 -> force i1))) (delay (\i0 -> \i0 -> force i1))) (i2 i1) (i2 i1)) (i2 [2,4,6,8,10,12,14,16,18,20])) [1,2,3,4,5,6,7,8,9,10]) (i1 (\i0 -> \i0 -> force (i4 i1 (delay (\i0 -> \i0 -> force i1)) (delay (i5 (i6 i1) (i2 (i7 i1)))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force (force chooseList))) (\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3)) (force headList)) (force tailList))) +pfoldl.nonempty (program 1.0.0 ((\i0 -> equalsInteger (i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (subtractInteger i4 i2) i1) (delay i2)) 0 (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) -55) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +pfoldl.nonempty-primed (program 1.0.0 ((\i0 -> equalsInteger (i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (subtractInteger i4 i2) i1) (delay i2)) 0 (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) -55) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +pfoldl.empty (program 1.0.0 ((\i0 -> equalsInteger (i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (subtractInteger i4 i2) i1) (delay i2)) 0 (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [])) 0) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +pfoldl.empty-primed (program 1.0.0 ((\i0 -> equalsInteger (i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> i5 (subtractInteger i4 i2) i1) (delay i2)) 0 (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [])) 0) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +elemAt.elemAt_3_[1..10] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> force (i3 (lessThanInteger i2 0) (delay (force (force trace "pelemAt: negative index" (delay error)))) (delay (i4 (\i0 -> \i0 -> \i0 -> force (i6 (equalsInteger i2 0) (delay (i1 (\i0 -> \i0 -> i2) (delay error))) (delay (i3 (subtractInteger i2 1) (i1 (\i0 -> \i0 -> i1) (delay error)))))) i2 i1)))) 3 (i2 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) (force ifThenElse)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +elemAt.elemAt_0_[1..10] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> force (i3 (lessThanInteger i2 0) (delay (force (force trace "pelemAt: negative index" (delay error)))) (delay (i4 (\i0 -> \i0 -> \i0 -> force (i6 (equalsInteger i2 0) (delay (i1 (\i0 -> \i0 -> i2) (delay error))) (delay (i3 (subtractInteger i2 1) (i1 (\i0 -> \i0 -> i1) (delay error)))))) i2 i1)))) 0 (i2 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) (force ifThenElse)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +elemAt.elemAt_9_[1..10] (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> \i0 -> force (i3 (lessThanInteger i2 0) (delay (force (force trace "pelemAt: negative index" (delay error)))) (delay (i4 (\i0 -> \i0 -> \i0 -> force (i6 (equalsInteger i2 0) (delay (i1 (\i0 -> \i0 -> i2) (delay error))) (delay (i3 (subtractInteger i2 1) (i1 (\i0 -> \i0 -> i1) (delay error)))))) i2 i1)))) 9 (i2 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4,5,6,7,8,9,10])) (force ifThenElse)) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +find.find_(==3)_[1..4] (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> force (force ifThenElse (i4 i2) (delay (\i0 -> \i0 -> i2 i4)) (delay (i5 i4 i1)))) (delay (\i0 -> \i0 -> force i1))) (\i0 -> equalsInteger i1 3) (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +find.find_(==5)_[1..4] (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> \i0 -> i1 (\i0 -> \i0 -> force (force ifThenElse (i4 i2) (delay (\i0 -> \i0 -> i2 i4)) (delay (i5 i4 i1)))) (delay (\i0 -> \i0 -> force i1))) (\i0 -> equalsInteger i1 5) (i1 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3,4])) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +x1+x2.builtin (program 1.0.0 ((\i0 -> (\i0 -> addInteger (i1 (force tailList i2)) (i1 i2)) (force headList)) [1,2,3,4,5])) +x1+x2.pmatch (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> force (i1 i3 (delay error) (delay ((\i0 -> force (i2 i1 (delay error) (delay (addInteger (i3 i4) (i3 i1))))) (force tailList i3))))) (force (force chooseList))) (force headList)) [1,2,3,4,5])) +uncons.ChooseList (program 1.0.0 ((\i0 -> force (force (force chooseList) i1 (delay error) (delay (force tailList i1)))) [1,2,3,4,5])) +uncons.head-and-tail (program 1.0.0 ((\i0 -> (\i0 -> force tailList i2) (force headList i1)) [1,2,3,4,5])) +uncons.head-and-tail-and-null (program 1.0.0 ((\i0 -> (\i0 -> force (force ifThenElse i1 (delay error) (delay ((\i0 -> force tailList i3) (force headList i2))))) (force nullList i1)) [1,2,3,4,5])) \ No newline at end of file diff --git a/plutarch-test/goldens/maybe.bench.golden b/plutarch-test/goldens/maybe.bench.golden new file mode 100644 index 000000000..fb0145e39 --- /dev/null +++ b/plutarch-test/goldens/maybe.bench.golden @@ -0,0 +1,6 @@ +eq.true.nothing {"exBudgetCPU":529100,"exBudgetMemory":2400,"scriptSizeBytes":34} +eq.true.just {"exBudgetCPU":1014033,"exBudgetMemory":3601,"scriptSizeBytes":43} +eq.false.nothing-just {"exBudgetCPU":621100,"exBudgetMemory":2800,"scriptSizeBytes":38} +eq.false.just-just {"exBudgetCPU":1014033,"exBudgetMemory":3601,"scriptSizeBytes":43} +pfromJust.nothing {"exBudgetCPU":100,"exBudgetMemory":100,"scriptSizeBytes":14} +pfromJust.just {"exBudgetCPU":669033,"exBudgetMemory":2101,"scriptSizeBytes":23} \ No newline at end of file diff --git a/plutarch-test/goldens/maybe.uplc.eval.golden b/plutarch-test/goldens/maybe.uplc.eval.golden new file mode 100644 index 000000000..cc715c6f3 --- /dev/null +++ b/plutarch-test/goldens/maybe.uplc.eval.golden @@ -0,0 +1,6 @@ +eq.true.nothing (program 1.0.0 True) +eq.true.just (program 1.0.0 True) +eq.false.nothing-just (program 1.0.0 False) +eq.false.just-just (program 1.0.0 False) +pfromJust.nothing (program 1.0.0 error) +pfromJust.just (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/maybe.uplc.golden b/plutarch-test/goldens/maybe.uplc.golden new file mode 100644 index 000000000..baa62a58d --- /dev/null +++ b/plutarch-test/goldens/maybe.uplc.golden @@ -0,0 +1,6 @@ +eq.true.nothing (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (delay False)) (delay (i1 (\i0 -> False) (delay True)))) (\i0 -> \i0 -> force i1) (\i0 -> \i0 -> force i1))) +eq.true.just (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (delay False)) (delay (i1 (\i0 -> False) (delay True)))) ((\i0 -> \i0 -> \i0 -> i2 i3) 42) ((\i0 -> \i0 -> \i0 -> i2 i3) 42))) +eq.false.nothing-just (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (delay False)) (delay (i1 (\i0 -> False) (delay True)))) (\i0 -> \i0 -> force i1) ((\i0 -> \i0 -> \i0 -> i2 i3) 42))) +eq.false.just-just (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> i2 (\i0 -> equalsInteger i2 i1) (delay False)) (delay (i1 (\i0 -> False) (delay True)))) ((\i0 -> \i0 -> \i0 -> i2 i3) 24) ((\i0 -> \i0 -> \i0 -> i2 i3) 42))) +pfromJust.nothing (program 1.0.0 ((\i0 -> i1 (\i0 -> i1) (delay error)) (\i0 -> \i0 -> force i1))) +pfromJust.just (program 1.0.0 (equalsInteger ((\i0 -> i1 (\i0 -> i1) (delay error)) ((\i0 -> \i0 -> \i0 -> i2 i3) 42)) 42)) \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.getFields.bench.golden b/plutarch-test/goldens/monadic.api.example.getFields.bench.golden index b8e62d0c1..4855f700a 100644 --- a/plutarch-test/goldens/monadic.api.example.getFields.bench.golden +++ b/plutarch-test/goldens/monadic.api.example.getFields.bench.golden @@ -1 +1 @@ -0 {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":11} \ No newline at end of file +0 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":11} \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.bench.golden b/plutarch-test/goldens/monadic.api.example.signatory.bench.golden new file mode 100644 index 000000000..a934ec699 --- /dev/null +++ b/plutarch-test/goldens/monadic.api.example.signatory.bench.golden @@ -0,0 +1,2 @@ +do.succeeds {"exBudgetCPU":6217368,"exBudgetMemory":16009,"scriptSizeBytes":390} +do.fails {"exBudgetCPU":10465180,"exBudgetMemory":21069,"scriptSizeBytes":386} \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.bench.golden b/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.bench.golden deleted file mode 100644 index 8705ffc87..000000000 --- a/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":8163467,"exBudgetMemory":16009,"scriptSizeBytes":290} \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.uplc.eval.golden b/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.uplc.eval.golden deleted file mode 100644 index 582b47c79..000000000 --- a/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.uplc.golden b/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.uplc.golden deleted file mode 100644 index ed510fea3..000000000 --- a/plutarch-test/goldens/monadic.api.example.signatory.dev=false.haskell.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) (unListData ((\i0 -> i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1))) (i8 i4)))) (delay ()) (delay error)))) (delay error))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.bench.golden b/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.bench.golden deleted file mode 100644 index 5bf28846b..000000000 --- a/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":8163467,"exBudgetMemory":16009,"scriptSizeBytes":382} \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.uplc.eval.golden b/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.uplc.eval.golden deleted file mode 100644 index 582b47c79..000000000 --- a/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.uplc.golden b/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.uplc.golden deleted file mode 100644 index fd936ba65..000000000 --- a/plutarch-test/goldens/monadic.api.example.signatory.dev=true.haskell.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) (unListData ((\i0 -> i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1))) (i8 i4)))) (delay ()) (delay error)))) (delay (force (force trace "Pattern match failure in qualified 'do' block at src/Plutarch/MonadicSpec.hs:44:5-15" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.uplc.eval.golden b/plutarch-test/goldens/monadic.api.example.signatory.uplc.eval.golden new file mode 100644 index 000000000..a9c117adc --- /dev/null +++ b/plutarch-test/goldens/monadic.api.example.signatory.uplc.eval.golden @@ -0,0 +1,2 @@ +do.succeeds (program 1.0.0 ()) +do.fails (program 1.0.0 error) \ No newline at end of file diff --git a/plutarch-test/goldens/monadic.api.example.signatory.uplc.golden b/plutarch-test/goldens/monadic.api.example.signatory.uplc.golden new file mode 100644 index 000000000..03ca95ab4 --- /dev/null +++ b/plutarch-test/goldens/monadic.api.example.signatory.uplc.golden @@ -0,0 +1,2 @@ +do.succeeds (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) (unListData ((\i0 -> i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1))) (i8 i4)))) (delay ()) (delay error)))) (delay (force (force trace "Pattern match failure in qualified 'do' block at conditional/Plutarch/MonadicSpec.hs:79:5-15" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #ab01fe235c #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +do.fails (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (force (i7 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i10 (equalsData (i11 i1) i3) (delay True) (delay (i2 (i12 i1))))))))) (bData i6) (unListData ((\i0 -> i9 ((\i0 -> i11 (i11 (i11 (i11 (i11 (i11 (i11 i1))))))) (i11 i1))) (i8 i4)))) (delay ()) (delay error)))) (delay (force (force trace "Pattern match failure in qualified 'do' block at conditional/Plutarch/MonadicSpec.hs:79:5-15" (delay error)))))) (i10 i2)) (force (force fstPair) i1)) (unConstrData (i5 (i6 i1)))) (i6 i1)) #41 #d8799fd8799f9fd8799fd8799fd8799f41a0ff00ffd8799fd8799fd87a9f41a1ffd87a80ffa0d8799f41d0ffffffff80a0a141c0a149736f6d65746f6b656e018080d8799fd8799fd87980d87a80ffd8799fd87b80d87a80ffff9f45ab01fe235c4312301443abcdefff80d8799f41b0ffffd87a9fd8799fd8799f41a0ff00ffffff) (force ifThenElse)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/pair.bench.golden b/plutarch-test/goldens/pair.bench.golden new file mode 100644 index 000000000..b5d9560cf --- /dev/null +++ b/plutarch-test/goldens/pair.bench.golden @@ -0,0 +1,4 @@ +eq.true {"exBudgetCPU":1866579,"exBudgetMemory":5803,"scriptSizeBytes":64} +eq.false.fst {"exBudgetCPU":1508589,"exBudgetMemory":5402,"scriptSizeBytes":64} +eq.false.snd {"exBudgetCPU":1797579,"exBudgetMemory":5503,"scriptSizeBytes":69} +eq.false.both {"exBudgetCPU":1439589,"exBudgetMemory":5102,"scriptSizeBytes":69} \ No newline at end of file diff --git a/plutarch-test/goldens/pair.uplc.eval.golden b/plutarch-test/goldens/pair.uplc.eval.golden new file mode 100644 index 000000000..f93364c5e --- /dev/null +++ b/plutarch-test/goldens/pair.uplc.eval.golden @@ -0,0 +1,4 @@ +eq.true (program 1.0.0 True) +eq.false.fst (program 1.0.0 False) +eq.false.snd (program 1.0.0 False) +eq.false.both (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/pair.uplc.golden b/plutarch-test/goldens/pair.uplc.golden new file mode 100644 index 000000000..93ccba025 --- /dev/null +++ b/plutarch-test/goldens/pair.uplc.golden @@ -0,0 +1,4 @@ +eq.true (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) (equalsInteger i4 i2) (delay (equalsString i3 i1)))))) ((\i0 -> \i0 -> i1 i2 i3) 42) ((\i0 -> \i0 -> i1 i2 i3) 42)) "Hello")) +eq.false.fst (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) (equalsInteger i4 i2) (delay (equalsString i3 i1)))))) ((\i0 -> \i0 -> i1 i2 i3) 42) ((\i0 -> \i0 -> i1 i2 i3) 24)) "Hello")) +eq.false.snd (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) (equalsInteger i4 i2) (delay (equalsString i3 i1)))))) ((\i0 -> \i0 -> i1 i2 "Hello") 42) ((\i0 -> \i0 -> i1 i2 "World") 42))) +eq.false.both (program 1.0.0 ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> force ((\i0 -> \i0 -> force ifThenElse i2 i1 (delay False)) (equalsInteger i4 i2) (delay (equalsString i3 i1)))))) ((\i0 -> \i0 -> i1 i2 "Hello") 42) ((\i0 -> \i0 -> i1 i2 "World") 24))) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.constr.bench.golden b/plutarch-test/goldens/pisdata.constr.bench.golden new file mode 100644 index 000000000..ae4d13e9e --- /dev/null +++ b/plutarch-test/goldens/pisdata.constr.bench.golden @@ -0,0 +1,13 @@ +sop.4wheeler.normal {"exBudgetCPU":926213,"exBudgetMemory":2760,"scriptSizeBytes":45} +sop.4wheeler.pdatasum {"exBudgetCPU":926213,"exBudgetMemory":2760,"scriptSizeBytes":45} +sop.2wheeler.normal {"exBudgetCPU":611227,"exBudgetMemory":1896,"scriptSizeBytes":30} +sop.2wheeler.pdatasum {"exBudgetCPU":611227,"exBudgetMemory":1896,"scriptSizeBytes":30} +sop.immovable.normal {"exBudgetCPU":204241,"exBudgetMemory":632,"scriptSizeBytes":12} +sop.immovable.pdatasum {"exBudgetCPU":204241,"exBudgetMemory":632,"scriptSizeBytes":12} +prod.1.normal {"exBudgetCPU":768720,"exBudgetMemory":2328,"scriptSizeBytes":40} +prod.1.pdatasum {"exBudgetCPU":768720,"exBudgetMemory":2328,"scriptSizeBytes":40} +prod.2.normal {"exBudgetCPU":768720,"exBudgetMemory":2328,"scriptSizeBytes":68} +prod.2.datasum {"exBudgetCPU":768720,"exBudgetMemory":2328,"scriptSizeBytes":68} +enum.PA {"exBudgetCPU":204241,"exBudgetMemory":632,"scriptSizeBytes":12} +enum.PB {"exBudgetCPU":204241,"exBudgetMemory":632,"scriptSizeBytes":12} +pconstant-pcon-rel {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":22} \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.constr.uplc.eval.golden b/plutarch-test/goldens/pisdata.constr.uplc.eval.golden new file mode 100644 index 000000000..ac6f1e88e --- /dev/null +++ b/plutarch-test/goldens/pisdata.constr.uplc.eval.golden @@ -0,0 +1,13 @@ +sop.4wheeler.normal (program 1.0.0 #d8799f0205182a00ff) +sop.4wheeler.pdatasum (program 1.0.0 #d8799f0205182a00ff) +sop.2wheeler.normal (program 1.0.0 #d87a9f0500ff) +sop.2wheeler.pdatasum (program 1.0.0 #d87a9f0500ff) +sop.immovable.normal (program 1.0.0 #d87b80) +sop.immovable.pdatasum (program 1.0.0 #d87b80) +prod.1.normal (program 1.0.0 #d8799f41ab4141410eff) +prod.1.pdatasum (program 1.0.0 #d8799f41ab4141410eff) +prod.2.normal (program 1.0.0 #d8799fd8799f40ffd87a9fd8799fd8799f41abff00ffffd87b9fd8799fd8799f41daffffffff) +prod.2.datasum (program 1.0.0 #d8799fd8799f40ffd87a9fd8799fd8799f41abff00ffffd87b9fd8799fd8799f41daffffffff) +enum.PA (program 1.0.0 #d87980) +enum.PB (program 1.0.0 #d87a80) +pconstant-pcon-rel (program 1.0.0 #d8799fd87a9f4101ffd87a80ff) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.constr.uplc.golden b/plutarch-test/goldens/pisdata.constr.uplc.golden new file mode 100644 index 000000000..c45fb7081 --- /dev/null +++ b/plutarch-test/goldens/pisdata.constr.uplc.golden @@ -0,0 +1,13 @@ +sop.4wheeler.normal (program 1.0.0 ((\i0 -> constrData 0 (i1 #02 (i1 #05 (i1 #182a (i1 #00 [ ]))))) (force mkCons))) +sop.4wheeler.pdatasum (program 1.0.0 ((\i0 -> constrData 0 (i1 #02 (i1 #05 (i1 #182a (i1 #00 [ ]))))) (force mkCons))) +sop.2wheeler.normal (program 1.0.0 ((\i0 -> constrData 1 (i1 #05 (i1 #00 []))) (force mkCons))) +sop.2wheeler.pdatasum (program 1.0.0 ((\i0 -> constrData 1 (i1 #05 (i1 #00 []))) (force mkCons))) +sop.immovable.normal (program 1.0.0 (constrData 2 [])) +sop.immovable.pdatasum (program 1.0.0 (constrData 2 [])) +prod.1.normal (program 1.0.0 ((\i0 -> constrData 0 (i1 #41ab (i1 #4141 (i1 #410e [ ])))) (force mkCons))) +prod.1.pdatasum (program 1.0.0 ((\i0 -> constrData 0 (i1 #41ab (i1 #4141 (i1 #410e [ ])))) (force mkCons))) +prod.2.normal (program 1.0.0 ((\i0 -> constrData 0 (i1 #d8799f40ff (i1 #d87a9fd8799fd8799f41abff00ffff (i1 #d87b9fd8799fd8799f41daffffff [ ])))) (force mkCons))) +prod.2.datasum (program 1.0.0 ((\i0 -> constrData 0 (i1 #d8799f40ff (i1 #d87a9fd8799fd8799f41abff00ffff (i1 #d87b9fd8799fd8799f41daffffff [ ])))) (force mkCons))) +enum.PA (program 1.0.0 (constrData 0 [])) +enum.PB (program 1.0.0 (constrData 1 [])) +pconstant-pcon-rel (program 1.0.0 #d8799fd87a9f4101ffd87a80ff) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.equality.bench.golden b/plutarch-test/goldens/pisdata.equality.bench.golden new file mode 100644 index 000000000..8b5f656a1 --- /dev/null +++ b/plutarch-test/goldens/pisdata.equality.bench.golden @@ -0,0 +1,4 @@ +PData.1 {"exBudgetCPU":1408085,"exBudgetMemory":901,"scriptSizeBytes":22} +PData.2 {"exBudgetCPU":1536367,"exBudgetMemory":1602,"scriptSizeBytes":30} +PAsData.1 {"exBudgetCPU":1332397,"exBudgetMemory":1065,"scriptSizeBytes":15} +PAsData.1 {"exBudgetCPU":1642953,"exBudgetMemory":2066,"scriptSizeBytes":31} \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.equality.uplc.eval.golden b/plutarch-test/goldens/pisdata.equality.uplc.eval.golden new file mode 100644 index 000000000..c177045ae --- /dev/null +++ b/plutarch-test/goldens/pisdata.equality.uplc.eval.golden @@ -0,0 +1,4 @@ +PData.1 (program 1.0.0 True) +PData.2 (program 1.0.0 True) +PAsData.1 (program 1.0.0 True) +PAsData.1 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.equality.uplc.golden b/plutarch-test/goldens/pisdata.equality.uplc.golden new file mode 100644 index 000000000..a6c36e050 --- /dev/null +++ b/plutarch-test/goldens/pisdata.equality.uplc.golden @@ -0,0 +1,4 @@ +PData.1 (program 1.0.0 ((\i0 -> equalsData i1 i1) #9fd87a9f00ffff)) +PData.2 (program 1.0.0 ((\i0 -> force ifThenElse i1 False True) (equalsData #d87980 #182a))) +PAsData.1 (program 1.0.0 (equalsData (iData 42) (iData 42))) +PAsData.1 (program 1.0.0 ((\i0 -> force ifThenElse i1 False True) (equalsData (bData #12) (bData #ab)))) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.lt.bench.golden b/plutarch-test/goldens/pisdata.lt.bench.golden new file mode 100644 index 000000000..03e9a3c1f --- /dev/null +++ b/plutarch-test/goldens/pisdata.lt.bench.golden @@ -0,0 +1,12 @@ +PCredential.derived.true {"exBudgetCPU":1827327,"exBudgetMemory":5930,"scriptSizeBytes":101} +PCredential.derived.false {"exBudgetCPU":2392816,"exBudgetMemory":7132,"scriptSizeBytes":101} +PCredential.pmatch.true {"exBudgetCPU":2725204,"exBudgetMemory":7896,"scriptSizeBytes":137} +PCredential.pmatch.false {"exBudgetCPU":2725204,"exBudgetMemory":7896,"scriptSizeBytes":137} +PCredential.pmatch-pdatarecord.true {"exBudgetCPU":2725204,"exBudgetMemory":7896,"scriptSizeBytes":137} +PCredential.pmatch-pdatarecord.false {"exBudgetCPU":2725204,"exBudgetMemory":7896,"scriptSizeBytes":137} +PTriplet.derived.true {"exBudgetCPU":4318557,"exBudgetMemory":12654,"scriptSizeBytes":158} +PTriplet.derived.false {"exBudgetCPU":4884046,"exBudgetMemory":13856,"scriptSizeBytes":158} +PTriplet.pmatch.true {"exBudgetCPU":4732557,"exBudgetMemory":14454,"scriptSizeBytes":161} +PTriplet.pmatch.false {"exBudgetCPU":5436046,"exBudgetMemory":16256,"scriptSizeBytes":161} +PTriplet.pmatch-pdatarecord.true {"exBudgetCPU":4180557,"exBudgetMemory":12054,"scriptSizeBytes":153} +PTriplet.pmatch-pdatarecord.false {"exBudgetCPU":4746046,"exBudgetMemory":13256,"scriptSizeBytes":153} \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.lt.uplc.eval.golden b/plutarch-test/goldens/pisdata.lt.uplc.eval.golden new file mode 100644 index 000000000..b4f436f15 --- /dev/null +++ b/plutarch-test/goldens/pisdata.lt.uplc.eval.golden @@ -0,0 +1,12 @@ +PCredential.derived.true (program 1.0.0 True) +PCredential.derived.false (program 1.0.0 False) +PCredential.pmatch.true (program 1.0.0 True) +PCredential.pmatch.false (program 1.0.0 False) +PCredential.pmatch-pdatarecord.true (program 1.0.0 True) +PCredential.pmatch-pdatarecord.false (program 1.0.0 False) +PTriplet.derived.true (program 1.0.0 True) +PTriplet.derived.false (program 1.0.0 False) +PTriplet.pmatch.true (program 1.0.0 True) +PTriplet.pmatch.false (program 1.0.0 False) +PTriplet.pmatch-pdatarecord.true (program 1.0.0 True) +PTriplet.pmatch-pdatarecord.false (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.lt.uplc.golden b/plutarch-test/goldens/pisdata.lt.uplc.golden new file mode 100644 index 000000000..5ffb8edf5 --- /dev/null +++ b/plutarch-test/goldens/pisdata.lt.uplc.golden @@ -0,0 +1,12 @@ +PCredential.derived.true (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay True) (delay (force (i7 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanByteString (unBData (i10 i2)) (unBData (i10 i1))) (i10 i4)) (i9 i4))) (delay False)))))) (i9 i2)) (i8 i2)) (unConstrData i2)) (unConstrData i2)) #d8799f40ff #d87a9f4141ff) (force ifThenElse)) (force headList)) (force (force sndPair))) (force (force fstPair)))) +PCredential.derived.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay True) (delay (force (i7 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanByteString (unBData (i10 i2)) (unBData (i10 i1))) (i10 i4)) (i9 i4))) (delay False)))))) (i9 i2)) (i8 i2)) (unConstrData i2)) (unConstrData i2)) #d87a9f4141ff #d8799f40ff) (force ifThenElse)) (force headList)) (force (force sndPair))) (force (force fstPair)))) +PCredential.pmatch.true (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay (lessThanByteString (unBData (i8 i4)) (unBData (i8 i1)))) (delay True))) (i9 i2)) (i9 i1)) (unConstrData i6))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (lessThanByteString (unBData (i8 i4)) (unBData (i8 i1)))) (delay False))) (i9 i2)) (i9 i1)) (unConstrData i6))))) (i6 i2)) (i6 i1)) (unConstrData #d8799f40ff)) (force ifThenElse)) (force headList)) #d87a9f4141ff) (force (force sndPair))) (force (force fstPair)))) +PCredential.pmatch.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (lessThanByteString (unBData (i8 i4)) (unBData (i8 i1)))) (delay False))) (i9 i2)) (i9 i1)) (unConstrData i6))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay (lessThanByteString (unBData (i8 i4)) (unBData (i8 i1)))) (delay True))) (i9 i2)) (i9 i1)) (unConstrData i6))))) (i6 i2)) (i6 i1)) (unConstrData #d87a9f4141ff)) (force ifThenElse)) (force headList)) #d8799f40ff) (force (force sndPair))) (force (force fstPair)))) +PCredential.pmatch-pdatarecord.true (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay (lessThanByteString (unBData (i8 i4)) (unBData (i8 i1)))) (delay True))) (i9 i2)) (i9 i1)) (unConstrData i6))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (lessThanByteString (unBData (i8 i4)) (unBData (i8 i1)))) (delay False))) (i9 i2)) (i9 i1)) (unConstrData i6))))) (i6 i2)) (i6 i1)) (unConstrData #d8799f40ff)) (force ifThenElse)) (force headList)) #d87a9f4141ff) (force (force sndPair))) (force (force fstPair)))) +PCredential.pmatch-pdatarecord.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay (lessThanByteString (unBData (i8 i4)) (unBData (i8 i1)))) (delay False))) (i9 i2)) (i9 i1)) (unConstrData i6))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay (lessThanByteString (unBData (i8 i4)) (unBData (i8 i1)))) (delay True))) (i9 i2)) (i9 i1)) (unConstrData i6))))) (i6 i2)) (i6 i1)) (unConstrData #d87a9f4141ff)) (force ifThenElse)) (force headList)) #d8799f40ff) (force (force sndPair))) (force (force fstPair)))) +PTriplet.derived.true (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay True) (delay (force (i7 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i11 (lessThanInteger i2 i1) (delay True) (delay (force (i11 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanInteger (unIData (i15 i2)) (unIData (i15 i1))) (i13 i4)) (i12 i4))) (delay False)))))) (unIData (i12 i2))) (unIData (i11 i2))) (i9 i4)) (i8 i4))) (delay False)))))) (unIData (i8 i2))) (unIData (i7 i2))) (i7 i2)) (i6 i2)) #d8799f010203ff #d8799f010305ff) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.derived.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay True) (delay (force (i7 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i11 (lessThanInteger i2 i1) (delay True) (delay (force (i11 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanInteger (unIData (i15 i2)) (unIData (i15 i1))) (i13 i4)) (i12 i4))) (delay False)))))) (unIData (i12 i2))) (unIData (i11 i2))) (i9 i4)) (i8 i4))) (delay False)))))) (unIData (i8 i2))) (unIData (i7 i2))) (i7 i2)) (i6 i2)) #d8799f010305ff #d8799f010203ff) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.pmatch.true (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay (force (i11 (equalsInteger i2 i1) (delay (lessThanInteger (unIData (i14 (i15 i7))) (unIData (i14 (i15 i5)))))))))) (unIData (i13 i4))) (unIData (i12 i5))))))))) (unIData (i11 i3))) (unIData (i10 i4))) (i10 i1)) (i10 #d8799f010305ff)) (i8 i1)) (i8 #d8799f010203ff)) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.pmatch.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay (force (i11 (equalsInteger i2 i1) (delay (lessThanInteger (unIData (i14 (i15 i7))) (unIData (i14 (i15 i5)))))))))) (unIData (i13 i4))) (unIData (i12 i5))))))))) (unIData (i11 i3))) (unIData (i10 i4))) (i10 i1)) (i10 #d8799f010203ff)) (i8 i1)) (i8 #d8799f010305ff)) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.pmatch-pdatarecord.true (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (lessThanInteger i2 i1) (delay True) (delay (force (i5 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay True) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanInteger (unIData (i13 i2)) (unIData (i13 i1))) (i11 i4)) (i10 i4))) (delay False)))))) (unIData (i10 i2))) (unIData (i9 i2))) (i7 i4)) (i6 i4))) (delay False)))))) (unIData (i6 i2))) (unIData (i5 i2))) (i5 #d8799f010305ff)) (i4 #d8799f010203ff)) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.pmatch-pdatarecord.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (lessThanInteger i2 i1) (delay True) (delay (force (i5 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay True) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanInteger (unIData (i13 i2)) (unIData (i13 i1))) (i11 i4)) (i10 i4))) (delay False)))))) (unIData (i10 i2))) (unIData (i9 i2))) (i7 i4)) (i6 i4))) (delay False)))))) (unIData (i6 i2))) (unIData (i5 i2))) (i5 #d8799f010203ff)) (i4 #d8799f010305ff)) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.lte.bench.golden b/plutarch-test/goldens/pisdata.lte.bench.golden new file mode 100644 index 000000000..9470f616a --- /dev/null +++ b/plutarch-test/goldens/pisdata.lte.bench.golden @@ -0,0 +1,18 @@ +PCredential.derived.true.eq {"exBudgetCPU":3347917,"exBudgetMemory":9225,"scriptSizeBytes":91} +PCredential.derived.true.less {"exBudgetCPU":1827327,"exBudgetMemory":5930,"scriptSizeBytes":101} +PCredential.derived.false {"exBudgetCPU":2392816,"exBudgetMemory":7132,"scriptSizeBytes":101} +PCredential.pmatch.true.eq {"exBudgetCPU":3347443,"exBudgetMemory":9225,"scriptSizeBytes":129} +PCredential.pmatch.true.less {"exBudgetCPU":2725204,"exBudgetMemory":7896,"scriptSizeBytes":137} +PCredential.pmatch.false {"exBudgetCPU":2725204,"exBudgetMemory":7896,"scriptSizeBytes":137} +PCredential.pmatch-pdatarecord.true.eq {"exBudgetCPU":3347443,"exBudgetMemory":9225,"scriptSizeBytes":129} +PCredential.pmatch-pdatarecord.true.less {"exBudgetCPU":2725204,"exBudgetMemory":7896,"scriptSizeBytes":137} +PCredential.pmatch-pdatarecord.false {"exBudgetCPU":2725204,"exBudgetMemory":7896,"scriptSizeBytes":137} +PTriplet.derived.true.eq {"exBudgetCPU":5782019,"exBudgetMemory":15949,"scriptSizeBytes":147} +PTriplet.derived.true.less {"exBudgetCPU":4318557,"exBudgetMemory":12654,"scriptSizeBytes":158} +PTriplet.derived.false {"exBudgetCPU":4884046,"exBudgetMemory":13856,"scriptSizeBytes":158} +PTriplet.pmatch.true.eq {"exBudgetCPU":6334019,"exBudgetMemory":18349,"scriptSizeBytes":155} +PTriplet.pmatch.true.less {"exBudgetCPU":4732557,"exBudgetMemory":14454,"scriptSizeBytes":161} +PTriplet.pmatch.false {"exBudgetCPU":5436046,"exBudgetMemory":16256,"scriptSizeBytes":161} +PTriplet.pmatch-pdatarecord.true.eq {"exBudgetCPU":5782019,"exBudgetMemory":15949,"scriptSizeBytes":147} +PTriplet.pmatch-pdatarecord.true.less {"exBudgetCPU":4180557,"exBudgetMemory":12054,"scriptSizeBytes":153} +PTriplet.pmatch-pdatarecord.false {"exBudgetCPU":4746046,"exBudgetMemory":13256,"scriptSizeBytes":153} \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.lte.uplc.eval.golden b/plutarch-test/goldens/pisdata.lte.uplc.eval.golden new file mode 100644 index 000000000..69302c643 --- /dev/null +++ b/plutarch-test/goldens/pisdata.lte.uplc.eval.golden @@ -0,0 +1,18 @@ +PCredential.derived.true.eq (program 1.0.0 True) +PCredential.derived.true.less (program 1.0.0 True) +PCredential.derived.false (program 1.0.0 False) +PCredential.pmatch.true.eq (program 1.0.0 True) +PCredential.pmatch.true.less (program 1.0.0 True) +PCredential.pmatch.false (program 1.0.0 False) +PCredential.pmatch-pdatarecord.true.eq (program 1.0.0 True) +PCredential.pmatch-pdatarecord.true.less (program 1.0.0 True) +PCredential.pmatch-pdatarecord.false (program 1.0.0 False) +PTriplet.derived.true.eq (program 1.0.0 True) +PTriplet.derived.true.less (program 1.0.0 True) +PTriplet.derived.false (program 1.0.0 False) +PTriplet.pmatch.true.eq (program 1.0.0 True) +PTriplet.pmatch.true.less (program 1.0.0 True) +PTriplet.pmatch.false (program 1.0.0 False) +PTriplet.pmatch-pdatarecord.true.eq (program 1.0.0 True) +PTriplet.pmatch-pdatarecord.true.less (program 1.0.0 True) +PTriplet.pmatch-pdatarecord.false (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.lte.uplc.golden b/plutarch-test/goldens/pisdata.lte.uplc.golden new file mode 100644 index 000000000..1d16c7c9b --- /dev/null +++ b/plutarch-test/goldens/pisdata.lte.uplc.golden @@ -0,0 +1,18 @@ +PCredential.derived.true.eq (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (lessThanInteger i2 i1) (delay True) (delay (force (i5 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsByteString (unBData (i8 i2)) (unBData (i8 i1))) (i8 i4)) (i7 i4))) (delay False)))))) (i7 i2)) (i6 i2)) (unConstrData i6)) (unConstrData i5)) (force ifThenElse)) (force headList)) (force (force sndPair))) (force (force fstPair))) #d8799f40ff)) +PCredential.derived.true.less (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay True) (delay (force (i7 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsByteString (unBData (i10 i2)) (unBData (i10 i1))) (i10 i4)) (i9 i4))) (delay False)))))) (i9 i2)) (i8 i2)) (unConstrData i2)) (unConstrData i2)) #d8799f40ff #d87a9f4141ff) (force ifThenElse)) (force headList)) (force (force sndPair))) (force (force fstPair)))) +PCredential.derived.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay True) (delay (force (i7 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsByteString (unBData (i10 i2)) (unBData (i10 i1))) (i10 i4)) (i9 i4))) (delay False)))))) (i9 i2)) (i8 i2)) (unConstrData i2)) (unConstrData i2)) #d87a9f4141ff #d8799f40ff) (force ifThenElse)) (force headList)) (force (force sndPair))) (force (force fstPair)))) +PCredential.pmatch.true.eq (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay False) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i8 i2)) (i8 i1)) (unConstrData i8))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay True) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i8 i2)) (i8 i1)) (unConstrData i8))))) (i5 i2)) (i5 i1)) (unConstrData i5)) (force ifThenElse)) (force headList)) (force (force sndPair))) (force (force fstPair))) #d8799f40ff)) +PCredential.pmatch.true.less (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay True) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i9 i2)) (i9 i1)) (unConstrData i6))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay False) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i9 i2)) (i9 i1)) (unConstrData i6))))) (i6 i2)) (i6 i1)) (unConstrData #d8799f40ff)) (force ifThenElse)) (force headList)) #d87a9f4141ff) (force (force sndPair))) (force (force fstPair)))) +PCredential.pmatch.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay False) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i9 i2)) (i9 i1)) (unConstrData i6))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay True) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i9 i2)) (i9 i1)) (unConstrData i6))))) (i6 i2)) (i6 i1)) (unConstrData #d87a9f4141ff)) (force ifThenElse)) (force headList)) #d8799f40ff) (force (force sndPair))) (force (force fstPair)))) +PCredential.pmatch-pdatarecord.true.eq (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay False) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i8 i2)) (i8 i1)) (unConstrData i8))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay True) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i8 i2)) (i8 i1)) (unConstrData i8))))) (i5 i2)) (i5 i1)) (unConstrData i5)) (force ifThenElse)) (force headList)) (force (force sndPair))) (force (force fstPair))) #d8799f40ff)) +PCredential.pmatch-pdatarecord.true.less (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 0 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay True) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i9 i2)) (i9 i1)) (unConstrData i6))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay False) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i9 i2)) (i9 i1)) (unConstrData i6))))) (i6 i2)) (i6 i1)) (unConstrData #d8799f40ff)) (force ifThenElse)) (force headList)) #d87a9f4141ff) (force (force sndPair))) (force (force fstPair)))) +PCredential.pmatch-pdatarecord.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i4 (equalsInteger 1 i2) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 0 i2) (delay False) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i9 i2)) (i9 i1)) (unConstrData i6))) (delay ((\i0 -> (\i0 -> (\i0 -> force (i7 (equalsInteger 1 i2) (delay True) (delay (lessThanEqualsByteString (unBData (i8 i4)) (unBData (i8 i1)))))) (i9 i2)) (i9 i1)) (unConstrData i6))))) (i6 i2)) (i6 i1)) (unConstrData #d87a9f4141ff)) (force ifThenElse)) (force headList)) #d8799f40ff) (force (force sndPair))) (force (force fstPair)))) +PTriplet.derived.true.eq (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (lessThanInteger i2 i1) (delay True) (delay (force (i5 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay True) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsInteger (unIData (i13 i2)) (unIData (i13 i1))) (i11 i4)) (i10 i4))) (delay False)))))) (unIData (i10 i2))) (unIData (i9 i2))) (i7 i4)) (i6 i4))) (delay False)))))) (unIData (i6 i2))) (unIData (i5 i2))) (i5 i7)) (i4 i6)) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) #d8799f010203ff)) +PTriplet.derived.true.less (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay True) (delay (force (i7 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i11 (lessThanInteger i2 i1) (delay True) (delay (force (i11 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsInteger (unIData (i15 i2)) (unIData (i15 i1))) (i13 i4)) (i12 i4))) (delay False)))))) (unIData (i12 i2))) (unIData (i11 i2))) (i9 i4)) (i8 i4))) (delay False)))))) (unIData (i8 i2))) (unIData (i7 i2))) (i7 i2)) (i6 i2)) #d8799f010203ff #d8799f010305ff) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.derived.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay True) (delay (force (i7 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i11 (lessThanInteger i2 i1) (delay True) (delay (force (i11 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsInteger (unIData (i15 i2)) (unIData (i15 i1))) (i13 i4)) (i12 i4))) (delay False)))))) (unIData (i12 i2))) (unIData (i11 i2))) (i9 i4)) (i8 i4))) (delay False)))))) (unIData (i8 i2))) (unIData (i7 i2))) (i7 i2)) (i6 i2)) #d8799f010305ff #d8799f010203ff) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.pmatch.true.eq (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay (force (i11 (equalsInteger i2 i1) (delay (lessThanEqualsInteger (unIData (i14 (i15 i7))) (unIData (i14 (i15 i5)))))))))) (unIData (i13 i4))) (unIData (i12 i5))))))))) (unIData (i11 i3))) (unIData (i10 i4))) (i10 i1)) (i10 i12)) (i8 i1)) (i8 i10)) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) #d8799f010203ff)) +PTriplet.pmatch.true.less (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay (force (i11 (equalsInteger i2 i1) (delay (lessThanEqualsInteger (unIData (i14 (i15 i7))) (unIData (i14 (i15 i5)))))))))) (unIData (i13 i4))) (unIData (i12 i5))))))))) (unIData (i11 i3))) (unIData (i10 i4))) (i10 i1)) (i10 #d8799f010305ff)) (i8 i1)) (i8 #d8799f010203ff)) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.pmatch.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i7 (lessThanInteger i2 i1) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay (force (i11 (equalsInteger i2 i1) (delay (lessThanEqualsInteger (unIData (i14 (i15 i7))) (unIData (i14 (i15 i5)))))))))) (unIData (i13 i4))) (unIData (i12 i5))))))))) (unIData (i11 i3))) (unIData (i10 i4))) (i10 i1)) (i10 #d8799f010203ff)) (i8 i1)) (i8 #d8799f010305ff)) (\i0 -> i4 i1 i2)) (delay True)) (\i0 -> \i0 -> i3 i2 i1 i4)) (force ifThenElse)) (delay False)) (force headList)) (force tailList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.pmatch-pdatarecord.true.eq (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (lessThanInteger i2 i1) (delay True) (delay (force (i5 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay True) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsInteger (unIData (i13 i2)) (unIData (i13 i1))) (i11 i4)) (i10 i4))) (delay False)))))) (unIData (i10 i2))) (unIData (i9 i2))) (i7 i4)) (i6 i4))) (delay False)))))) (unIData (i6 i2))) (unIData (i5 i2))) (i5 i7)) (i4 i6)) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair))) #d8799f010203ff)) +PTriplet.pmatch-pdatarecord.true.less (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (lessThanInteger i2 i1) (delay True) (delay (force (i5 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay True) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsInteger (unIData (i13 i2)) (unIData (i13 i1))) (i11 i4)) (i10 i4))) (delay False)))))) (unIData (i10 i2))) (unIData (i9 i2))) (i7 i4)) (i6 i4))) (delay False)))))) (unIData (i6 i2))) (unIData (i5 i2))) (i5 #d8799f010305ff)) (i4 #d8799f010203ff)) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +PTriplet.pmatch-pdatarecord.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (lessThanInteger i2 i1) (delay True) (delay (force (i5 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i9 (lessThanInteger i2 i1) (delay True) (delay (force (i9 (equalsInteger i2 i1) (delay ((\i0 -> (\i0 -> lessThanEqualsInteger (unIData (i13 i2)) (unIData (i13 i1))) (i11 i4)) (i10 i4))) (delay False)))))) (unIData (i10 i2))) (unIData (i9 i2))) (i7 i4)) (i6 i4))) (delay False)))))) (unIData (i6 i2))) (unIData (i5 i2))) (i5 #d8799f010203ff)) (i4 #d8799f010305ff)) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.ppair.bench.golden b/plutarch-test/goldens/pisdata.ppair.bench.golden new file mode 100644 index 000000000..ca959902e --- /dev/null +++ b/plutarch-test/goldens/pisdata.ppair.bench.golden @@ -0,0 +1,5 @@ +simple {"exBudgetCPU":238611,"exBudgetMemory":864,"scriptSizeBytes":19} +scriptcredential {"exBudgetCPU":191611,"exBudgetMemory":632,"scriptSizeBytes":28} +isomorphism.pforgetData {"exBudgetCPU":1199105,"exBudgetMemory":3492,"scriptSizeBytes":52} +isomorphism.pbuiltinPairFromTuple {"exBudgetCPU":1693045,"exBudgetMemory":5388,"scriptSizeBytes":68} +isomorphism.ptupleFromBuiltin {"exBudgetCPU":1199105,"exBudgetMemory":3492,"scriptSizeBytes":52} \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.ppair.uplc.eval.golden b/plutarch-test/goldens/pisdata.ppair.uplc.eval.golden new file mode 100644 index 000000000..86d4048d5 --- /dev/null +++ b/plutarch-test/goldens/pisdata.ppair.uplc.eval.golden @@ -0,0 +1,5 @@ +simple (program 1.0.0 (#01, #4141)) +scriptcredential (program 1.0.0 (#d8799f4141ff, #d87a9f4182ff)) +isomorphism.pforgetData (program 1.0.0 #d8799fd8799f4141ffd87a9f4182ffff) +isomorphism.pbuiltinPairFromTuple (program 1.0.0 (#d8799f4141ff, #d87a9f4182ff)) +isomorphism.ptupleFromBuiltin (program 1.0.0 #d8799fd8799f4141ffd87a9f4182ffff) \ No newline at end of file diff --git a/plutarch-test/goldens/pisdata.ppair.uplc.golden b/plutarch-test/goldens/pisdata.ppair.uplc.golden new file mode 100644 index 000000000..87673939a --- /dev/null +++ b/plutarch-test/goldens/pisdata.ppair.uplc.golden @@ -0,0 +1,5 @@ +simple (program 1.0.0 (mkPairData #01 (bData #41))) +scriptcredential (program 1.0.0 (mkPairData #d8799f4141ff #d87a9f4182ff)) +isomorphism.pforgetData (program 1.0.0 ((\i0 -> (\i0 -> constrData 0 (i2 (force (force fstPair) i1) (i2 (force (force sndPair) i1) [ ]))) (mkPairData #d8799f4141ff #d87a9f4182ff)) (force mkCons))) +isomorphism.pbuiltinPairFromTuple (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> mkPairData (i3 i1) (i3 (force tailList i1))) (force (force sndPair) (unConstrData i1))) ((\i0 -> \i0 -> constrData 0 (i4 i2 (i4 i1 [ ]))) #d8799f4141ff #d87a9f4182ff)) (force headList)) (force mkCons))) +isomorphism.ptupleFromBuiltin (program 1.0.0 ((\i0 -> (\i0 -> constrData 0 (i2 (force (force fstPair) i1) (i2 (force (force sndPair) i1) [ ]))) (mkPairData #d8799f4141ff #d87a9f4182ff)) (force mkCons))) \ No newline at end of file diff --git a/plutarch-test/goldens/plam.bench.golden b/plutarch-test/goldens/plam.bench.golden new file mode 100644 index 000000000..ee5053909 --- /dev/null +++ b/plutarch-test/goldens/plam.bench.golden @@ -0,0 +1,28 @@ +id {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +flip.const {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +plet {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":6} +primitives.bool.true {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":6} +primitives.int.0 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +primitives.int.1 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +primitives.int.512 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":8} +primitives.int.1048576 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":10} +primitives.bytestring.1 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":10} +primitives.bytestring.1111111 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":16} +primitives.unit.list {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":8} +primitives.unit.() {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":6} +primitives.id {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +primitives.fun.lam+ {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":6} +primitives.fun.+ {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":6} +η-reduction-optimisations.λx y. addInteger x y => addInteger {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":6} +η-reduction-optimisations.λx y. hoist (force mkCons) x y => force mkCons {"exBudgetCPU":46100,"exBudgetMemory":300,"scriptSizeBytes":6} +η-reduction-optimisations.λx y. hoist mkCons x y => mkCons x y {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":11} +η-reduction-optimisations.λx y. hoist (λx y. x + y - y - x) x y => λx y. x + y - y - x {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":19} +η-reduction-optimisations.λx y. x + x {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":11} +η-reduction-optimisations.let x = addInteger in x 1 1 {"exBudgetCPU":321577,"exBudgetMemory":602,"scriptSizeBytes":11} +η-reduction-optimisations.let x = 0 in x => 0 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +η-reduction-optimisations.let x = hoist (λx. x + x) in 0 => 0 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +η-reduction-optimisations.let x = hoist (λx. x + x) in x {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":10} +η-reduction-optimisations.λx y. sha2_256 x y =>! {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":11} +η-reduction-optimisations.let f = hoist (λx. x) in λx y. f x y => λx y. x y {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":9} +η-reduction-optimisations.let f = hoist (λx. x True) in λx y. f x y => λx y. (λz. z True) x y {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":11} +η-reduction-optimisations.λy. (λx. x + x) y {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":10} \ No newline at end of file diff --git a/plutarch-test/goldens/plam.flip.const.uplc.eval.golden b/plutarch-test/goldens/plam.flip.const.uplc.eval.golden deleted file mode 100644 index d9080ab8b..000000000 --- a/plutarch-test/goldens/plam.flip.const.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/plam.flip.const.uplc.golden b/plutarch-test/goldens/plam.flip.const.uplc.golden deleted file mode 100644 index d9080ab8b..000000000 --- a/plutarch-test/goldens/plam.flip.const.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/plam.id.uplc.eval.golden b/plutarch-test/goldens/plam.id.uplc.eval.golden deleted file mode 100644 index 1e51ae76c..000000000 --- a/plutarch-test/goldens/plam.id.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/plam.id.uplc.golden b/plutarch-test/goldens/plam.id.uplc.golden deleted file mode 100644 index 1e51ae76c..000000000 --- a/plutarch-test/goldens/plam.id.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/plam.plet.uplc.eval.golden b/plutarch-test/goldens/plam.plet.uplc.eval.golden deleted file mode 100644 index 3cf174504..000000000 --- a/plutarch-test/goldens/plam.plet.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> error)) \ No newline at end of file diff --git a/plutarch-test/goldens/plam.plet.uplc.golden b/plutarch-test/goldens/plam.plet.uplc.golden deleted file mode 100644 index 3cf174504..000000000 --- a/plutarch-test/goldens/plam.plet.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> error)) \ No newline at end of file diff --git a/plutarch-test/goldens/plam.uplc.eval.golden b/plutarch-test/goldens/plam.uplc.eval.golden new file mode 100644 index 000000000..eeaf90097 --- /dev/null +++ b/plutarch-test/goldens/plam.uplc.eval.golden @@ -0,0 +1,28 @@ +id (program 1.0.0 (\i0 -> i1)) +flip.const (program 1.0.0 (\i0 -> \i0 -> i1)) +plet (program 1.0.0 (\i0 -> \i0 -> error)) +primitives.bool.true (program 1.0.0 (\i0 -> True)) +primitives.int.0 (program 1.0.0 (\i0 -> 0)) +primitives.int.1 (program 1.0.0 (\i0 -> 1)) +primitives.int.512 (program 1.0.0 (\i0 -> 512)) +primitives.int.1048576 (program 1.0.0 (\i0 -> 1048576)) +primitives.bytestring.1 (program 1.0.0 (\i0 -> #31)) +primitives.bytestring.1111111 (program 1.0.0 (\i0 -> #31313131313131)) +primitives.unit.list (program 1.0.0 (\i0 -> [()])) +primitives.unit.() (program 1.0.0 (\i0 -> ())) +primitives.id (program 1.0.0 (\i0 -> i1)) +primitives.fun.lam+ (program 1.0.0 (\i0 -> addInteger)) +primitives.fun.+ (program 1.0.0 addInteger) +η-reduction-optimisations.λx y. addInteger x y => addInteger (program 1.0.0 addInteger) +η-reduction-optimisations.λx y. hoist (force mkCons) x y => force mkCons (program 1.0.0 (force mkCons)) +η-reduction-optimisations.λx y. hoist mkCons x y => mkCons x y (program 1.0.0 (\i0 -> \i0 -> mkCons i2 i1)) +η-reduction-optimisations.λx y. hoist (λx y. x + y - y - x) x y => λx y. x + y - y - x (program 1.0.0 (\i0 -> \i0 -> subtractInteger (subtractInteger (addInteger i2 i1) i1) i2)) +η-reduction-optimisations.λx y. x + x (program 1.0.0 (\i0 -> \i0 -> addInteger i2 i2)) +η-reduction-optimisations.let x = addInteger in x 1 1 (program 1.0.0 2) +η-reduction-optimisations.let x = 0 in x => 0 (program 1.0.0 0) +η-reduction-optimisations.let x = hoist (λx. x + x) in 0 => 0 (program 1.0.0 0) +η-reduction-optimisations.let x = hoist (λx. x + x) in x (program 1.0.0 (\i0 -> addInteger i1 i1)) +η-reduction-optimisations.λx y. sha2_256 x y =>! (program 1.0.0 (\i0 -> \i0 -> sha2_256 i2 i1)) +η-reduction-optimisations.let f = hoist (λx. x) in λx y. f x y => λx y. x y (program 1.0.0 (\i0 -> \i0 -> i2 i1)) +η-reduction-optimisations.let f = hoist (λx. x True) in λx y. f x y => λx y. (λz. z True) x y (program 1.0.0 (\i0 -> \i0 -> i2 True i1)) +η-reduction-optimisations.λy. (λx. x + x) y (program 1.0.0 (\i0 -> addInteger i1 i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/plam.uplc.golden b/plutarch-test/goldens/plam.uplc.golden new file mode 100644 index 000000000..2137369c2 --- /dev/null +++ b/plutarch-test/goldens/plam.uplc.golden @@ -0,0 +1,28 @@ +id (program 1.0.0 (\i0 -> i1)) +flip.const (program 1.0.0 (\i0 -> \i0 -> i1)) +plet (program 1.0.0 (\i0 -> \i0 -> error)) +primitives.bool.true (program 1.0.0 (\i0 -> True)) +primitives.int.0 (program 1.0.0 (\i0 -> 0)) +primitives.int.1 (program 1.0.0 (\i0 -> 1)) +primitives.int.512 (program 1.0.0 (\i0 -> 512)) +primitives.int.1048576 (program 1.0.0 (\i0 -> 1048576)) +primitives.bytestring.1 (program 1.0.0 (\i0 -> #31)) +primitives.bytestring.1111111 (program 1.0.0 (\i0 -> #31313131313131)) +primitives.unit.list (program 1.0.0 (\i0 -> [()])) +primitives.unit.() (program 1.0.0 (\i0 -> ())) +primitives.id (program 1.0.0 (\i0 -> i1)) +primitives.fun.lam+ (program 1.0.0 (\i0 -> addInteger)) +primitives.fun.+ (program 1.0.0 addInteger) +η-reduction-optimisations.λx y. addInteger x y => addInteger (program 1.0.0 addInteger) +η-reduction-optimisations.λx y. hoist (force mkCons) x y => force mkCons (program 1.0.0 (force mkCons)) +η-reduction-optimisations.λx y. hoist mkCons x y => mkCons x y (program 1.0.0 (\i0 -> \i0 -> mkCons i2 i1)) +η-reduction-optimisations.λx y. hoist (λx y. x + y - y - x) x y => λx y. x + y - y - x (program 1.0.0 (\i0 -> \i0 -> subtractInteger (subtractInteger (addInteger i2 i1) i1) i2)) +η-reduction-optimisations.λx y. x + x (program 1.0.0 (\i0 -> \i0 -> addInteger i2 i2)) +η-reduction-optimisations.let x = addInteger in x 1 1 (program 1.0.0 (addInteger 1 1)) +η-reduction-optimisations.let x = 0 in x => 0 (program 1.0.0 0) +η-reduction-optimisations.let x = hoist (λx. x + x) in 0 => 0 (program 1.0.0 0) +η-reduction-optimisations.let x = hoist (λx. x + x) in x (program 1.0.0 (\i0 -> addInteger i1 i1)) +η-reduction-optimisations.λx y. sha2_256 x y =>! (program 1.0.0 (\i0 -> \i0 -> sha2_256 i2 i1)) +η-reduction-optimisations.let f = hoist (λx. x) in λx y. f x y => λx y. x y (program 1.0.0 (\i0 -> \i0 -> i2 i1)) +η-reduction-optimisations.let f = hoist (λx. x True) in λx y. f x y => λx y. (λz. z True) x y (program 1.0.0 (\i0 -> \i0 -> i2 True i1)) +η-reduction-optimisations.λy. (λx. x + x) y (program 1.0.0 (\i0 -> addInteger i1 i1)) \ No newline at end of file diff --git a/plutarch-test/goldens/plutustype.deconstr.bench.golden b/plutarch-test/goldens/plutustype.deconstr.bench.golden new file mode 100644 index 000000000..e654e76e3 --- /dev/null +++ b/plutarch-test/goldens/plutustype.deconstr.bench.golden @@ -0,0 +1,37 @@ +matching.typed.newtype.normal {"exBudgetCPU":348727,"exBudgetMemory":1164,"scriptSizeBytes":30} +matching.typed.newtype.datasum {"exBudgetCPU":348727,"exBudgetMemory":1164,"scriptSizeBytes":30} +matching.typed.sumtype(ignore-fields).normal {"exBudgetCPU":1316652,"exBudgetMemory":3798,"scriptSizeBytes":44} +matching.typed.sumtype(ignore-fields).datasum {"exBudgetCPU":1316652,"exBudgetMemory":3798,"scriptSizeBytes":44} +matching.typed.sumtype(partial-match).normal {"exBudgetCPU":1316652,"exBudgetMemory":3798,"scriptSizeBytes":44} +matching.typed.sumtype(partial-match).datasum {"exBudgetCPU":1316652,"exBudgetMemory":3798,"scriptSizeBytes":44} +matching.typed.sumtype(exhaustive).normal.minting {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":83} +matching.typed.sumtype(exhaustive).normal.spending {"exBudgetCPU":1385652,"exBudgetMemory":4098,"scriptSizeBytes":93} +matching.typed.sumtype(exhaustive).normal.rewarding {"exBudgetCPU":1951141,"exBudgetMemory":5300,"scriptSizeBytes":90} +matching.typed.sumtype(exhaustive).normal.certifying {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":85} +matching.typed.sumtype(exhaustive).datasum.minting {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":83} +matching.typed.sumtype(exhaustive).datasum.spending {"exBudgetCPU":1385652,"exBudgetMemory":4098,"scriptSizeBytes":93} +matching.typed.sumtype(exhaustive).datasum.rewarding {"exBudgetCPU":1951141,"exBudgetMemory":5300,"scriptSizeBytes":90} +matching.typed.sumtype(exhaustive).datasum.certifying {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":85} +matching.typed.sumtype(exhaustive)(ignore-fields).normal.minting {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":83} +matching.typed.sumtype(exhaustive)(ignore-fields).normal.spending {"exBudgetCPU":1385652,"exBudgetMemory":4098,"scriptSizeBytes":93} +matching.typed.sumtype(exhaustive)(ignore-fields).normal.rewarding {"exBudgetCPU":1951141,"exBudgetMemory":5300,"scriptSizeBytes":90} +matching.typed.sumtype(exhaustive)(ignore-fields).normal.certifying {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":85} +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.minting {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":83} +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.spending {"exBudgetCPU":1385652,"exBudgetMemory":4098,"scriptSizeBytes":93} +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.rewarding {"exBudgetCPU":1951141,"exBudgetMemory":5300,"scriptSizeBytes":90} +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.certifying {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":85} +matching.raw.newtype {"exBudgetCPU":348727,"exBudgetMemory":1164,"scriptSizeBytes":30} +matching.raw.sumtype(ignore-fields) {"exBudgetCPU":931721,"exBudgetMemory":2466,"scriptSizeBytes":33} +matching.raw.sumtype(partial-match) {"exBudgetCPU":1178652,"exBudgetMemory":3198,"scriptSizeBytes":39} +matching.raw.sumtype(exhaustive).minting {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":83} +matching.raw.sumtype(exhaustive).spending {"exBudgetCPU":1385652,"exBudgetMemory":4098,"scriptSizeBytes":93} +matching.raw.sumtype(exhaustive).rewarding {"exBudgetCPU":1951141,"exBudgetMemory":5300,"scriptSizeBytes":90} +matching.raw.sumtype(exhaustive).certifying {"exBudgetCPU":2516630,"exBudgetMemory":6502,"scriptSizeBytes":85} +matching.raw.sumtype(exhaustive)(ignore-fields).minting {"exBudgetCPU":2200699,"exBudgetMemory":5470,"scriptSizeBytes":75} +matching.raw.sumtype(exhaustive)(ignore-fields).spending {"exBudgetCPU":1069721,"exBudgetMemory":3066,"scriptSizeBytes":85} +matching.raw.sumtype(exhaustive)(ignore-fields).rewarding {"exBudgetCPU":1635210,"exBudgetMemory":4268,"scriptSizeBytes":82} +matching.raw.sumtype(exhaustive)(ignore-fields).certifying {"exBudgetCPU":2200699,"exBudgetMemory":5470,"scriptSizeBytes":77} +fields.typed.extract-single {"exBudgetCPU":460976,"exBudgetMemory":1496,"scriptSizeBytes":32} +fields.raw.extract-single {"exBudgetCPU":460976,"exBudgetMemory":1496,"scriptSizeBytes":32} +combined.typed.toValidatorHash {"exBudgetCPU":2012997,"exBudgetMemory":5958,"scriptSizeBytes":75} +combined.raw.toValidatorHash {"exBudgetCPU":1874997,"exBudgetMemory":5358,"scriptSizeBytes":70} \ No newline at end of file diff --git a/plutarch-test/goldens/plutustype.deconstr.uplc.eval.golden b/plutarch-test/goldens/plutustype.deconstr.uplc.eval.golden new file mode 100644 index 000000000..55e989cb6 --- /dev/null +++ b/plutarch-test/goldens/plutustype.deconstr.uplc.eval.golden @@ -0,0 +1,37 @@ +matching.typed.newtype.normal (program 1.0.0 [#d8799f41abff, #d87a80]) +matching.typed.newtype.datasum (program 1.0.0 [#d8799f41abff, #d87a80]) +matching.typed.sumtype(ignore-fields).normal (program 1.0.0 ()) +matching.typed.sumtype(ignore-fields).datasum (program 1.0.0 ()) +matching.typed.sumtype(partial-match).normal (program 1.0.0 [#40]) +matching.typed.sumtype(partial-match).datasum (program 1.0.0 [#40]) +matching.typed.sumtype(exhaustive).normal.minting (program 1.0.0 #01) +matching.typed.sumtype(exhaustive).normal.spending (program 1.0.0 #02) +matching.typed.sumtype(exhaustive).normal.rewarding (program 1.0.0 #03) +matching.typed.sumtype(exhaustive).normal.certifying (program 1.0.0 #04) +matching.typed.sumtype(exhaustive).datasum.minting (program 1.0.0 #01) +matching.typed.sumtype(exhaustive).datasum.spending (program 1.0.0 #02) +matching.typed.sumtype(exhaustive).datasum.rewarding (program 1.0.0 #03) +matching.typed.sumtype(exhaustive).datasum.certifying (program 1.0.0 #04) +matching.typed.sumtype(exhaustive)(ignore-fields).normal.minting (program 1.0.0 #01) +matching.typed.sumtype(exhaustive)(ignore-fields).normal.spending (program 1.0.0 #02) +matching.typed.sumtype(exhaustive)(ignore-fields).normal.rewarding (program 1.0.0 #03) +matching.typed.sumtype(exhaustive)(ignore-fields).normal.certifying (program 1.0.0 #04) +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.minting (program 1.0.0 #01) +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.spending (program 1.0.0 #02) +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.rewarding (program 1.0.0 #03) +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.certifying (program 1.0.0 #04) +matching.raw.newtype (program 1.0.0 [#d8799f41abff, #d87a80]) +matching.raw.sumtype(ignore-fields) (program 1.0.0 ()) +matching.raw.sumtype(partial-match) (program 1.0.0 [#40]) +matching.raw.sumtype(exhaustive).minting (program 1.0.0 #01) +matching.raw.sumtype(exhaustive).spending (program 1.0.0 #02) +matching.raw.sumtype(exhaustive).rewarding (program 1.0.0 #03) +matching.raw.sumtype(exhaustive).certifying (program 1.0.0 #04) +matching.raw.sumtype(exhaustive)(ignore-fields).minting (program 1.0.0 #01) +matching.raw.sumtype(exhaustive)(ignore-fields).spending (program 1.0.0 #02) +matching.raw.sumtype(exhaustive)(ignore-fields).rewarding (program 1.0.0 #03) +matching.raw.sumtype(exhaustive)(ignore-fields).certifying (program 1.0.0 #04) +fields.typed.extract-single (program 1.0.0 #d87a9f41abff) +fields.raw.extract-single (program 1.0.0 #d87a9f41abff) +combined.typed.toValidatorHash (program 1.0.0 (\i0 -> \i0 -> i2 #ab)) +combined.raw.toValidatorHash (program 1.0.0 (\i0 -> \i0 -> i2 #ab)) \ No newline at end of file diff --git a/plutarch-test/goldens/plutustype.deconstr.uplc.golden b/plutarch-test/goldens/plutustype.deconstr.uplc.golden new file mode 100644 index 000000000..54b466db0 --- /dev/null +++ b/plutarch-test/goldens/plutustype.deconstr.uplc.golden @@ -0,0 +1,37 @@ +matching.typed.newtype.normal (program 1.0.0 ((\i0 -> force (force sndPair) (unConstrData i1)) #d8799fd8799f41abffd87a80ff)) +matching.typed.newtype.datasum (program 1.0.0 ((\i0 -> force (force sndPair) (unConstrData i1)) #d8799fd8799f41abffd87a80ff)) +matching.typed.sumtype(ignore-fields).normal (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsInteger 0 i2) (delay ()) (delay error))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff)) +matching.typed.sumtype(ignore-fields).datasum (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsInteger 0 i2) (delay ()) (delay error))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff)) +matching.typed.sumtype(partial-match).normal (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsInteger 0 i2) (delay i1) (delay error))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff)) +matching.typed.sumtype(partial-match).datasum (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsInteger 0 i2) (delay i1) (delay error))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff)) +matching.typed.sumtype(exhaustive).normal.minting (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff) (force ifThenElse))) +matching.typed.sumtype(exhaustive).normal.spending (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87a9fd8799fd8799f41abff00ffff) (force ifThenElse))) +matching.typed.sumtype(exhaustive).normal.rewarding (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87b9fd87a9f182a0007ffff) (force ifThenElse))) +matching.typed.sumtype(exhaustive).normal.certifying (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87c9fd87e80ff) (force ifThenElse))) +matching.typed.sumtype(exhaustive).datasum.minting (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff) (force ifThenElse))) +matching.typed.sumtype(exhaustive).datasum.spending (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87a9fd8799fd8799f41abff00ffff) (force ifThenElse))) +matching.typed.sumtype(exhaustive).datasum.rewarding (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87b9fd87a9f182a0007ffff) (force ifThenElse))) +matching.typed.sumtype(exhaustive).datasum.certifying (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87c9fd87e80ff) (force ifThenElse))) +matching.typed.sumtype(exhaustive)(ignore-fields).normal.minting (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff) (force ifThenElse))) +matching.typed.sumtype(exhaustive)(ignore-fields).normal.spending (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87a9fd8799fd8799f41abff00ffff) (force ifThenElse))) +matching.typed.sumtype(exhaustive)(ignore-fields).normal.rewarding (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87b9fd87a9f182a0007ffff) (force ifThenElse))) +matching.typed.sumtype(exhaustive)(ignore-fields).normal.certifying (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87c9fd87e80ff) (force ifThenElse))) +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.minting (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff) (force ifThenElse))) +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.spending (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87a9fd8799fd8799f41abff00ffff) (force ifThenElse))) +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.rewarding (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87b9fd87a9f182a0007ffff) (force ifThenElse))) +matching.typed.sumtype(exhaustive)(ignore-fields).datasum.certifying (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger 1 i2) (delay #02) (delay (force (i5 (equalsInteger 2 i2) (delay #03) (delay (force (i5 (equalsInteger 3 i2) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87c9fd87e80ff) (force ifThenElse))) +matching.raw.newtype (program 1.0.0 ((\i0 -> force (force sndPair) (unConstrData i1)) #d8799fd8799f41abffd87a80ff)) +matching.raw.sumtype(ignore-fields) (program 1.0.0 ((\i0 -> force (force ifThenElse (equalsInteger (force (force fstPair) (unConstrData i1)) 0) (delay ()) (delay error))) #d8799f40ff)) +matching.raw.sumtype(partial-match) (program 1.0.0 ((\i0 -> (\i0 -> force (force ifThenElse (equalsInteger (force (force fstPair) i1) 0) (delay (force (force sndPair) i1)) (delay error))) (unConstrData i1)) #d8799f40ff)) +matching.raw.sumtype(exhaustive).minting (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger i2 1) (delay #02) (delay (force (i5 (equalsInteger i2 2) (delay #03) (delay (force (i5 (equalsInteger i2 3) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d8799f40ff) (force ifThenElse))) +matching.raw.sumtype(exhaustive).spending (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger i2 1) (delay #02) (delay (force (i5 (equalsInteger i2 2) (delay #03) (delay (force (i5 (equalsInteger i2 3) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87a9fd8799fd8799f41abff00ffff) (force ifThenElse))) +matching.raw.sumtype(exhaustive).rewarding (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger i2 1) (delay #02) (delay (force (i5 (equalsInteger i2 2) (delay #03) (delay (force (i5 (equalsInteger i2 3) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87b9fd87a9f182a0007ffff) (force ifThenElse))) +matching.raw.sumtype(exhaustive).certifying (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (i5 (equalsInteger i2 1) (delay #02) (delay (force (i5 (equalsInteger i2 2) (delay #03) (delay (force (i5 (equalsInteger i2 3) (delay #04) (delay #01))))))))) (force (force sndPair) i2)) (force (force fstPair) i1)) (unConstrData i1)) #d87c9fd87e80ff) (force ifThenElse))) +matching.raw.sumtype(exhaustive)(ignore-fields).minting (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> force (i3 (equalsInteger i1 1) (delay #02) (delay (force (i3 (equalsInteger i1 2) (delay #03) (delay (force (i3 (equalsInteger i1 3) (delay #04) (delay #01))))))))) (force (force fstPair) (unConstrData i1))) #d8799f40ff) (force ifThenElse))) +matching.raw.sumtype(exhaustive)(ignore-fields).spending (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> force (i3 (equalsInteger i1 1) (delay #02) (delay (force (i3 (equalsInteger i1 2) (delay #03) (delay (force (i3 (equalsInteger i1 3) (delay #04) (delay #01))))))))) (force (force fstPair) (unConstrData i1))) #d87a9fd8799fd8799f41abff00ffff) (force ifThenElse))) +matching.raw.sumtype(exhaustive)(ignore-fields).rewarding (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> force (i3 (equalsInteger i1 1) (delay #02) (delay (force (i3 (equalsInteger i1 2) (delay #03) (delay (force (i3 (equalsInteger i1 3) (delay #04) (delay #01))))))))) (force (force fstPair) (unConstrData i1))) #d87b9fd87a9f182a0007ffff) (force ifThenElse))) +matching.raw.sumtype(exhaustive)(ignore-fields).certifying (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> force (i3 (equalsInteger i1 1) (delay #02) (delay (force (i3 (equalsInteger i1 2) (delay #03) (delay (force (i3 (equalsInteger i1 3) (delay #04) (delay #01))))))))) (force (force fstPair) (unConstrData i1))) #d87c9fd87e80ff) (force ifThenElse))) +fields.typed.extract-single (program 1.0.0 ((\i0 -> force headList (force (force sndPair) (unConstrData i1))) #d8799fd87a9f41abffd87a80ff)) +fields.raw.extract-single (program 1.0.0 ((\i0 -> force headList (force (force sndPair) (unConstrData i1))) #d8799fd87a9f41abffd87a80ff)) +combined.typed.toValidatorHash (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsInteger 1 i2) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (unBData (i5 i1)))) (delay (\i0 -> \i0 -> force i1)))) (i5 i2)) (force (force fstPair) i1)) (unConstrData (i2 (i3 (unConstrData i1))))) #d8799fd87a9f41abffd87a80ff) (force headList)) (force (force sndPair)))) +combined.raw.toValidatorHash (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force ifThenElse (equalsInteger (force (force fstPair) i1) 0) (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> i2 i3) (unBData (i3 (i4 i1))))))) (unConstrData (i2 (i3 (unConstrData i1))))) #d8799fd87a9f41abffd87a80ff) (force headList)) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/plutustype.example.bench.golden b/plutarch-test/goldens/plutustype.example.bench.golden new file mode 100644 index 000000000..8a9450622 --- /dev/null +++ b/plutarch-test/goldens/plutustype.example.bench.golden @@ -0,0 +1,4 @@ +swap.A {"exBudgetCPU":207100,"exBudgetMemory":1000,"scriptSizeBytes":16} +swap.B {"exBudgetCPU":207100,"exBudgetMemory":1000,"scriptSizeBytes":16} +scottenc.PMaybe {"exBudgetCPU":299100,"exBudgetMemory":1400,"scriptSizeBytes":16} +scottenc.PPair {"exBudgetCPU":299100,"exBudgetMemory":1400,"scriptSizeBytes":28} \ No newline at end of file diff --git a/plutarch-test/goldens/plutustype.example.uplc.eval.golden b/plutarch-test/goldens/plutustype.example.uplc.eval.golden new file mode 100644 index 000000000..9ecb284b8 --- /dev/null +++ b/plutarch-test/goldens/plutustype.example.uplc.eval.golden @@ -0,0 +1,4 @@ +swap.A (program 1.0.0 (\i0 -> \i0 -> force i1)) +swap.B (program 1.0.0 (\i0 -> \i0 -> force i2)) +scottenc.PMaybe (program 1.0.0 42) +scottenc.PPair (program 1.0.0 "Universe") \ No newline at end of file diff --git a/plutarch-test/goldens/plutustype.example.uplc.golden b/plutarch-test/goldens/plutustype.example.uplc.golden new file mode 100644 index 000000000..aa593fc09 --- /dev/null +++ b/plutarch-test/goldens/plutustype.example.uplc.golden @@ -0,0 +1,4 @@ +swap.A (program 1.0.0 ((\i0 -> \i0 -> force i2) (delay (\i0 -> \i0 -> force i1)) (delay (\i0 -> \i0 -> force i2)))) +swap.B (program 1.0.0 ((\i0 -> \i0 -> force i1) (delay (\i0 -> \i0 -> force i1)) (delay (\i0 -> \i0 -> force i2)))) +scottenc.PMaybe (program 1.0.0 ((\i0 -> \i0 -> \i0 -> i2 i3) 42 (\i0 -> i1) (delay error))) +scottenc.PPair (program 1.0.0 ((\i0 -> \i0 -> i1 i2 "Universe") 42 (\i0 -> \i0 -> i1))) \ No newline at end of file diff --git a/plutarch-test/goldens/rational.bench.golden b/plutarch-test/goldens/rational.bench.golden new file mode 100644 index 000000000..977e089bf --- /dev/null +++ b/plutarch-test/goldens/rational.bench.golden @@ -0,0 +1,24 @@ +literal {"exBudgetCPU":161100,"exBudgetMemory":800,"scriptSizeBytes":17} +ops.+ {"exBudgetCPU":33566829,"exBudgetMemory":84401,"scriptSizeBytes":393} +ops.- {"exBudgetCPU":33566829,"exBudgetMemory":84401,"scriptSizeBytes":393} +ops.* {"exBudgetCPU":58106354,"exBudgetMemory":142977,"scriptSizeBytes":452} +ops.harmonic-sum {"exBudgetCPU":85280775,"exBudgetMemory":207655,"scriptSizeBytes":456} +ops.multi-product {"exBudgetCPU":96066215,"exBudgetMemory":237989,"scriptSizeBytes":478} +compare {"exBudgetCPU":27186403,"exBudgetMemory":69077,"scriptSizeBytes":378} +round.5/3 {"exBudgetCPU":17922870,"exBudgetMemory":39749,"scriptSizeBytes":384} +round.4/3 {"exBudgetCPU":16466921,"exBudgetMemory":36646,"scriptSizeBytes":384} +round.-5/2 {"exBudgetCPU":17724384,"exBudgetMemory":39249,"scriptSizeBytes":398} +round.-1/4 {"exBudgetCPU":16834398,"exBudgetMemory":37348,"scriptSizeBytes":398} +truncate.5/4 {"exBudgetCPU":13893565,"exBudgetMemory":33539,"scriptSizeBytes":335} +truncate.7/4 {"exBudgetCPU":15349514,"exBudgetMemory":36642,"scriptSizeBytes":335} +truncate.1/4 {"exBudgetCPU":12437616,"exBudgetMemory":30436,"scriptSizeBytes":335} +truncate.-7/4 {"exBudgetCPU":17471417,"exBudgetMemory":40849,"scriptSizeBytes":349} +properFraction.-1/2 {"exBudgetCPU":40492313,"exBudgetMemory":101522,"scriptSizeBytes":513} +properFraction.-3/2 {"exBudgetCPU":42315739,"exBudgetMemory":105327,"scriptSizeBytes":515} +properFraction.-4/3 {"exBudgetCPU":42315739,"exBudgetMemory":105327,"scriptSizeBytes":515} +data.id.0.5 {"exBudgetCPU":161100,"exBudgetMemory":800,"scriptSizeBytes":17} +data.id.2 {"exBudgetCPU":161100,"exBudgetMemory":800,"scriptSizeBytes":17} +data.id.11/3 {"exBudgetCPU":13897101,"exBudgetMemory":33539,"scriptSizeBytes":289} +div by 0.1/0 {"exBudgetCPU":591291,"exBudgetMemory":136,"scriptSizeBytes":289} +div by 0.recip 0 {"exBudgetCPU":498395,"exBudgetMemory":134,"scriptSizeBytes":90} +div by 0.1/(1-1) {"exBudgetCPU":9190865,"exBudgetMemory":20168,"scriptSizeBytes":368} \ No newline at end of file diff --git a/plutarch-test/goldens/rational.compare.bench.golden b/plutarch-test/goldens/rational.compare.bench.golden deleted file mode 100644 index 6491ee7f6..000000000 --- a/plutarch-test/goldens/rational.compare.bench.golden +++ /dev/null @@ -1 +0,0 @@ -< {"exBudgetCPU":25140684,"exBudgetMemory":58473,"scriptSizeBytes":298} \ No newline at end of file diff --git a/plutarch-test/goldens/rational.compare.uplc.eval.golden b/plutarch-test/goldens/rational.compare.uplc.eval.golden deleted file mode 100644 index b33a7688c..000000000 --- a/plutarch-test/goldens/rational.compare.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -< (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/rational.compare.uplc.golden b/plutarch-test/goldens/rational.compare.uplc.golden deleted file mode 100644 index 5d367b7b5..000000000 --- a/plutarch-test/goldens/rational.compare.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -< (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> lessThanInteger (multiplyInteger i1 i4) (multiplyInteger i2 i3)))) (i1 (\i0 -> i1 2 1) (\i0 -> i1 9 1)) (i1 (\i0 -> i1 3 1) (\i0 -> i1 10 1))) (\i0 -> \i0 -> i3 (i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> i1 (multiplyInteger i5 i2) (multiplyInteger i4 i3)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 (multiplyInteger i2 (divideInteger i5 i3)) (multiplyInteger i2 (divideInteger i4 i3))) (force (i10 (equalsInteger i2 0) (delay 0) (delay (force (i10 (lessThanEqualsInteger i2 0) (delay (subtractInteger 0 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i7 i2 i1) (i8 i3 i2)) (i8 i2 i1)) (force (i8 (lessThanEqualsInteger i2 (subtractInteger 0 1)) (delay (subtractInteger 0 i2)) (delay i2)))) (force (i7 (lessThanEqualsInteger i2 (subtractInteger 0 1)) (delay (subtractInteger 0 i2)) (delay i2))))) (i1 (\i0 -> \i0 -> \i0 -> force (i7 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i4 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> \i0 -> force (i3 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (force ifThenElse))) \ No newline at end of file diff --git a/plutarch-test/goldens/rational.literal.uplc.eval.golden b/plutarch-test/goldens/rational.literal.uplc.eval.golden deleted file mode 100644 index 0dcc5a2f3..000000000 --- a/plutarch-test/goldens/rational.literal.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> i1 1 2)) \ No newline at end of file diff --git a/plutarch-test/goldens/rational.literal.uplc.golden b/plutarch-test/goldens/rational.literal.uplc.golden deleted file mode 100644 index 0dcc5a2f3..000000000 --- a/plutarch-test/goldens/rational.literal.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> i1 1 2)) \ No newline at end of file diff --git a/plutarch-test/goldens/rational.ops.bench.golden b/plutarch-test/goldens/rational.ops.bench.golden deleted file mode 100644 index 262c8b0b7..000000000 --- a/plutarch-test/goldens/rational.ops.bench.golden +++ /dev/null @@ -1,3 +0,0 @@ -+ {"exBudgetCPU":29624522,"exBudgetMemory":70391,"scriptSizeBytes":309} -- {"exBudgetCPU":29624522,"exBudgetMemory":70391,"scriptSizeBytes":309} -* {"exBudgetCPU":53544398,"exBudgetMemory":123567,"scriptSizeBytes":353} \ No newline at end of file diff --git a/plutarch-test/goldens/rational.ops.uplc.eval.golden b/plutarch-test/goldens/rational.ops.uplc.eval.golden deleted file mode 100644 index 9a9de27ef..000000000 --- a/plutarch-test/goldens/rational.ops.uplc.eval.golden +++ /dev/null @@ -1,3 +0,0 @@ -+ (program 1.0.0 (\i0 -> i1 (multiplyInteger 1 (divideInteger 4 4)) (multiplyInteger 1 (divideInteger 4 4)))) -- (program 1.0.0 (\i0 -> i1 (multiplyInteger 1 (divideInteger 1 1)) (multiplyInteger 1 (divideInteger 6 1)))) -* (program 1.0.0 (\i0 -> i1 (multiplyInteger 1 (divideInteger 1 1)) (multiplyInteger 1 (divideInteger 4 1)))) \ No newline at end of file diff --git a/plutarch-test/goldens/rational.ops.uplc.golden b/plutarch-test/goldens/rational.ops.uplc.golden deleted file mode 100644 index efc174720..000000000 --- a/plutarch-test/goldens/rational.ops.uplc.golden +++ /dev/null @@ -1,3 +0,0 @@ -+ (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i4 (i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> i1 (addInteger (multiplyInteger i5 i2) (multiplyInteger i3 i4)) (multiplyInteger i4 i2))))) (i1 (\i0 -> i1 1 1) (\i0 -> i1 2 1)) (i1 (\i0 -> i1 1 1) (\i0 -> i1 2 1))) (\i0 -> \i0 -> i3 (i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> i1 (multiplyInteger i5 i2) (multiplyInteger i4 i3)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 (multiplyInteger i2 (divideInteger i5 i3)) (multiplyInteger i2 (divideInteger i4 i3))) (force (i10 (equalsInteger i2 0) (delay 0) (delay (force (i10 (lessThanEqualsInteger i2 0) (delay (subtractInteger 0 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i7 i2 i1) (i8 i3 i2)) (i8 i2 i1)) (force (i8 (lessThanEqualsInteger i2 (subtractInteger 0 1)) (delay (subtractInteger 0 i2)) (delay i2)))) (force (i7 (lessThanEqualsInteger i2 (subtractInteger 0 1)) (delay (subtractInteger 0 i2)) (delay i2))))) (i1 (\i0 -> \i0 -> \i0 -> force (i7 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i4 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> \i0 -> force (i3 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (force ifThenElse))) -- (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i4 (i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> i1 (subtractInteger (multiplyInteger i5 i2) (multiplyInteger i3 i4)) (multiplyInteger i4 i2))))) (i1 (\i0 -> i1 1 1) (\i0 -> i1 2 1)) (i1 (\i0 -> i1 1 1) (\i0 -> i1 3 1))) (\i0 -> \i0 -> i3 (i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> i1 (multiplyInteger i5 i2) (multiplyInteger i4 i3)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 (multiplyInteger i2 (divideInteger i5 i3)) (multiplyInteger i2 (divideInteger i4 i3))) (force (i10 (equalsInteger i2 0) (delay 0) (delay (force (i10 (lessThanEqualsInteger i2 0) (delay (subtractInteger 0 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i7 i2 i1) (i8 i3 i2)) (i8 i2 i1)) (force (i8 (lessThanEqualsInteger i2 (subtractInteger 0 1)) (delay (subtractInteger 0 i2)) (delay i2)))) (force (i7 (lessThanEqualsInteger i2 (subtractInteger 0 1)) (delay (subtractInteger 0 i2)) (delay i2))))) (i1 (\i0 -> \i0 -> \i0 -> force (i7 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i4 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> \i0 -> force (i3 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (force ifThenElse))) -* (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i5 (i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> i1 (multiplyInteger i5 i3) (multiplyInteger i4 i2))))) (i1 (\i0 -> i1 1 1) (i2 (\i0 -> i1 3 1) (\i0 -> i1 2 1))) (i1 (\i0 -> i1 2 1) (i2 (\i0 -> i1 5 1) (\i0 -> i1 2 1)))) (\i0 -> \i0 -> i4 (i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> i1 (subtractInteger (multiplyInteger i5 i2) (multiplyInteger i3 i4)) (multiplyInteger i4 i2)))))) (\i0 -> \i0 -> i3 (i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> \i0 -> i1 (multiplyInteger i5 i2) (multiplyInteger i4 i3)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> \i0 -> i1 (multiplyInteger i2 (divideInteger i5 i3)) (multiplyInteger i2 (divideInteger i4 i3))) (force (i10 (equalsInteger i2 0) (delay 0) (delay (force (i10 (lessThanEqualsInteger i2 0) (delay (subtractInteger 0 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i7 i2 i1) (i8 i3 i2)) (i8 i2 i1)) (force (i8 (lessThanEqualsInteger i2 (subtractInteger 0 1)) (delay (subtractInteger 0 i2)) (delay i2)))) (force (i7 (lessThanEqualsInteger i2 (subtractInteger 0 1)) (delay (subtractInteger 0 i2)) (delay i2))))) (i1 (\i0 -> \i0 -> \i0 -> force (i7 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i4 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> \i0 -> force (i3 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (force ifThenElse))) \ No newline at end of file diff --git a/plutarch-test/goldens/rational.uplc.eval.golden b/plutarch-test/goldens/rational.uplc.eval.golden new file mode 100644 index 000000000..07186d02c --- /dev/null +++ b/plutarch-test/goldens/rational.uplc.eval.golden @@ -0,0 +1,24 @@ +literal (program 1.0.0 (\i0 -> i1 1 2)) +ops.+ (program 1.0.0 (\i0 -> i1 1 1)) +ops.- (program 1.0.0 (\i0 -> i1 1 6)) +ops.* (program 1.0.0 (\i0 -> i1 1 4)) +ops.harmonic-sum (program 1.0.0 (\i0 -> i1 77 60)) +ops.multi-product (program 1.0.0 (\i0 -> i1 1 6)) +compare (program 1.0.0 True) +round.5/3 (program 1.0.0 2) +round.4/3 (program 1.0.0 1) +round.-5/2 (program 1.0.0 -2) +round.-1/4 (program 1.0.0 0) +truncate.5/4 (program 1.0.0 1) +truncate.7/4 (program 1.0.0 1) +truncate.1/4 (program 1.0.0 0) +truncate.-7/4 (program 1.0.0 -1) +properFraction.-1/2 (program 1.0.0 True) +properFraction.-3/2 (program 1.0.0 True) +properFraction.-4/3 (program 1.0.0 True) +data.id.0.5 (program 1.0.0 (\i0 -> i1 1 2)) +data.id.2 (program 1.0.0 (\i0 -> i1 2 1)) +data.id.11/3 (program 1.0.0 (\i0 -> i1 11 3)) +div by 0.1/0 (program 1.0.0 error) +div by 0.recip 0 (program 1.0.0 error) +div by 0.1/(1-1) (program 1.0.0 error) \ No newline at end of file diff --git a/plutarch-test/goldens/rational.uplc.golden b/plutarch-test/goldens/rational.uplc.golden new file mode 100644 index 000000000..2ec5f55dd --- /dev/null +++ b/plutarch-test/goldens/rational.uplc.golden @@ -0,0 +1,24 @@ +literal (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 2) 1)) +ops.+ (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i8 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (addInteger (multiplyInteger i4 i1) (multiplyInteger i2 i3)))))) (i1 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)) (i1 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +ops.- (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i8 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (subtractInteger (multiplyInteger i4 i1) (multiplyInteger i2 i3)))))) (i1 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)) (i1 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +ops.* (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i9 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (multiplyInteger i4 i2))))) (i1 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2))) (i1 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2) (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 5) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i8 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (subtractInteger (multiplyInteger i4 i1) (multiplyInteger i2 i3))))))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +ops.harmonic-sum (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (i1 (i1 (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)) (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3))) (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4))) (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 5))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i8 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (addInteger (multiplyInteger i4 i1) (multiplyInteger i2 i3))))))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +ops.multi-product (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (i1 (i2 (i1 (i2 (i1 (i2 (i1 (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3)) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3)) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4)) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4)) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 5)) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 5)) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 6)) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i8 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (multiplyInteger i4 i2)))))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +compare (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> lessThanInteger (multiplyInteger i1 i4) (multiplyInteger i2 i3)))) (i1 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 9)) (i1 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 10))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +round.5/3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger i2 (force (i8 (equalsInteger (modInteger i3 2) 1) (delay (force (i8 (lessThanInteger (divideInteger i3 2) i1) (delay 1) (delay 0)))) (delay (force (i8 (equalsInteger (divideInteger i3 2) i1) (delay (modInteger i2 2)) (delay (force (i8 (lessThanInteger i1 (divideInteger i3 2)) (delay 0) (delay 1)))))))))) (modInteger i3 i2)) (divideInteger i2 i1))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 5) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +round.4/3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger i2 (force (i8 (equalsInteger (modInteger i3 2) 1) (delay (force (i8 (lessThanInteger (divideInteger i3 2) i1) (delay 1) (delay 0)))) (delay (force (i8 (equalsInteger (divideInteger i3 2) i1) (delay (modInteger i2 2)) (delay (force (i8 (lessThanInteger i1 (divideInteger i3 2)) (delay 0) (delay 1)))))))))) (modInteger i3 i2)) (divideInteger i2 i1))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +round.-5/2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger i2 (force (i8 (equalsInteger (modInteger i3 2) 1) (delay (force (i8 (lessThanInteger (divideInteger i3 2) i1) (delay 1) (delay 0)))) (delay (force (i8 (equalsInteger (divideInteger i3 2) i1) (delay (modInteger i2 2)) (delay (force (i8 (lessThanInteger i1 (divideInteger i3 2)) (delay 0) (delay 1)))))))))) (modInteger i3 i2)) (divideInteger i2 i1))) ((\i0 -> i1 (\i0 -> \i0 -> (\i0 -> \i0 -> i1 i2 i3) (i5 i2))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 5) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +round.-1/4 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> addInteger i2 (force (i8 (equalsInteger (modInteger i3 2) 1) (delay (force (i8 (lessThanInteger (divideInteger i3 2) i1) (delay 1) (delay 0)))) (delay (force (i8 (equalsInteger (divideInteger i3 2) i1) (delay (modInteger i2 2)) (delay (force (i8 (lessThanInteger i1 (divideInteger i3 2)) (delay 0) (delay 1)))))))))) (modInteger i3 i2)) (divideInteger i2 i1))) ((\i0 -> i1 (\i0 -> \i0 -> (\i0 -> \i0 -> i1 i2 i3) (i5 i2))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4)))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +truncate.5/4 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> force (i7 (lessThanEqualsInteger 0 i3) (delay i1) (delay (addInteger i1 (force (i7 (equalsInteger (modInteger i3 i2) 0) (delay 0) (delay 1))))))) (divideInteger i2 i1))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 5) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +truncate.7/4 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> force (i7 (lessThanEqualsInteger 0 i3) (delay i1) (delay (addInteger i1 (force (i7 (equalsInteger (modInteger i3 i2) 0) (delay 0) (delay 1))))))) (divideInteger i2 i1))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 7) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +truncate.1/4 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> force (i7 (lessThanEqualsInteger 0 i3) (delay i1) (delay (addInteger i1 (force (i7 (equalsInteger (modInteger i3 i2) 0) (delay 0) (delay 1))))))) (divideInteger i2 i1))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +truncate.-7/4 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> force (i7 (lessThanEqualsInteger 0 i3) (delay i1) (delay (addInteger i1 (force (i7 (equalsInteger (modInteger i3 i2) 0) (delay 0) (delay 1))))))) (divideInteger i2 i1))) ((\i0 -> i1 (\i0 -> \i0 -> (\i0 -> \i0 -> i1 i2 i3) (i5 i2))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 7) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4)))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +properFraction.-1/2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) ((\i0 -> i3 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i10 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (subtractInteger (multiplyInteger i4 i1) (multiplyInteger i2 i3)))))) ((\i0 -> \i0 -> i1 i3 i2) 1))) (i1 (\i0 -> \i0 -> (\i0 -> force (i16 (lessThanEqualsInteger 0 i3) (delay i1) (delay (addInteger i1 (force (i16 (equalsInteger (modInteger i3 i2) 0) (delay 0) (delay 1))))))) (divideInteger i2 i1)))) (i1 (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2))) (\i0 -> \i0 -> force ((\i0 -> \i0 -> i16 i2 i1 (delay False)) (equalsInteger i2 0) (delay ((\i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> equalsInteger (multiplyInteger i1 i4) (multiplyInteger i2 i3)))) (i3 (i4 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)))))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> \i0 -> i1 i2 i3) (i12 i2)))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +properFraction.-3/2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) ((\i0 -> i3 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i10 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (subtractInteger (multiplyInteger i4 i1) (multiplyInteger i2 i3)))))) ((\i0 -> \i0 -> i1 i3 i2) 1))) (i1 (\i0 -> \i0 -> (\i0 -> force (i16 (lessThanEqualsInteger 0 i3) (delay i1) (delay (addInteger i1 (force (i16 (equalsInteger (modInteger i3 i2) 0) (delay 0) (delay 1))))))) (divideInteger i2 i1)))) (i1 (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2))) (\i0 -> \i0 -> force ((\i0 -> \i0 -> i16 i2 i1 (delay False)) (equalsInteger i2 (i12 1)) (delay ((\i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> equalsInteger (multiplyInteger i1 i4) (multiplyInteger i2 i3)))) (i3 (i4 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)))))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> \i0 -> i1 i2 i3) (i12 i2)))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +properFraction.-4/3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) ((\i0 -> i3 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i10 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (subtractInteger (multiplyInteger i4 i1) (multiplyInteger i2 i3)))))) ((\i0 -> \i0 -> i1 i3 i2) 1))) (i1 (\i0 -> \i0 -> (\i0 -> force (i16 (lessThanEqualsInteger 0 i3) (delay i1) (delay (addInteger i1 (force (i16 (equalsInteger (modInteger i3 i2) 0) (delay 0) (delay 1))))))) (divideInteger i2 i1)))) (i1 (i2 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 4) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3))) (\i0 -> \i0 -> force ((\i0 -> \i0 -> i16 i2 i1 (delay False)) (equalsInteger i2 (i12 1)) (delay ((\i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> equalsInteger (multiplyInteger i1 i4) (multiplyInteger i2 i3)))) (i3 (i4 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3)))))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> \i0 -> i1 i2 i3) (i12 i2)))) (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) (i15 (multiplyInteger i3 i2)))))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i13 (equalsInteger i2 0) (delay 0) (delay (force (i13 (lessThanEqualsInteger i2 0) (delay (i11 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i10 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i7 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i6 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i4 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (\i0 -> force (i2 (lessThanEqualsInteger i1 0) (delay (force (i3 i4 (delay error)))) (delay i1)))) (force ifThenElse)) (force trace)) "ptryPositive: building with non positive")) +data.id.0.5 (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 2) 1)) +data.id.2 (program 1.0.0 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2)) +data.id.11/3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 11) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 3)) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +div by 0.1/0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i14 (equalsInteger i2 0) (delay 0) (delay (force (i14 (lessThanEqualsInteger i2 0) (delay (i13 1)) (delay 1))))))) ((\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> force (i18 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i15 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i12 i2)) (i11 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i10 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 0)) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) +div by 0.recip 0 (program 1.0.0 ((\i0 -> i1 (\i0 -> \i0 -> (\i0 -> \i0 -> i1 i3 i2) (force (force ifThenElse (lessThanEqualsInteger i2 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 0))) +div by 0.1/(1-1) (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> i8 ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i15 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> i7 ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i4 i2)) (subtractInteger (multiplyInteger i4 i1) (multiplyInteger i2 i3)))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1))) (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i11 (equalsInteger i2 0) (delay 0) (delay (force (i11 (lessThanEqualsInteger i2 0) (delay (i12 1)) (delay 1))))))) (i4 i2 i1)))) (\i0 -> \i0 -> (\i0 -> (\i0 -> i5 (i7 i2 i1) (i8 i2 i1)) (i8 i2)) (i7 i2))) (i1 (\i0 -> \i0 -> \i0 -> force (i8 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> \i0 -> force (i5 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2)))) (\i0 -> \i0 -> force (i4 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) \ No newline at end of file diff --git a/plutarch-test/goldens/recursion.example.bench.golden b/plutarch-test/goldens/recursion.example.bench.golden new file mode 100644 index 000000000..0586b4e7f --- /dev/null +++ b/plutarch-test/goldens/recursion.example.bench.golden @@ -0,0 +1,3 @@ +iterateN.lam {"exBudgetCPU":230100,"exBudgetMemory":1100,"scriptSizeBytes":53} +iterateN.app.succ {"exBudgetCPU":17710019,"exBudgetMemory":45362,"scriptSizeBytes":65} +iterateN.app.double {"exBudgetCPU":16574209,"exBudgetMemory":45362,"scriptSizeBytes":65} \ No newline at end of file diff --git a/plutarch-test/goldens/recursion.example.iterateN.bench.golden b/plutarch-test/goldens/recursion.example.iterateN.bench.golden deleted file mode 100644 index 87c0d711b..000000000 --- a/plutarch-test/goldens/recursion.example.iterateN.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":297830,"exBudgetMemory":1100,"scriptSizeBytes":53} \ No newline at end of file diff --git a/plutarch-test/goldens/recursion.example.iterateN.uplc.eval.golden b/plutarch-test/goldens/recursion.example.iterateN.uplc.eval.golden deleted file mode 100644 index 9d49a3960..000000000 --- a/plutarch-test/goldens/recursion.example.iterateN.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay ((\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay (i4 (subtractInteger i3 1) i2 (i2 i1))))) (\i0 -> i2 i2 i1)) (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay (i4 (subtractInteger i3 1) i2 (i2 i1))))) (\i0 -> i2 i2 i1)) i1) (subtractInteger i3 1) i2 (i2 i1)))))) \ No newline at end of file diff --git a/plutarch-test/goldens/recursion.example.iterateN.uplc.golden b/plutarch-test/goldens/recursion.example.iterateN.uplc.golden deleted file mode 100644 index b474fd9f1..000000000 --- a/plutarch-test/goldens/recursion.example.iterateN.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay (i4 (subtractInteger i3 1) i2 (i2 i1))))))) \ No newline at end of file diff --git a/plutarch-test/goldens/recursion.example.uplc.eval.golden b/plutarch-test/goldens/recursion.example.uplc.eval.golden new file mode 100644 index 000000000..ae3fa5d70 --- /dev/null +++ b/plutarch-test/goldens/recursion.example.uplc.eval.golden @@ -0,0 +1,3 @@ +iterateN.lam (program 1.0.0 (\i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay ((\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay (i4 (subtractInteger i3 1) i2 (i2 i1))))) (\i0 -> i2 i2 i1)) (\i0 -> (\i0 -> \i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay (i4 (subtractInteger i3 1) i2 (i2 i1))))) (\i0 -> i2 i2 i1)) i1) (subtractInteger i3 1) i2 (i2 i1)))))) +iterateN.app.succ (program 1.0.0 10) +iterateN.app.double (program 1.0.0 1024) \ No newline at end of file diff --git a/plutarch-test/goldens/recursion.example.uplc.golden b/plutarch-test/goldens/recursion.example.uplc.golden new file mode 100644 index 000000000..ccf9c0206 --- /dev/null +++ b/plutarch-test/goldens/recursion.example.uplc.golden @@ -0,0 +1,3 @@ +iterateN.lam (program 1.0.0 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay (i4 (subtractInteger i3 1) i2 (i2 i1))))))) +iterateN.app.succ (program 1.0.0 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay (i4 (subtractInteger i3 1) i2 (i2 i1))))) 10 (\i0 -> addInteger i1 1) 0)) +iterateN.app.double (program 1.0.0 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> \i0 -> \i0 -> force (force ifThenElse (equalsInteger i3 0) (delay i1) (delay (i4 (subtractInteger i3 1) i2 (i2 i1))))) 10 (\i0 -> multiplyInteger i1 2) 1)) \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth stake validator.uplc.golden b/plutarch-test/goldens/scripts.auth stake validator.uplc.golden deleted file mode 100644 index d6b3b2803..000000000 --- a/plutarch-test/goldens/scripts.auth stake validator.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> force (i3 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i6 (equalsData (i8 i1) i3) (delay True) (delay (i2 (i7 i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> i6 ((\i0 -> i6 (i6 (i6 (i6 (i6 (i6 (i6 i1))))))) (i7 i1))) (i5 (i6 i1))))) (delay ()) (delay error))) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_policy.hash.golden b/plutarch-test/goldens/scripts.auth_policy.hash.golden deleted file mode 100644 index a64f01b91..000000000 --- a/plutarch-test/goldens/scripts.auth_policy.hash.golden +++ /dev/null @@ -1 +0,0 @@ -581cb9f49b1f51a0c1c285c9fde6b1da21e7094f7c19efb6eeace1ada858 \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_policy.uplc.eval.golden b/plutarch-test/goldens/scripts.auth_policy.uplc.eval.golden deleted file mode 100644 index b66a171ce..000000000 --- a/plutarch-test/goldens/scripts.auth_policy.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> force (force ifThenElse ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (force ifThenElse (equalsData (force headList i1) i3) (delay True) (delay (i2 (force tailList i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> force headList ((\i0 -> force tailList (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList i1))))))) ((\i0 -> force (force sndPair) (unConstrData i1)) i1))) (force headList ((\i0 -> force (force sndPair) (unConstrData i1)) i1))))) (delay ()) (delay error)))) \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_policy.uplc.golden b/plutarch-test/goldens/scripts.auth_policy.uplc.golden deleted file mode 100644 index d6b3b2803..000000000 --- a/plutarch-test/goldens/scripts.auth_policy.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> force (i3 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i6 (equalsData (i8 i1) i3) (delay True) (delay (i2 (i7 i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> i6 ((\i0 -> i6 (i6 (i6 (i6 (i6 (i6 (i6 i1))))))) (i7 i1))) (i5 (i6 i1))))) (delay ()) (delay error))) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_stake_validator.hash.golden b/plutarch-test/goldens/scripts.auth_stake_validator.hash.golden deleted file mode 100644 index a64f01b91..000000000 --- a/plutarch-test/goldens/scripts.auth_stake_validator.hash.golden +++ /dev/null @@ -1 +0,0 @@ -581cb9f49b1f51a0c1c285c9fde6b1da21e7094f7c19efb6eeace1ada858 \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_stake_validator.uplc.eval.golden b/plutarch-test/goldens/scripts.auth_stake_validator.uplc.eval.golden deleted file mode 100644 index b66a171ce..000000000 --- a/plutarch-test/goldens/scripts.auth_stake_validator.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> force (force ifThenElse ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (force ifThenElse (equalsData (force headList i1) i3) (delay True) (delay (i2 (force tailList i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> force headList ((\i0 -> force tailList (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList i1))))))) ((\i0 -> force (force sndPair) (unConstrData i1)) i1))) (force headList ((\i0 -> force (force sndPair) (unConstrData i1)) i1))))) (delay ()) (delay error)))) \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_stake_validator.uplc.golden b/plutarch-test/goldens/scripts.auth_stake_validator.uplc.golden deleted file mode 100644 index d6b3b2803..000000000 --- a/plutarch-test/goldens/scripts.auth_stake_validator.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> force (i3 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i6 (equalsData (i8 i1) i3) (delay True) (delay (i2 (i7 i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> i6 ((\i0 -> i6 (i6 (i6 (i6 (i6 (i6 (i6 i1))))))) (i7 i1))) (i5 (i6 i1))))) (delay ()) (delay error))) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_validator.hash.golden b/plutarch-test/goldens/scripts.auth_validator.hash.golden deleted file mode 100644 index e2c047a34..000000000 --- a/plutarch-test/goldens/scripts.auth_validator.hash.golden +++ /dev/null @@ -1 +0,0 @@ -581cb8c68ee0b38d3c830ae47aec8154b1c35eeabaceaf2c00bea1f33865 \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_validator.uplc.eval.golden b/plutarch-test/goldens/scripts.auth_validator.uplc.eval.golden deleted file mode 100644 index 8b9af4f50..000000000 --- a/plutarch-test/goldens/scripts.auth_validator.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> \i0 -> force (force ifThenElse (verifySignature #11661a8aca9b09bb93eefda295b5da2be3f944d1f4253ab29da17db580f50d02d26218e33fbba5e0cc1b0c0cadfb67a5f9a90157dcc19eecd7c9373b0415c888 (unBData i3) (unBData i2)) (delay ()) (delay error)))) \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.auth_validator.uplc.golden b/plutarch-test/goldens/scripts.auth_validator.uplc.golden deleted file mode 100644 index 8b9af4f50..000000000 --- a/plutarch-test/goldens/scripts.auth_validator.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (\i0 -> \i0 -> \i0 -> force (force ifThenElse (verifySignature #11661a8aca9b09bb93eefda295b5da2be3f944d1f4253ab29da17db580f50d02d26218e33fbba5e0cc1b0c0cadfb67a5f9a90157dcc19eecd7c9373b0415c888 (unBData i3) (unBData i2)) (delay ()) (delay error)))) \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.bench.golden b/plutarch-test/goldens/scripts.bench.golden new file mode 100644 index 000000000..3d967bd99 --- /dev/null +++ b/plutarch-test/goldens/scripts.bench.golden @@ -0,0 +1,6 @@ +auth_validator.0 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":155} +auth_validator.hash {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":70} +auth_policy.0 {"exBudgetCPU":483100,"exBudgetMemory":2200,"scriptSizeBytes":144} +auth_policy.hash {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":70} +auth_stake_validator.0 {"exBudgetCPU":483100,"exBudgetMemory":2200,"scriptSizeBytes":144} +auth_stake_validator.hash {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":70} \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.uplc.eval.golden b/plutarch-test/goldens/scripts.uplc.eval.golden new file mode 100644 index 000000000..8f850d233 --- /dev/null +++ b/plutarch-test/goldens/scripts.uplc.eval.golden @@ -0,0 +1,6 @@ +auth_validator.0 (program 1.0.0 (\i0 -> \i0 -> \i0 -> force (force ifThenElse (verifyEd25519Signature #3131363631613861636139623039626239336565666461323935623564613262653366393434643166343235336162323964613137646235383066353064303264323632313865333366626261356530636331623063306361646662363761356639613930313537646363313965656364376339333733623034313563383838 (unBData i3) (unBData i2)) (delay ()) (delay error)))) +auth_validator.hash (program 1.0.0 "581c8ac3f00bb148ff48cb551e7d5ea877863d152e75f459e0066f3dd047") +auth_policy.0 (program 1.0.0 (\i0 -> \i0 -> force (force ifThenElse ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (force ifThenElse (equalsData (force headList i1) i3) (delay True) (delay (i2 (force tailList i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> force headList ((\i0 -> force tailList (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList i1))))))) ((\i0 -> force (force sndPair) (unConstrData i1)) i1))) (force headList ((\i0 -> force (force sndPair) (unConstrData i1)) i1))))) (delay ()) (delay error)))) +auth_policy.hash (program 1.0.0 "581cb9f49b1f51a0c1c285c9fde6b1da21e7094f7c19efb6eeace1ada858") +auth_stake_validator.0 (program 1.0.0 (\i0 -> \i0 -> force (force ifThenElse ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (force ifThenElse (equalsData (force headList i1) i3) (delay True) (delay (i2 (force tailList i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> force headList ((\i0 -> force tailList (force tailList (force tailList (force tailList (force tailList (force tailList (force tailList i1))))))) ((\i0 -> force (force sndPair) (unConstrData i1)) i1))) (force headList ((\i0 -> force (force sndPair) (unConstrData i1)) i1))))) (delay ()) (delay error)))) +auth_stake_validator.hash (program 1.0.0 "581cb9f49b1f51a0c1c285c9fde6b1da21e7094f7c19efb6eeace1ada858") \ No newline at end of file diff --git a/plutarch-test/goldens/scripts.uplc.golden b/plutarch-test/goldens/scripts.uplc.golden new file mode 100644 index 000000000..e2368a834 --- /dev/null +++ b/plutarch-test/goldens/scripts.uplc.golden @@ -0,0 +1,6 @@ +auth_validator.0 (program 1.0.0 (\i0 -> \i0 -> \i0 -> force (force ifThenElse (verifyEd25519Signature #3131363631613861636139623039626239336565666461323935623564613262653366393434643166343235336162323964613137646235383066353064303264323632313865333366626261356530636331623063306361646662363761356639613930313537646363313965656364376339333733623034313563383838 (unBData i3) (unBData i2)) (delay ()) (delay error)))) +auth_validator.hash (program 1.0.0 "581c8ac3f00bb148ff48cb551e7d5ea877863d152e75f459e0066f3dd047") +auth_policy.0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> force (i3 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i6 (equalsData (i8 i1) i3) (delay True) (delay (i2 (i7 i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> i6 ((\i0 -> i6 (i6 (i6 (i6 (i6 (i6 (i6 i1))))))) (i7 i1))) (i5 (i6 i1))))) (delay ()) (delay error))) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +auth_policy.hash (program 1.0.0 "581cb9f49b1f51a0c1c285c9fde6b1da21e7094f7c19efb6eeace1ada858") +auth_stake_validator.0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> \i0 -> force (i3 ((\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> force (force (force chooseList) i1 (delay False) (delay (force (i6 (equalsData (i8 i1) i3) (delay True) (delay (i2 (i7 i1))))))))) #581ccc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f (unListData ((\i0 -> i6 ((\i0 -> i6 (i6 (i6 (i6 (i6 (i6 (i6 i1))))))) (i7 i1))) (i5 (i6 i1))))) (delay ()) (delay error))) (force ifThenElse)) (force tailList)) (force headList)) (\i0 -> i2 (unConstrData i1))) (force (force sndPair)))) +auth_stake_validator.hash (program 1.0.0 "581cb9f49b1f51a0c1c285c9fde6b1da21e7094f7c19efb6eeace1ada858") \ No newline at end of file diff --git a/plutarch-test/goldens/show.bench.golden b/plutarch-test/goldens/show.bench.golden new file mode 100644 index 000000000..a0407ff6d --- /dev/null +++ b/plutarch-test/goldens/show.bench.golden @@ -0,0 +1,36 @@ +unit {"exBudgetCPU":92100,"exBudgetMemory":500,"scriptSizeBytes":13} +bool.true {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":33} +bool.false {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":33} +int.0 {"exBudgetCPU":6396998,"exBudgetMemory":15821,"scriptSizeBytes":306} +int.5 {"exBudgetCPU":9224443,"exBudgetMemory":21831,"scriptSizeBytes":306} +int.-5 {"exBudgetCPU":9983574,"exBudgetMemory":23236,"scriptSizeBytes":306} +int.10 {"exBudgetCPU":12581916,"exBudgetMemory":29051,"scriptSizeBytes":306} +int.-10 {"exBudgetCPU":13341047,"exBudgetMemory":30456,"scriptSizeBytes":306} +int.14 {"exBudgetCPU":14843872,"exBudgetMemory":33859,"scriptSizeBytes":306} +int.-14 {"exBudgetCPU":15603003,"exBudgetMemory":35264,"scriptSizeBytes":306} +int.102 {"exBudgetCPU":19380677,"exBudgetMemory":43485,"scriptSizeBytes":307} +int.-102 {"exBudgetCPU":20139808,"exBudgetMemory":44890,"scriptSizeBytes":307} +bytestring.empty {"exBudgetCPU":2593943,"exBudgetMemory":9918,"scriptSizeBytes":414} +bytestring.1 {"exBudgetCPU":10473299,"exBudgetMemory":27270,"scriptSizeBytes":416} +bytestring.2 {"exBudgetCPU":29710789,"exBudgetMemory":68664,"scriptSizeBytes":417} +bytestring.3 {"exBudgetCPU":36555875,"exBudgetMemory":83616,"scriptSizeBytes":418} +bytestring.n {"exBudgetCPU":68788748,"exBudgetMemory":152130,"scriptSizeBytes":418} +bytestring.0 {"exBudgetCPU":17894738,"exBudgetMemory":43950,"scriptSizeBytes":418} +str.empty {"exBudgetCPU":2142713,"exBudgetMemory":5633,"scriptSizeBytes":128} +str.hello123 {"exBudgetCPU":27030233,"exBudgetMemory":65073,"scriptSizeBytes":137} +str.quoted {"exBudgetCPU":30518590,"exBudgetMemory":72910,"scriptSizeBytes":138} +str.slash {"exBudgetCPU":23919293,"exBudgetMemory":57643,"scriptSizeBytes":136} +str.unicode {"exBudgetCPU":33189676,"exBudgetMemory":79932,"scriptSizeBytes":139} +str.unicode-quoted {"exBudgetCPU":40139276,"exBudgetMemory":95604,"scriptSizeBytes":141} +maybe.nothing {"exBudgetCPU":1265100,"exBudgetMemory":5600,"scriptSizeBytes":342} +maybe.just {"exBudgetCPU":16206308,"exBudgetMemory":37380,"scriptSizeBytes":347} +either.right {"exBudgetCPU":16299485,"exBudgetMemory":37681,"scriptSizeBytes":360} +maybe.either {"exBudgetCPU":18173450,"exBudgetMemory":41142,"scriptSizeBytes":423} +list.nil {"exBudgetCPU":2963985,"exBudgetMemory":11943,"scriptSizeBytes":397} +list.1 {"exBudgetCPU":10073511,"exBudgetMemory":28264,"scriptSizeBytes":398} +list.1,2,3 {"exBudgetCPU":28141986,"exBudgetMemory":70956,"scriptSizeBytes":401} +builtinlist.nil {"exBudgetCPU":2756985,"exBudgetMemory":11043,"scriptSizeBytes":389} +builtinlist.1,2,3 {"exBudgetCPU":26137058,"exBudgetMemory":60484,"scriptSizeBytes":392} +pair.int-str {"exBudgetCPU":34865639,"exBudgetMemory":80705,"scriptSizeBytes":454} +pair.int-list {"exBudgetCPU":42325700,"exBudgetMemory":93314,"scriptSizeBytes":434} +rational.1/2 {"exBudgetCPU":24862351,"exBudgetMemory":59194,"scriptSizeBytes":568} \ No newline at end of file diff --git a/plutarch-test/goldens/show.uplc.eval.golden b/plutarch-test/goldens/show.uplc.eval.golden new file mode 100644 index 000000000..fe0f3a9aa --- /dev/null +++ b/plutarch-test/goldens/show.uplc.eval.golden @@ -0,0 +1,36 @@ +unit (program 1.0.0 "()") +bool.true (program 1.0.0 "PTrue") +bool.false (program 1.0.0 "PFalse") +int.0 (program 1.0.0 "0") +int.5 (program 1.0.0 "5") +int.-5 (program 1.0.0 "-5") +int.10 (program 1.0.0 "10") +int.-10 (program 1.0.0 "-10") +int.14 (program 1.0.0 "14") +int.-14 (program 1.0.0 "-14") +int.102 (program 1.0.0 "102") +int.-102 (program 1.0.0 "-102") +bytestring.empty (program 1.0.0 "0x") +bytestring.1 (program 1.0.0 "0x14") +bytestring.2 (program 1.0.0 "0x14af") +bytestring.3 (program 1.0.0 "0x14af03") +bytestring.n (program 1.0.0 "0xffffff") +bytestring.0 (program 1.0.0 "0x000000") +str.empty (program 1.0.0 "\"\"") +str.hello123 (program 1.0.0 "\"hello123\"") +str.quoted (program 1.0.0 "\"hello\\\"123\"") +str.slash (program 1.0.0 "\"foo\\bar\"") +str.unicode (program 1.0.0 "\"vis-\224-vis\"") +str.unicode-quoted (program 1.0.0 "\"vis-\\\"\224\\\"-vis\"") +maybe.nothing (program 1.0.0 "PNothing") +maybe.just (program 1.0.0 "PJust 42") +either.right (program 1.0.0 "PRight 42") +maybe.either (program 1.0.0 "PJust (PLeft 42)") +list.nil (program 1.0.0 "[]") +list.1 (program 1.0.0 "[1]") +list.1,2,3 (program 1.0.0 "[1, 2, 3]") +builtinlist.nil (program 1.0.0 "[]") +builtinlist.1,2,3 (program 1.0.0 "[1, 2, 3]") +pair.int-str (program 1.0.0 "PPair 42 \"hello\"") +pair.int-list (program 1.0.0 "PPair 42 [1, 2, 3]") +rational.1/2 (program 1.0.0 "1/2") \ No newline at end of file diff --git a/plutarch-test/goldens/show.uplc.golden b/plutarch-test/goldens/show.uplc.golden new file mode 100644 index 000000000..cd10b85e0 --- /dev/null +++ b/plutarch-test/goldens/show.uplc.golden @@ -0,0 +1,36 @@ +unit (program 1.0.0 ((\i0 -> "()") ())) +bool.true (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay "PTrue") (delay "PFalse"))) True)) +bool.false (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay "PTrue") (delay "PFalse"))) False)) +int.0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) 0) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +int.5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) 5) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +int.-5 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) -5) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +int.10 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) 10) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +int.-10 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) -10) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +int.14 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) 14) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +int.-14 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) -14) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +int.102 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) 102) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +int.-102 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i15 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i17 (equalsInteger i2 0) (delay (i5 i1)) (delay ((\i0 -> appendString i1 (i6 i2)) (i4 i2))))) (remainderInteger (i15 i2) 10)) (quotientInteger (i14 i1) 10))) -102) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +bytestring.empty (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "0x" ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> \i0 -> (\i0 -> force (i23 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i5)) (indexByteString i4 0))))) (lengthOfByteString i3)) "" (\i0 -> \i0 -> appendString ((\i0 -> (\i0 -> appendString (i8 i2) (i8 i1)) (remainderInteger i3 16)) (quotientInteger i2 16)) (i4 i1))) i1)) #) (\i0 -> force (i17 (equalsInteger i1 0) (delay i2) (delay (force (i17 (equalsInteger i1 1) (delay i3) (delay (force (i17 (equalsInteger i1 2) (delay i4) (delay (force (i17 (equalsInteger i1 3) (delay i5) (delay (force (i17 (equalsInteger i1 4) (delay i6) (delay (force (i17 (equalsInteger i1 5) (delay i7) (delay (force (i17 (equalsInteger i1 6) (delay i8) (delay (force (i17 (equalsInteger i1 7) (delay i9) (delay (force (i17 (equalsInteger i1 8) (delay i10) (delay (force (i17 (equalsInteger i1 9) (delay i11) (delay (force (i17 (equalsInteger i1 10) (delay i12) (delay (force (i17 (equalsInteger i1 11) (delay i13) (delay (force (i17 (equalsInteger i1 12) (delay i14) (delay (force (i17 (equalsInteger i1 13) (delay i15) (delay (force (i17 (equalsInteger i1 14) (delay i16) (delay (force (i17 (equalsInteger i1 15) (delay i18) (delay error))))))))))))))))))))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") "a") "b") "c") "d") "e") (force ifThenElse)) "f")) +bytestring.1 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "0x" ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> \i0 -> (\i0 -> force (i23 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i5)) (indexByteString i4 0))))) (lengthOfByteString i3)) "" (\i0 -> \i0 -> appendString ((\i0 -> (\i0 -> appendString (i8 i2) (i8 i1)) (remainderInteger i3 16)) (quotientInteger i2 16)) (i4 i1))) i1)) #14) (\i0 -> force (i17 (equalsInteger i1 0) (delay i2) (delay (force (i17 (equalsInteger i1 1) (delay i3) (delay (force (i17 (equalsInteger i1 2) (delay i4) (delay (force (i17 (equalsInteger i1 3) (delay i5) (delay (force (i17 (equalsInteger i1 4) (delay i6) (delay (force (i17 (equalsInteger i1 5) (delay i7) (delay (force (i17 (equalsInteger i1 6) (delay i8) (delay (force (i17 (equalsInteger i1 7) (delay i9) (delay (force (i17 (equalsInteger i1 8) (delay i10) (delay (force (i17 (equalsInteger i1 9) (delay i11) (delay (force (i17 (equalsInteger i1 10) (delay i12) (delay (force (i17 (equalsInteger i1 11) (delay i13) (delay (force (i17 (equalsInteger i1 12) (delay i14) (delay (force (i17 (equalsInteger i1 13) (delay i15) (delay (force (i17 (equalsInteger i1 14) (delay i16) (delay (force (i17 (equalsInteger i1 15) (delay i18) (delay error))))))))))))))))))))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") "a") "b") "c") "d") "e") (force ifThenElse)) "f")) +bytestring.2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "0x" ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> \i0 -> (\i0 -> force (i23 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i5)) (indexByteString i4 0))))) (lengthOfByteString i3)) "" (\i0 -> \i0 -> appendString ((\i0 -> (\i0 -> appendString (i8 i2) (i8 i1)) (remainderInteger i3 16)) (quotientInteger i2 16)) (i4 i1))) i1)) #14af) (\i0 -> force (i17 (equalsInteger i1 0) (delay i2) (delay (force (i17 (equalsInteger i1 1) (delay i3) (delay (force (i17 (equalsInteger i1 2) (delay i4) (delay (force (i17 (equalsInteger i1 3) (delay i5) (delay (force (i17 (equalsInteger i1 4) (delay i6) (delay (force (i17 (equalsInteger i1 5) (delay i7) (delay (force (i17 (equalsInteger i1 6) (delay i8) (delay (force (i17 (equalsInteger i1 7) (delay i9) (delay (force (i17 (equalsInteger i1 8) (delay i10) (delay (force (i17 (equalsInteger i1 9) (delay i11) (delay (force (i17 (equalsInteger i1 10) (delay i12) (delay (force (i17 (equalsInteger i1 11) (delay i13) (delay (force (i17 (equalsInteger i1 12) (delay i14) (delay (force (i17 (equalsInteger i1 13) (delay i15) (delay (force (i17 (equalsInteger i1 14) (delay i16) (delay (force (i17 (equalsInteger i1 15) (delay i18) (delay error))))))))))))))))))))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") "a") "b") "c") "d") "e") (force ifThenElse)) "f")) +bytestring.3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "0x" ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> \i0 -> (\i0 -> force (i23 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i5)) (indexByteString i4 0))))) (lengthOfByteString i3)) "" (\i0 -> \i0 -> appendString ((\i0 -> (\i0 -> appendString (i8 i2) (i8 i1)) (remainderInteger i3 16)) (quotientInteger i2 16)) (i4 i1))) i1)) #14af03) (\i0 -> force (i17 (equalsInteger i1 0) (delay i2) (delay (force (i17 (equalsInteger i1 1) (delay i3) (delay (force (i17 (equalsInteger i1 2) (delay i4) (delay (force (i17 (equalsInteger i1 3) (delay i5) (delay (force (i17 (equalsInteger i1 4) (delay i6) (delay (force (i17 (equalsInteger i1 5) (delay i7) (delay (force (i17 (equalsInteger i1 6) (delay i8) (delay (force (i17 (equalsInteger i1 7) (delay i9) (delay (force (i17 (equalsInteger i1 8) (delay i10) (delay (force (i17 (equalsInteger i1 9) (delay i11) (delay (force (i17 (equalsInteger i1 10) (delay i12) (delay (force (i17 (equalsInteger i1 11) (delay i13) (delay (force (i17 (equalsInteger i1 12) (delay i14) (delay (force (i17 (equalsInteger i1 13) (delay i15) (delay (force (i17 (equalsInteger i1 14) (delay i16) (delay (force (i17 (equalsInteger i1 15) (delay i18) (delay error))))))))))))))))))))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") "a") "b") "c") "d") "e") (force ifThenElse)) "f")) +bytestring.n (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "0x" ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> \i0 -> (\i0 -> force (i23 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i5)) (indexByteString i4 0))))) (lengthOfByteString i3)) "" (\i0 -> \i0 -> appendString ((\i0 -> (\i0 -> appendString (i8 i2) (i8 i1)) (remainderInteger i3 16)) (quotientInteger i2 16)) (i4 i1))) i1)) #ffffff) (\i0 -> force (i17 (equalsInteger i1 0) (delay i2) (delay (force (i17 (equalsInteger i1 1) (delay i3) (delay (force (i17 (equalsInteger i1 2) (delay i4) (delay (force (i17 (equalsInteger i1 3) (delay i5) (delay (force (i17 (equalsInteger i1 4) (delay i6) (delay (force (i17 (equalsInteger i1 5) (delay i7) (delay (force (i17 (equalsInteger i1 6) (delay i8) (delay (force (i17 (equalsInteger i1 7) (delay i9) (delay (force (i17 (equalsInteger i1 8) (delay i10) (delay (force (i17 (equalsInteger i1 9) (delay i11) (delay (force (i17 (equalsInteger i1 10) (delay i12) (delay (force (i17 (equalsInteger i1 11) (delay i13) (delay (force (i17 (equalsInteger i1 12) (delay i14) (delay (force (i17 (equalsInteger i1 13) (delay i15) (delay (force (i17 (equalsInteger i1 14) (delay i16) (delay (force (i17 (equalsInteger i1 15) (delay i18) (delay error))))))))))))))))))))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") "a") "b") "c") "d") "e") (force ifThenElse)) "f")) +bytestring.0 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "0x" ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> \i0 -> (\i0 -> force (i23 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i5)) (indexByteString i4 0))))) (lengthOfByteString i3)) "" (\i0 -> \i0 -> appendString ((\i0 -> (\i0 -> appendString (i8 i2) (i8 i1)) (remainderInteger i3 16)) (quotientInteger i2 16)) (i4 i1))) i1)) #000000) (\i0 -> force (i17 (equalsInteger i1 0) (delay i2) (delay (force (i17 (equalsInteger i1 1) (delay i3) (delay (force (i17 (equalsInteger i1 2) (delay i4) (delay (force (i17 (equalsInteger i1 3) (delay i5) (delay (force (i17 (equalsInteger i1 4) (delay i6) (delay (force (i17 (equalsInteger i1 5) (delay i7) (delay (force (i17 (equalsInteger i1 6) (delay i8) (delay (force (i17 (equalsInteger i1 7) (delay i9) (delay (force (i17 (equalsInteger i1 8) (delay i10) (delay (force (i17 (equalsInteger i1 9) (delay i11) (delay (force (i17 (equalsInteger i1 10) (delay i12) (delay (force (i17 (equalsInteger i1 11) (delay i13) (delay (force (i17 (equalsInteger i1 12) (delay i14) (delay (force (i17 (equalsInteger i1 13) (delay i15) (delay (force (i17 (equalsInteger i1 14) (delay i16) (delay (force (i17 (equalsInteger i1 15) (delay i18) (delay error))))))))))))))))))))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") "a") "b") "c") "d") "e") (force ifThenElse)) "f")) +str.empty (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> appendString i3 (appendString (decodeUtf8 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i4)) (indexByteString i3 0))))) (lengthOfByteString i2)) (\i0 -> \i0 -> force (i6 (equalsInteger i2 34) (delay (consByteString 92 (consByteString i2 (i4 i1)))) (delay (consByteString i2 (i4 i1)))))) (encodeUtf8 i1))) i3)) "") (force ifThenElse)) "\"")) +str.hello123 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> appendString i3 (appendString (decodeUtf8 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i4)) (indexByteString i3 0))))) (lengthOfByteString i2)) (\i0 -> \i0 -> force (i6 (equalsInteger i2 34) (delay (consByteString 92 (consByteString i2 (i4 i1)))) (delay (consByteString i2 (i4 i1)))))) (encodeUtf8 i1))) i3)) "hello123") (force ifThenElse)) "\"")) +str.quoted (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> appendString i3 (appendString (decodeUtf8 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i4)) (indexByteString i3 0))))) (lengthOfByteString i2)) (\i0 -> \i0 -> force (i6 (equalsInteger i2 34) (delay (consByteString 92 (consByteString i2 (i4 i1)))) (delay (consByteString i2 (i4 i1)))))) (encodeUtf8 i1))) i3)) "hello\"123") (force ifThenElse)) "\"")) +str.slash (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> appendString i3 (appendString (decodeUtf8 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i4)) (indexByteString i3 0))))) (lengthOfByteString i2)) (\i0 -> \i0 -> force (i6 (equalsInteger i2 34) (delay (consByteString 92 (consByteString i2 (i4 i1)))) (delay (consByteString i2 (i4 i1)))))) (encodeUtf8 i1))) i3)) "foo\\bar") (force ifThenElse)) "\"")) +str.unicode (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> appendString i3 (appendString (decodeUtf8 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i4)) (indexByteString i3 0))))) (lengthOfByteString i2)) (\i0 -> \i0 -> force (i6 (equalsInteger i2 34) (delay (consByteString 92 (consByteString i2 (i4 i1)))) (delay (consByteString i2 (i4 i1)))))) (encodeUtf8 i1))) i3)) "vis-\224-vis") (force ifThenElse)) "\"")) +str.unicode-quoted (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> appendString i3 (appendString (decodeUtf8 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i6 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i4)) (indexByteString i3 0))))) (lengthOfByteString i2)) (\i0 -> \i0 -> force (i6 (equalsInteger i2 34) (delay (consByteString 92 (consByteString i2 (i4 i1)))) (delay (consByteString i2 (i4 i1)))))) (encodeUtf8 i1))) i3)) "vis-\"\224\"-vis") (force ifThenElse)) "\"")) +maybe.nothing (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> appendString "PJust" (appendString " " ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i17 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i19 (equalsInteger i2 0) (delay (i7 i1)) (delay ((\i0 -> appendString i1 (i8 i2)) (i4 i2))))) (remainderInteger (i17 i2) 10)) (quotientInteger (i16 i1) 10))) i1))) (delay "PNothing")) (\i0 -> \i0 -> force i1)) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +maybe.just (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> appendString "PJust" (appendString " " ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i17 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i19 (equalsInteger i2 0) (delay (i7 i1)) (delay ((\i0 -> appendString i1 (i8 i2)) (i4 i2))))) (remainderInteger (i17 i2) 10)) (quotientInteger (i16 i1) 10))) i1))) (delay "PNothing")) ((\i0 -> \i0 -> \i0 -> i2 i3) 42)) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +either.right (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> appendString "PLeft" (appendString i3 "()")) (\i0 -> appendString "PRight" (appendString i3 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i18 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i20 (equalsInteger i2 0) (delay (i8 i1)) (delay ((\i0 -> appendString i1 (i9 i2)) (i4 i2))))) (remainderInteger (i18 i2) 10)) (quotientInteger (i17 i1) 10))) i1)))) ((\i0 -> \i0 -> \i0 -> i1 i3) 42)) " ") (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +maybe.either (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> appendString "PJust" (appendString i18 (i1 (\i0 -> appendString i18 (appendString (appendString "PLeft" (appendString i19 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i18 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i20 (equalsInteger i2 0) (delay (i8 i1)) (delay ((\i0 -> appendString i1 (i9 i2)) (i4 i2))))) (remainderInteger (i18 i2) 10)) (quotientInteger (i17 i1) 10))) i1))) i20)) (\i0 -> appendString i18 (appendString (appendString "PRight" (appendString i19 "()")) i20))))) (delay "PNothing")) ((\i0 -> \i0 -> \i0 -> i2 i3) ((\i0 -> \i0 -> \i0 -> i2 i3) 42))) (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1)) "(") " ") ")")) +list.nil (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "[" (appendString (i19 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> appendString (i8 i4) (appendString ", " (i6 i3))) (delay (i6 i2))) (delay i20)) i1) "]")) (i18 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [])) (i17 (\i0 -> \i0 -> appendString (force (i16 (lessThanInteger i1 0) (delay i3) (delay i18))) ((\i0 -> (\i0 -> force (i18 (equalsInteger i2 0) (delay (i6 i1)) (delay ((\i0 -> appendString i1 (i7 i2)) (i4 i2))))) (remainderInteger (i16 i2) 10)) (quotientInteger (i15 i1) 10))))) "-") (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1)) "") (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +list.1 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "[" (appendString (i19 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> appendString (i8 i4) (appendString ", " (i6 i3))) (delay (i6 i2))) (delay i20)) i1) "]")) (i18 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1])) (i17 (\i0 -> \i0 -> appendString (force (i16 (lessThanInteger i1 0) (delay i3) (delay i18))) ((\i0 -> (\i0 -> force (i18 (equalsInteger i2 0) (delay (i6 i1)) (delay ((\i0 -> appendString i1 (i7 i2)) (i4 i2))))) (remainderInteger (i16 i2) 10)) (quotientInteger (i15 i1) 10))))) "-") (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1)) "") (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +list.1,2,3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "[" (appendString (i19 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> i1 (\i0 -> \i0 -> appendString (i8 i4) (appendString ", " (i6 i3))) (delay (i6 i2))) (delay i20)) i1) "]")) (i18 (\i0 -> \i0 -> force (force (force chooseList) i1 (delay (\i0 -> \i0 -> force i1)) (delay ((\i0 -> \i0 -> \i0 -> \i0 -> i2 i4 i3) (force headList i1) (i2 (force tailList i1)))))) [1,2,3])) (i17 (\i0 -> \i0 -> appendString (force (i16 (lessThanInteger i1 0) (delay i3) (delay i18))) ((\i0 -> (\i0 -> force (i18 (equalsInteger i2 0) (delay (i6 i1)) (delay ((\i0 -> appendString i1 (i7 i2)) (i4 i2))))) (remainderInteger (i16 i2) 10)) (quotientInteger (i15 i1) 10))))) "-") (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1)) "") (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))))) +builtinlist.nil (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "[" (appendString (i4 (\i0 -> \i0 -> force (i4 i1 (delay i8) (delay ((\i0 -> force (i5 i1 (delay (i6 (i24 i2))) (delay (appendString (i6 (i24 i2)) (appendString ", " (i3 (i25 i2))))))) (i24 i1))))) i1) "]")) []) (force (force chooseList))) (i1 (\i0 -> \i0 -> appendString (force (i18 (lessThanInteger i1 0) (delay i4) (delay i5))) ((\i0 -> (\i0 -> force (i20 (equalsInteger i2 0) (delay (i8 i1)) (delay ((\i0 -> appendString i1 (i9 i2)) (i4 i2))))) (remainderInteger (i18 i2) 10)) (quotientInteger (i17 i1) 10))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) "-") "") (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1)) (force headList)) (force tailList))) +builtinlist.1,2,3 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> appendString "[" (appendString (i4 (\i0 -> \i0 -> force (i4 i1 (delay i8) (delay ((\i0 -> force (i5 i1 (delay (i6 (i24 i2))) (delay (appendString (i6 (i24 i2)) (appendString ", " (i3 (i25 i2))))))) (i24 i1))))) i1) "]")) [1,2,3]) (force (force chooseList))) (i1 (\i0 -> \i0 -> appendString (force (i18 (lessThanInteger i1 0) (delay i4) (delay i5))) ((\i0 -> (\i0 -> force (i20 (equalsInteger i2 0) (delay (i8 i1)) (delay ((\i0 -> appendString i1 (i9 i2)) (i4 i2))))) (remainderInteger (i18 i2) 10)) (quotientInteger (i17 i1) 10))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) "-") "") (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1)) (force headList)) (force tailList))) +pair.int-str (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> appendString "PPair" (appendString i17 (appendString (i18 (\i0 -> \i0 -> appendString (force (i21 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i23 (equalsInteger i2 0) (delay (i8 i1)) (delay ((\i0 -> appendString i1 (i9 i2)) (i4 i2))))) (remainderInteger (i18 i2) 10)) (quotientInteger (i17 i1) 10))) i2) (appendString i17 (appendString i20 (appendString (decodeUtf8 (i18 (\i0 -> \i0 -> (\i0 -> (\i0 -> force (i23 (equalsInteger i1 0) (delay i3) (delay ((\i0 -> (\i0 -> i4 i2 i1) (sliceByteString 1 (subtractInteger i2 1) i4)) (indexByteString i3 0))))) (lengthOfByteString i2)) (\i0 -> \i0 -> force (i23 (equalsInteger i2 34) (delay (consByteString 92 (consByteString i2 (i4 i1)))) (delay (consByteString i2 (i4 i1)))))) (encodeUtf8 i1))) i20))))))) ((\i0 -> \i0 -> i1 i2 "hello") 42)) (\i0 -> force (i16 (equalsInteger i1 0) (delay i2) (delay (force (i16 (equalsInteger i1 1) (delay i3) (delay (force (i16 (equalsInteger i1 2) (delay i4) (delay (force (i16 (equalsInteger i1 3) (delay i5) (delay (force (i16 (equalsInteger i1 4) (delay i6) (delay (force (i16 (equalsInteger i1 5) (delay i7) (delay (force (i16 (equalsInteger i1 6) (delay i8) (delay (force (i16 (equalsInteger i1 7) (delay i9) (delay (force (i16 (equalsInteger i1 8) (delay i10) (delay (force (i16 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i5 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) " ") (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (force ifThenElse)) "\"")) +pair.int-list (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> appendString "PPair" (appendString i4 (appendString (i6 i2) (appendString i4 (appendString "[" (appendString (i7 (\i0 -> \i0 -> force (i7 i1 (delay i11) (delay ((\i0 -> force (i8 i1 (delay (i9 (i27 i2))) (delay (appendString (i9 (i27 i2)) (appendString ", " (i3 (i28 i2))))))) (i27 i1))))) i1) "]"))))))) ((\i0 -> \i0 -> i1 i2 [1,2,3]) 42)) " ") (force (force chooseList))) (i1 (\i0 -> \i0 -> appendString (force (i18 (lessThanInteger i1 0) (delay i4) (delay i5))) ((\i0 -> (\i0 -> force (i20 (equalsInteger i2 0) (delay (i8 i1)) (delay ((\i0 -> appendString i1 (i9 i2)) (i4 i2))))) (remainderInteger (i18 i2) 10)) (quotientInteger (i17 i1) 10))))) (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) "-") "") (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1)) (force headList)) (force tailList))) +rational.1/2 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> appendString (i4 i2) (appendString "/" (i4 i1)))) ((\i0 -> \i0 -> i2 (\i0 -> \i0 -> i3 (\i0 -> \i0 -> (\i0 -> (\i0 -> i1 (\i0 -> \i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> \i0 -> i1 i3 i2) (multiplyInteger i2 (divideInteger i4 i3))) (multiplyInteger i1 (divideInteger i4 i2))) (force (i29 (equalsInteger i2 0) (delay 0) (delay (force (i29 (lessThanEqualsInteger i2 0) (delay (i28 1)) (delay 1))))))) ((\i0 -> (\i0 -> i27 (\i0 -> \i0 -> \i0 -> force (i33 (equalsInteger i1 0) (delay i2) (delay (i3 i1 (modInteger i2 i1))))) (force (i30 (lessThanEqualsInteger i2 i1) (delay i1) (delay i2))) (force (i30 (lessThanEqualsInteger i2 i1) (delay i2) (delay i1)))) (i27 i2)) (i26 i2)))) ((\i0 -> \i0 -> i1 i2 i3) (multiplyInteger i5 i2))) ((\i0 -> force (i25 (lessThanEqualsInteger i1 0) (delay (force (force trace "ptryPositive: building with non positive" (delay error)))) (delay i1))) (multiplyInteger i3 i2))))) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 1) ((\i0 -> (\i0 -> \i0 -> i1 i3 i2) 1) 2))) (i14 (\i0 -> \i0 -> appendString (force (i19 (lessThanInteger i1 0) (delay i3) (delay i4))) ((\i0 -> (\i0 -> force (i21 (equalsInteger i2 0) (delay (i7 i1)) (delay ((\i0 -> appendString i1 (i8 i2)) (i4 i2))))) (remainderInteger (i18 i2) 10)) (quotientInteger (i17 i1) 10))))) "-") "") (\i0 -> force (i15 (equalsInteger i1 0) (delay i2) (delay (force (i15 (equalsInteger i1 1) (delay i3) (delay (force (i15 (equalsInteger i1 2) (delay i4) (delay (force (i15 (equalsInteger i1 3) (delay i5) (delay (force (i15 (equalsInteger i1 4) (delay i6) (delay (force (i15 (equalsInteger i1 5) (delay i7) (delay (force (i15 (equalsInteger i1 6) (delay i8) (delay (force (i15 (equalsInteger i1 7) (delay i9) (delay (force (i15 (equalsInteger i1 8) (delay i10) (delay (force (i15 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1)))) (\i0 -> force (i3 (lessThanEqualsInteger i1 (i2 1)) (delay (i2 i1)) (delay i1)))) (\i0 -> subtractInteger 0 i1)) (force ifThenElse))) \ No newline at end of file diff --git a/plutarch-test/goldens/str.bench.golden b/plutarch-test/goldens/str.bench.golden new file mode 100644 index 000000000..e29874316 --- /dev/null +++ b/plutarch-test/goldens/str.bench.golden @@ -0,0 +1,5 @@ +eq {"exBudgetCPU":344094,"exBudgetMemory":901,"scriptSizeBytes":18} +semigroup.laws.id.1 {"exBudgetCPU":509625,"exBudgetMemory":1308,"scriptSizeBytes":24} +semigroup.laws.id.2 {"exBudgetCPU":509625,"exBudgetMemory":1308,"scriptSizeBytes":23} +semigroup.concat {"exBudgetCPU":672150,"exBudgetMemory":1011,"scriptSizeBytes":35} +semigroup.mempty {"exBudgetCPU":185100,"exBudgetMemory":901,"scriptSizeBytes":14} \ No newline at end of file diff --git a/plutarch-test/goldens/str.eq.bench.golden b/plutarch-test/goldens/str.eq.bench.golden deleted file mode 100644 index f101e03db..000000000 --- a/plutarch-test/goldens/str.eq.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":389284,"exBudgetMemory":901,"scriptSizeBytes":18} \ No newline at end of file diff --git a/plutarch-test/goldens/str.eq.uplc.eval.golden b/plutarch-test/goldens/str.eq.uplc.eval.golden deleted file mode 100644 index 6f6141e6e..000000000 --- a/plutarch-test/goldens/str.eq.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/str.eq.uplc.golden b/plutarch-test/goldens/str.eq.uplc.golden deleted file mode 100644 index 63513b313..000000000 --- a/plutarch-test/goldens/str.eq.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ((\i0 -> equalsString i1 i1) "foo")) \ No newline at end of file diff --git a/plutarch-test/goldens/str.semigroup.bench.golden b/plutarch-test/goldens/str.semigroup.bench.golden deleted file mode 100644 index c7b8dada0..000000000 --- a/plutarch-test/goldens/str.semigroup.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":300965,"exBudgetMemory":602,"scriptSizeBytes":21} \ No newline at end of file diff --git a/plutarch-test/goldens/str.semigroup.uplc.eval.golden b/plutarch-test/goldens/str.semigroup.uplc.eval.golden deleted file mode 100644 index f164f6bbc..000000000 --- a/plutarch-test/goldens/str.semigroup.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 "foobar") \ No newline at end of file diff --git a/plutarch-test/goldens/str.semigroup.uplc.golden b/plutarch-test/goldens/str.semigroup.uplc.golden deleted file mode 100644 index 2f346f9ce..000000000 --- a/plutarch-test/goldens/str.semigroup.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 (appendString "foo" "bar")) \ No newline at end of file diff --git a/plutarch-test/goldens/str.uplc.eval.golden b/plutarch-test/goldens/str.uplc.eval.golden new file mode 100644 index 000000000..ca90e11c5 --- /dev/null +++ b/plutarch-test/goldens/str.uplc.eval.golden @@ -0,0 +1,5 @@ +eq (program 1.0.0 True) +semigroup.laws.id.1 (program 1.0.0 True) +semigroup.laws.id.2 (program 1.0.0 True) +semigroup.concat (program 1.0.0 True) +semigroup.mempty (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/str.uplc.golden b/plutarch-test/goldens/str.uplc.golden new file mode 100644 index 000000000..6ec6d23da --- /dev/null +++ b/plutarch-test/goldens/str.uplc.golden @@ -0,0 +1,5 @@ +eq (program 1.0.0 ((\i0 -> equalsString i1 i1) "foo")) +semigroup.laws.id.1 (program 1.0.0 ((\i0 -> equalsString (appendString "" i1) i1) "foo")) +semigroup.laws.id.2 (program 1.0.0 ((\i0 -> equalsString i1 (appendString "" i1)) "foo")) +semigroup.concat (program 1.0.0 (equalsString (appendString "foo" "bar") "foobar")) +semigroup.mempty (program 1.0.0 ((\i0 -> equalsString i1 i1) "")) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.bench.golden b/plutarch-test/goldens/trace.bench.golden new file mode 100644 index 000000000..8ca483b2c --- /dev/null +++ b/plutarch-test/goldens/trace.bench.golden @@ -0,0 +1,10 @@ +ptrace.one {"exBudgetCPU":396442,"exBudgetMemory":932,"scriptSizeBytes":16} +ptrace.two {"exBudgetCPU":815784,"exBudgetMemory":1864,"scriptSizeBytes":30} +ptraceShowId.right-42 {"exBudgetCPU":16741827,"exBudgetMemory":38713,"scriptSizeBytes":373} +ptraceIfTrue.true {"exBudgetCPU":706998,"exBudgetMemory":1933,"scriptSizeBytes":27} +ptraceIfTrue.false {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":27} +ptraceIfFalse.true {"exBudgetCPU":379656,"exBudgetMemory":1401,"scriptSizeBytes":27} +ptraceIfFalse.false {"exBudgetCPU":706998,"exBudgetMemory":1933,"scriptSizeBytes":27} +chained.false.true.false {"exBudgetCPU":1178554,"exBudgetMemory":3634,"scriptSizeBytes":51} +chained.ptrace.true.false {"exBudgetCPU":821998,"exBudgetMemory":2433,"scriptSizeBytes":40} +chained.ptrace.true.true {"exBudgetCPU":1126340,"exBudgetMemory":2865,"scriptSizeBytes":40} \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptrace.bench.golden b/plutarch-test/goldens/trace.dev=false.ptrace.bench.golden deleted file mode 100644 index a2816cf9f..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptrace.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -one {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} -two {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptrace.uplc.eval.golden b/plutarch-test/goldens/trace.dev=false.ptrace.uplc.eval.golden deleted file mode 100644 index afed943f4..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptrace.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -one (program 1.0.0 ()) -two (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptrace.uplc.golden b/plutarch-test/goldens/trace.dev=false.ptrace.uplc.golden deleted file mode 100644 index afed943f4..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptrace.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -one (program 1.0.0 ()) -two (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.bench.golden b/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.bench.golden deleted file mode 100644 index a956630ef..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -true {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} -false {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.uplc.eval.golden b/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.uplc.eval.golden deleted file mode 100644 index 5ac22f250..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -true (program 1.0.0 True) -false (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.uplc.golden b/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.uplc.golden deleted file mode 100644 index 5ac22f250..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptraceIfFalse.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -true (program 1.0.0 True) -false (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.bench.golden b/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.bench.golden deleted file mode 100644 index a956630ef..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -true {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} -false {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.uplc.eval.golden b/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.uplc.eval.golden deleted file mode 100644 index 5ac22f250..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -true (program 1.0.0 True) -false (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.uplc.golden b/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.uplc.golden deleted file mode 100644 index 5ac22f250..000000000 --- a/plutarch-test/goldens/trace.dev=false.ptraceIfTrue.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -true (program 1.0.0 True) -false (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptrace.bench.golden b/plutarch-test/goldens/trace.dev=true.ptrace.bench.golden deleted file mode 100644 index 1170ab911..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptrace.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -one {"exBudgetCPU":388284,"exBudgetMemory":932,"scriptSizeBytes":16} -two {"exBudgetCPU":806241,"exBudgetMemory":1864,"scriptSizeBytes":30} \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptrace.uplc.eval.golden b/plutarch-test/goldens/trace.dev=true.ptrace.uplc.eval.golden deleted file mode 100644 index afed943f4..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptrace.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -one (program 1.0.0 ()) -two (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptrace.uplc.golden b/plutarch-test/goldens/trace.dev=true.ptrace.uplc.golden deleted file mode 100644 index 1fee9ffaf..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptrace.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -one (program 1.0.0 (force (force trace "foo" (delay ())))) -two (program 1.0.0 ((\i0 -> force (i1 "foo" (delay (force (i1 "bar" (delay ())))))) (force trace))) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.bench.golden b/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.bench.golden deleted file mode 100644 index 6591c746e..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -true {"exBudgetCPU":387150,"exBudgetMemory":1401,"scriptSizeBytes":27} -false {"exBudgetCPU":686015,"exBudgetMemory":1933,"scriptSizeBytes":27} \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.uplc.eval.golden b/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.uplc.eval.golden deleted file mode 100644 index 5ac22f250..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -true (program 1.0.0 True) -false (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.uplc.golden b/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.uplc.golden deleted file mode 100644 index f3c9dcec6..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptraceIfFalse.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -true (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay i1) (delay (force trace "foo" i1)))) True)) -false (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay i1) (delay (force trace "foo" i1)))) False)) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.bench.golden b/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.bench.golden deleted file mode 100644 index 67ae0223c..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.bench.golden +++ /dev/null @@ -1,2 +0,0 @@ -true {"exBudgetCPU":686015,"exBudgetMemory":1933,"scriptSizeBytes":27} -false {"exBudgetCPU":387150,"exBudgetMemory":1401,"scriptSizeBytes":27} \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.uplc.eval.golden b/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.uplc.eval.golden deleted file mode 100644 index 5ac22f250..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.uplc.eval.golden +++ /dev/null @@ -1,2 +0,0 @@ -true (program 1.0.0 True) -false (program 1.0.0 False) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.uplc.golden b/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.uplc.golden deleted file mode 100644 index f6214aa00..000000000 --- a/plutarch-test/goldens/trace.dev=true.ptraceIfTrue.uplc.golden +++ /dev/null @@ -1,2 +0,0 @@ -true (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay (force trace "foo" i1)) (delay i1))) True)) -false (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay (force trace "foo" i1)) (delay i1))) False)) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.uplc.eval.golden b/plutarch-test/goldens/trace.uplc.eval.golden new file mode 100644 index 000000000..51bcda305 --- /dev/null +++ b/plutarch-test/goldens/trace.uplc.eval.golden @@ -0,0 +1,10 @@ +ptrace.one (program 1.0.0 ()) +ptrace.two (program 1.0.0 ()) +ptraceShowId.right-42 (program 1.0.0 (\i0 -> \i0 -> i1 42)) +ptraceIfTrue.true (program 1.0.0 True) +ptraceIfTrue.false (program 1.0.0 False) +ptraceIfFalse.true (program 1.0.0 True) +ptraceIfFalse.false (program 1.0.0 False) +chained.false.true.false (program 1.0.0 False) +chained.ptrace.true.false (program 1.0.0 False) +chained.ptrace.true.true (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/trace.uplc.golden b/plutarch-test/goldens/trace.uplc.golden new file mode 100644 index 000000000..e1625b0be --- /dev/null +++ b/plutarch-test/goldens/trace.uplc.golden @@ -0,0 +1,10 @@ +ptrace.one (program 1.0.0 (force (force trace "foo" (delay ())))) +ptrace.two (program 1.0.0 ((\i0 -> force (i1 "foo" (delay (force (i1 "bar" (delay ())))))) (force trace))) +ptraceShowId.right-42 (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> (\i0 -> force (force trace ((\i0 -> i1 (\i0 -> appendString "PLeft" (appendString i3 "()")) (\i0 -> appendString "PRight" (appendString i3 ((\i0 -> (\i0 -> i2 (\i0 -> i2 i2 i1)) (\i0 -> i2 (\i0 -> i2 i2 i1))) (\i0 -> \i0 -> appendString (force (i18 (lessThanInteger i1 0) (delay "-") (delay ""))) ((\i0 -> (\i0 -> force (i20 (equalsInteger i2 0) (delay (i8 i1)) (delay ((\i0 -> appendString i1 (i9 i2)) (i4 i2))))) (remainderInteger (i18 i2) 10)) (quotientInteger (i17 i1) 10))) i1)))) ((\i0 -> \i0 -> \i0 -> i1 i3) 42)) (delay ((\i0 -> \i0 -> \i0 -> i1 i3) 42)))) " ") (\i0 -> force (i13 (equalsInteger i1 0) (delay i2) (delay (force (i13 (equalsInteger i1 1) (delay i3) (delay (force (i13 (equalsInteger i1 2) (delay i4) (delay (force (i13 (equalsInteger i1 3) (delay i5) (delay (force (i13 (equalsInteger i1 4) (delay i6) (delay (force (i13 (equalsInteger i1 5) (delay i7) (delay (force (i13 (equalsInteger i1 6) (delay i8) (delay (force (i13 (equalsInteger i1 7) (delay i9) (delay (force (i13 (equalsInteger i1 8) (delay i10) (delay (force (i13 (equalsInteger i1 9) (delay i11) (delay error))))))))))))))))))))))))))))))) "0") "1") "2") "3") "4") "5") "6") "7") "8") "9") (\i0 -> force (i2 (lessThanEqualsInteger i1 (i3 1)) (delay (i3 i1)) (delay i1)))) (force ifThenElse)) (\i0 -> subtractInteger 0 i1))) +ptraceIfTrue.true (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay (force trace "foo" i1)) (delay i1))) True)) +ptraceIfTrue.false (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay (force trace "foo" i1)) (delay i1))) False)) +ptraceIfFalse.true (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay i1) (delay (force trace "foo" i1)))) True)) +ptraceIfFalse.false (program 1.0.0 ((\i0 -> force (force ifThenElse i1 (delay i1) (delay (force trace "foo" i1)))) False)) +chained.false.true.false (program 1.0.0 ((\i0 -> (\i0 -> (\i0 -> force (i2 i1 (delay i1) (delay (i3 "foo" i1)))) ((\i0 -> force (i2 i1 (delay (i3 "bar" i1)) (delay i1))) False)) (force ifThenElse)) (force trace))) +chained.ptrace.true.false (program 1.0.0 ((\i0 -> force (i1 "foo" (delay ((\i0 -> force (force ifThenElse i1 (delay (i2 "bar" i1)) (delay i1))) False)))) (force trace))) +chained.ptrace.true.true (program 1.0.0 ((\i0 -> force (i1 "foo" (delay ((\i0 -> force (force ifThenElse i1 (delay (i2 "bar" i1)) (delay i1))) True)))) (force trace))) \ No newline at end of file diff --git a/plutarch-test/goldens/unit.bench.golden b/plutarch-test/goldens/unit.bench.golden new file mode 100644 index 000000000..cd41099b4 --- /dev/null +++ b/plutarch-test/goldens/unit.bench.golden @@ -0,0 +1,5 @@ +pcon {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":6} +pmatch {"exBudgetCPU":92100,"exBudgetMemory":500,"scriptSizeBytes":8} +compare.== {"exBudgetCPU":161100,"exBudgetMemory":800,"scriptSizeBytes":10} +compare.< {"exBudgetCPU":161100,"exBudgetMemory":800,"scriptSizeBytes":10} +compare.<= {"exBudgetCPU":161100,"exBudgetMemory":800,"scriptSizeBytes":10} \ No newline at end of file diff --git a/plutarch-test/goldens/unit.compare.bench.golden b/plutarch-test/goldens/unit.compare.bench.golden deleted file mode 100644 index 9b5ece174..000000000 --- a/plutarch-test/goldens/unit.compare.bench.golden +++ /dev/null @@ -1,3 +0,0 @@ -== {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} -< {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} -<= {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} \ No newline at end of file diff --git a/plutarch-test/goldens/unit.compare.uplc.eval.golden b/plutarch-test/goldens/unit.compare.uplc.eval.golden deleted file mode 100644 index 8e479b21c..000000000 --- a/plutarch-test/goldens/unit.compare.uplc.eval.golden +++ /dev/null @@ -1,3 +0,0 @@ -== (program 1.0.0 True) -< (program 1.0.0 False) -<= (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/unit.compare.uplc.golden b/plutarch-test/goldens/unit.compare.uplc.golden deleted file mode 100644 index 8e479b21c..000000000 --- a/plutarch-test/goldens/unit.compare.uplc.golden +++ /dev/null @@ -1,3 +0,0 @@ -== (program 1.0.0 True) -< (program 1.0.0 False) -<= (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/unit.pcon.bench.golden b/plutarch-test/goldens/unit.pcon.bench.golden deleted file mode 100644 index c735abb6b..000000000 --- a/plutarch-test/goldens/unit.pcon.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} \ No newline at end of file diff --git a/plutarch-test/goldens/unit.pcon.uplc.eval.golden b/plutarch-test/goldens/unit.pcon.uplc.eval.golden deleted file mode 100644 index 582b47c79..000000000 --- a/plutarch-test/goldens/unit.pcon.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/unit.pcon.uplc.golden b/plutarch-test/goldens/unit.pcon.uplc.golden deleted file mode 100644 index 582b47c79..000000000 --- a/plutarch-test/goldens/unit.pcon.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 ()) \ No newline at end of file diff --git a/plutarch-test/goldens/unit.pmatch.bench.golden b/plutarch-test/goldens/unit.pmatch.bench.golden deleted file mode 100644 index c735abb6b..000000000 --- a/plutarch-test/goldens/unit.pmatch.bench.golden +++ /dev/null @@ -1 +0,0 @@ -0 {"exBudgetCPU":29873,"exBudgetMemory":200,"scriptSizeBytes":6} \ No newline at end of file diff --git a/plutarch-test/goldens/unit.pmatch.uplc.eval.golden b/plutarch-test/goldens/unit.pmatch.uplc.eval.golden deleted file mode 100644 index 6f6141e6e..000000000 --- a/plutarch-test/goldens/unit.pmatch.uplc.eval.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/unit.pmatch.uplc.golden b/plutarch-test/goldens/unit.pmatch.uplc.golden deleted file mode 100644 index 6f6141e6e..000000000 --- a/plutarch-test/goldens/unit.pmatch.uplc.golden +++ /dev/null @@ -1 +0,0 @@ -0 (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/unit.uplc.eval.golden b/plutarch-test/goldens/unit.uplc.eval.golden new file mode 100644 index 000000000..25660b104 --- /dev/null +++ b/plutarch-test/goldens/unit.uplc.eval.golden @@ -0,0 +1,5 @@ +pcon (program 1.0.0 ()) +pmatch (program 1.0.0 True) +compare.== (program 1.0.0 True) +compare.< (program 1.0.0 False) +compare.<= (program 1.0.0 True) \ No newline at end of file diff --git a/plutarch-test/goldens/unit.uplc.golden b/plutarch-test/goldens/unit.uplc.golden new file mode 100644 index 000000000..e282c9cd3 --- /dev/null +++ b/plutarch-test/goldens/unit.uplc.golden @@ -0,0 +1,5 @@ +pcon (program 1.0.0 ()) +pmatch (program 1.0.0 ((\i0 -> True) ())) +compare.== (program 1.0.0 ((\i0 -> (\i0 -> True) ()) ())) +compare.< (program 1.0.0 ((\i0 -> (\i0 -> False) ()) ())) +compare.<= (program 1.0.0 ((\i0 -> (\i0 -> True) ()) ())) \ No newline at end of file diff --git a/plutarch-test/goldens/uplc-behaviour.bench.golden b/plutarch-test/goldens/uplc-behaviour.bench.golden new file mode 100644 index 000000000..12b8afbb5 --- /dev/null +++ b/plutarch-test/goldens/uplc-behaviour.bench.golden @@ -0,0 +1,4 @@ +2:[1] {"exBudgetCPU":203593,"exBudgetMemory":732,"scriptSizeBytes":13} +fails:True:[1] {"exBudgetCPU":65593,"exBudgetMemory":132,"scriptSizeBytes":13} +(2,1) {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":10} +fails:MkPair-1-2 {"exBudgetCPU":100,"exBudgetMemory":100,"scriptSizeBytes":11} \ No newline at end of file diff --git a/plutarch-test/goldens/uplc-behaviour.uplc.eval.golden b/plutarch-test/goldens/uplc-behaviour.uplc.eval.golden new file mode 100644 index 000000000..246399d89 --- /dev/null +++ b/plutarch-test/goldens/uplc-behaviour.uplc.eval.golden @@ -0,0 +1,4 @@ +2:[1] (program 1.0.0 [2,1]) +fails:True:[1] (program 1.0.0 error) +(2,1) (program 1.0.0 (1, 2)) +fails:MkPair-1-2 (program 1.0.0 error) \ No newline at end of file diff --git a/plutarch-test/goldens/uplc-behaviour.uplc.golden b/plutarch-test/goldens/uplc-behaviour.uplc.golden new file mode 100644 index 000000000..b10d2a70b --- /dev/null +++ b/plutarch-test/goldens/uplc-behaviour.uplc.golden @@ -0,0 +1,4 @@ +2:[1] (program 1.0.0 (force mkCons 2 [1])) +fails:True:[1] (program 1.0.0 (force mkCons True [1])) +(2,1) (program 1.0.0 (1, 2)) +fails:MkPair-1-2 (program 1.0.0 (mkPairData 1 2)) \ No newline at end of file diff --git a/plutarch-test/goldens/uplc-misc.bench.golden b/plutarch-test/goldens/uplc-misc.bench.golden new file mode 100644 index 000000000..b156cb07c --- /dev/null +++ b/plutarch-test/goldens/uplc-misc.bench.golden @@ -0,0 +1,5 @@ +perror {"exBudgetCPU":100,"exBudgetMemory":100,"scriptSizeBytes":5} +laziness.f.d {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +laziness.d.f.d {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":7} +hoist.id.0 {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":9} +hoist.fstPair {"exBudgetCPU":23100,"exBudgetMemory":200,"scriptSizeBytes":6} \ No newline at end of file diff --git a/plutarch-test/goldens/uplc-misc.uplc.eval.golden b/plutarch-test/goldens/uplc-misc.uplc.eval.golden new file mode 100644 index 000000000..b1441b8f9 --- /dev/null +++ b/plutarch-test/goldens/uplc-misc.uplc.eval.golden @@ -0,0 +1,5 @@ +perror (program 1.0.0 error) +laziness.f.d (program 1.0.0 0) +laziness.d.f.d (program 1.0.0 (delay 0)) +hoist.id.0 (program 1.0.0 (\i0 -> i1 0)) +hoist.fstPair (program 1.0.0 fstPair) \ No newline at end of file diff --git a/plutarch-test/goldens/uplc-misc.uplc.golden b/plutarch-test/goldens/uplc-misc.uplc.golden new file mode 100644 index 000000000..b1441b8f9 --- /dev/null +++ b/plutarch-test/goldens/uplc-misc.uplc.golden @@ -0,0 +1,5 @@ +perror (program 1.0.0 error) +laziness.f.d (program 1.0.0 0) +laziness.d.f.d (program 1.0.0 (delay 0)) +hoist.id.0 (program 1.0.0 (\i0 -> i1 0)) +hoist.fstPair (program 1.0.0 fstPair) \ No newline at end of file diff --git a/plutarch-test/plutarch-base/BaseSpec.hs b/plutarch-test/plutarch-base/BaseSpec.hs new file mode 100644 index 000000000..108855af1 --- /dev/null +++ b/plutarch-test/plutarch-base/BaseSpec.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=BaseSpec #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} diff --git a/plutarch-test/plutarch-base/Plutarch/ApiSpec.hs b/plutarch-test/plutarch-base/Plutarch/ApiSpec.hs new file mode 100644 index 000000000..77176f6b3 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/ApiSpec.hs @@ -0,0 +1,538 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} + +-- NOTE: This module also contains ScriptContext mocks, which should ideally +-- moved to a module of its own after cleaning up to expose a easy to reason +-- about API. +module Plutarch.ApiSpec ( + spec, + ctx, + validContext0, + validOutputs0, + invalidContext1, + d0Dat, + d0DatValue, + inp, +) where + +import Test.Tasty.HUnit + +import Control.Monad (forM_) +import Control.Monad.Trans.Cont (cont, runCont) +import Data.String (fromString) +import Numeric (showHex) +import PlutusLedgerApi.V1 +import qualified PlutusLedgerApi.V1.Interval as Interval +import qualified PlutusLedgerApi.V1.Value as Value +import PlutusTx.Monoid (inv) + +import Plutarch.Api.V1 ( + AmountGuarantees (NoGuarantees, NonZero, Positive), + KeyGuarantees (Sorted), + PCredential, + PCurrencySymbol, + PMaybeData, + PPubKeyHash, + PScriptContext, + PScriptPurpose (PMinting, PSpending), + PStakingCredential, + PTxInInfo, + PTxInfo, + PValue, + ) +import qualified Plutarch.Api.V1.AssocMap as AssocMap +import qualified Plutarch.Api.V1.Value as PValue +import Plutarch.Builtin (pasConstr, pforgetData) +import Plutarch.Prelude +import Plutarch.Test +import Plutarch.Test.Property.Gen () + +import Test.Hspec +import Test.Tasty.QuickCheck (Property, property, (===)) + +import Plutarch.Lift (PConstanted, PLifted, PUnsafeLiftDecl (PLifted)) + +newtype EnclosedTerm (p :: PType) = EnclosedTerm {getEnclosedTerm :: ClosedTerm p} + +spec :: Spec +spec = do + describe "api" $ do + describe "ctx" $ do + pgoldenSpec $ do + "term" @| ctx + "get" @\ do + "txInfo" @| pfromData (getTxInfo # ctx) @-> \p -> + plift p @?= info + "mint" @| pforgetData (getMint #$ getTxInfo # ctx) @-> \p -> + plift p @?= toData mint + "credentials" @| getCredentials ctx @-> \p -> + plift p @?= [toData validator] + "sym" + @| pfromData (getSym #$ PValue.pnormalize #$ pfromData $ getMint #$ getTxInfo # ctx) + @-> \p -> plift p @?= sym + "ScriptPurpose" @\ do + "literal" @| pconstant @PScriptPurpose (Minting dummyCurrency) + "decode" + @| pmatch (pconstant @PScriptPurpose (Minting dummyCurrency)) + $ \case + PMinting c -> popaque c + _ -> perror + describe "value" $ do + pgoldenSpec $ do + let pmint = PValue.pconstantPositiveSingleton (pconstant "c0") (pconstant "sometoken") 1 + pmintOtherToken = PValue.pconstantPositiveSingleton (pconstant "c0") (pconstant "othertoken") 1 + pmintOtherSymbol = PValue.pconstantPositiveSingleton (pconstant "c7") (pconstant "sometoken") 1 + pada = PValue.pconstantPositiveSingleton PValue.padaSymbol PValue.padaToken 10_000_000 + growingSymbols, symbols :: [EnclosedTerm (PValue 'Sorted 'Positive)] + growingSymbols = + scanl + (\s v -> EnclosedTerm $ getEnclosedTerm s <> getEnclosedTerm v) + (EnclosedTerm pmint) + symbols + symbols = (\n -> EnclosedTerm (toSymbolicValue n)) <$> [0 .. 15] + toSymbolicValue :: Integer -> ClosedTerm (PValue 'Sorted 'Positive) + toSymbolicValue n = + PValue.pconstantPositiveSingleton (pconstant $ fromString $ "c" <> showHex n "") (pconstant "token") 1 + "singleton" @| pmint @-> \p -> + plift (PValue.pforgetSorted $ PValue.pforgetPositive p) @?= mint + "singletonData" + @| PValue.psingletonData # pdata (pconstant "c0") # pdata (pconstant "sometoken") # pdata 1 + @-> \p -> plift (PValue.pforgetSorted p) @?= mint + "valueOf" @\ do + "itself" @| PValue.pvalueOf @-> \v -> plift (v # pmint # pconstant "c0" # pconstant "sometoken") @?= 1 + "applied" @| PValue.pvalueOf # pmint # pconstant "c0" # pconstant "sometoken" @-> \p -> + plift p @?= 1 + "growing" + @\ forM_ + (zip [1 :: Int .. length growingSymbols] growingSymbols) + ( \(size, v) -> + fromString (show size) + @| PValue.pvalueOf # getEnclosedTerm v # pconstant "c7" # pconstant "token" + @-> \p -> plift p @?= if size < 9 then 0 else 1 + ) + "unionWith" @\ do + "const" @| PValue.punionWith # plam const # pmint # pmint @-> \p -> + plift (PValue.pforgetSorted $ PValue.pnormalize # p) @?= mint + "(+)" @\ do + "itself" @| PValue.punionWith # plam (+) @-> \plus -> + plift (PValue.pforgetSorted $ PValue.pnormalize #$ plus # pmint # pmint) @?= mint <> mint + "applied" @| PValue.punionWith # plam (+) # pmint # pmint @-> \p -> + plift (PValue.pforgetSorted $ PValue.pnormalize # p) @?= mint <> mint + "tokens" @| PValue.punionWith # plam (+) # pmint # pmintOtherToken @-> \p -> + plift (PValue.pforgetSorted $ PValue.pnormalize # p) @?= mint <> mintOtherToken + "symbols" @| PValue.punionWith # plam (+) # pmint # pmintOtherSymbol @-> \p -> + plift (PValue.pforgetSorted $ PValue.pnormalize # p) @?= mint <> mintOtherSymbol + "growing" + @\ forM_ + (zip [1 :: Int .. length growingSymbols] growingSymbols) + ( \(size, v) -> + fromString (show size) @| PValue.punionWith # plam const # getEnclosedTerm v # pmintOtherSymbol + @-> \v' -> passert (v' #== PValue.punionWith # plam const # pmintOtherSymbol # getEnclosedTerm v) + ) + "unionWithData const" @\ do + "itself" @| PValue.punionWithData @-> \u -> + plift (PValue.pforgetSorted $ PValue.pnormalize #$ u # plam const # pmint # pmint) @?= mint + "applied" @| PValue.punionWithData # plam const # pmint # pmint @-> \p -> + plift (PValue.pforgetSorted $ PValue.pnormalize # p) @?= mint + "inv" + @| inv (PValue.pforgetPositive pmint :: Term _ (PValue 'Sorted 'NonZero)) + @-> \p -> plift (PValue.pforgetSorted p) @?= inv mint + "equality" @\ do + "itself" @| plam ((#==) @(PValue 'Sorted 'Positive)) @-> \eq -> passert (eq # pmint # pmint) + "triviallyTrue" @| pmint #== pmint @-> passert + "triviallyFalse" @| pmint #== pmintOtherToken @-> passertNot + "swappedTokensTrue" + @| pto (PValue.punionWith # plam (+) # pmint # pmintOtherToken) + #== pto (PValue.punionWith # plam (+) # pmintOtherToken # pmint) + @-> passert + "swappedSymbolsTrue" + @| pto (PValue.punionWith # plam (+) # pmint # pmintOtherSymbol) + #== pto (PValue.punionWith # plam (+) # pmintOtherSymbol # pmint) + @-> passert + "growing" + @\ forM_ + (zip [1 :: Int .. length growingSymbols] growingSymbols) + ( \(size, v) -> + fromString (show size) + @| getEnclosedTerm v #== getEnclosedTerm v @-> passert + ) + "normalize" @\ do + "identity" + @| PValue.passertPositive # (PValue.pnormalize # (pmint <> pmintOtherSymbol)) + @-> \v -> passert (v #== pmint <> pmintOtherSymbol) + "empty" + @| PValue.pnormalize # (PValue.punionWith # plam (-) # pmint # pmint) + @-> \v -> passert (v #== mempty) + "assertSorted" @\ do + "succeeds" @| PValue.passertSorted # (pmint <> pmintOtherSymbol) @-> psucceeds + "fails on malsorted symbols" + @| PValue.passertSorted + # ( pcon $ + PValue.PValue $ + pcon $ + AssocMap.PMap $ + pconcat # pto (pto pmintOtherSymbol) # pto (pto pmint) + ) + @-> pfails + "fails on zero quantities" + @| PValue.passertSorted # (PValue.punionWith # plam (-) # pmint # pmint) + @-> pfails + "fails on empty token map" + @| PValue.passertSorted + # (pcon $ PValue.PValue $ AssocMap.psingleton # pconstant "c0" # AssocMap.pempty) + @-> pfails + "Ada" @\ do + "adaSymbol" @| PValue.padaSymbol @-> psucceeds + "adaToken" @| PValue.padaToken @-> psucceeds + "lovelaceValueOf" @| PValue.plovelaceValueOf @-> \p -> passert (p # pada #== 10_000_000) + "isAdaOnlyValue" @\ do + "itself" @| PValue.pisAdaOnlyValue @-> \p -> passert (p # pada) + "true on empty" @| PValue.pisAdaOnlyValue # (mempty :: Term _ (PValue 'Sorted 'Positive)) @-> passert + "trivially false" @| PValue.pisAdaOnlyValue # pmint @-> passertNot + "less trivially false" @| PValue.pisAdaOnlyValue # (pmint <> pada) @-> passertNot + "adaOnlyValue" @\ do + "itself" @| PValue.padaOnlyValue @-> \p -> passert (p # (pada <> pmint) #== pada) + "on empty" + @| PValue.padaOnlyValue # (mempty :: Term _ (PValue 'Sorted 'Positive)) + @-> \p -> passert (p #== mempty) + "on non-Ada" @| PValue.padaOnlyValue # pmint @-> \p -> passert (p #== mempty) + "on Ada" @| PValue.padaOnlyValue # pada @-> \p -> passert (p #== pada) + "noAdaValue" @\ do + "itself" @| PValue.pnoAdaValue @-> \p -> passert (p # (pada <> pmint) #== pmint) + "on empty" + @| PValue.pnoAdaValue # (mempty :: Term _ (PValue 'Sorted 'Positive)) + @-> \p -> passert (p #== mempty) + "on non-Ada" @| PValue.pnoAdaValue # pmint @-> \p -> passert (p #== pmint) + "on Ada" @| PValue.pnoAdaValue # pada @-> \p -> passert (p #== mempty) + describe "map" $ do + pgoldenSpec $ do + let pmap, pdmap, emptyMap, doubleMap, otherMap :: Term _ (AssocMap.PMap 'Sorted PByteString PInteger) + pmap = AssocMap.psingleton # pconstant "key" # 42 + pdmap = AssocMap.psingletonData # pdata (pconstant "key") # pdata 42 + emptyMap = AssocMap.pempty + doubleMap = AssocMap.psingleton # pconstant "key" # 84 + otherMap = AssocMap.psingleton # pconstant "newkey" # 6 + "lookup" @\ do + "itself" @| AssocMap.plookup + @-> \lookup -> passert $ lookup # pconstant "key" # pmap #== pcon (PJust 42) + "hit" @| AssocMap.plookup # pconstant "key" # pmap + @-> \result -> passert $ result #== pcon (PJust 42) + "miss" @| AssocMap.plookup # pconstant "nokey" # pmap + @-> \result -> passert $ result #== pcon PNothing + "lookupData" @\ do + "hit" @| AssocMap.plookupData # pdata (pconstant "key") # pmap + @-> \result -> passert $ result #== pcon (PJust $ pdata 42) + "miss" @| AssocMap.plookupData # pdata (pconstant "nokey") # pmap + @-> \result -> passert $ result #== pcon PNothing + "findWithDefault" @\ do + "itself" @| AssocMap.pfindWithDefault + @-> \find -> (find # 12 # pconstant "key" # pmap) #@?= (42 :: Term _ PInteger) + "hit" @| AssocMap.pfindWithDefault # 12 # pconstant "key" # pmap + @-> \result -> passert $ result #== 42 + "hit2" + @| AssocMap.pfindWithDefault # 12 # pconstant "newkey" # (AssocMap.punionWith # plam const # pmap # otherMap) + @-> \result -> passert $ result #== 6 + "miss" @| AssocMap.pfindWithDefault # 12 # pconstant "nokey" # pmap + @-> \result -> passert $ result #== 12 + "singleton" @| pmap @-> pshouldReallyBe pdmap + "singletonData" @| pdmap @-> pshouldReallyBe pmap + "insert" @\ do + "empty" @| AssocMap.pinsert # pconstant "key" # 42 # emptyMap @-> pshouldReallyBe pmap + "replace" @| AssocMap.pinsert # pconstant "key" # 84 # pmap @-> pshouldReallyBe doubleMap + "delete" @\ do + "empty" @| AssocMap.pdelete # pconstant "key" # emptyMap @-> pshouldReallyBe emptyMap + "only" @| AssocMap.pdelete # pconstant "key" # pmap @-> pshouldReallyBe emptyMap + "miss" @| AssocMap.pdelete # pconstant "nokey" # pmap @-> pshouldReallyBe pmap + "new" + @| AssocMap.pdelete # pconstant "newkey" # (AssocMap.pinsert # pconstant "newkey" # 6 # pmap) + @-> pshouldReallyBe pmap + "old" + @| AssocMap.pdelete # pconstant "key" # (AssocMap.pinsert # pconstant "newkey" # 6 # pmap) + @-> pshouldReallyBe otherMap + "difference" @\ do + "emptyLeft" @| AssocMap.pdifference # emptyMap # pmap @-> pshouldReallyBe emptyMap + "emptyRight" @| AssocMap.pdifference # pmap # emptyMap @-> pshouldReallyBe pmap + "emptyResult" @| AssocMap.pdifference # pmap # doubleMap @-> pshouldReallyBe emptyMap + "unionWith" @\ do + "const" @| AssocMap.punionWith # plam const # pmap # pmap @-> pshouldReallyBe pmap + "double" @| AssocMap.punionWith # plam (+) # pmap # pmap @-> pshouldReallyBe doubleMap + "(+)" + @| AssocMap.punionWith # plam (+) # pmap # otherMap + @-> \p -> passert (p #== AssocMap.punionWith # plam (+) # otherMap # pmap) + "flip (+)" + @| AssocMap.punionWith # plam (+) # otherMap # pmap + @-> \p -> passert (p #== AssocMap.punionWith # plam (+) # pmap # otherMap) + "unionWithData" @\ do + "const" @| AssocMap.punionWithData # plam const # pmap # pmap @-> pshouldReallyBe pmap + "emptyLeft" @| AssocMap.punionWithData # plam const # emptyMap # pmap @-> pshouldReallyBe pmap + "emptyRight" @| AssocMap.punionWithData # plam const # pmap # emptyMap @-> pshouldReallyBe pmap + describe "example" $ do + -- The checkSignatory family of functions implicitly use tracing due to + -- monadic syntax, and as such we need two sets of tests here. + -- See Plutarch.MonadicSpec for GHC9 only syntax. + describe "signatory" . pgoldenSpec $ do + let aSig :: PubKeyHash = "ab01fe235c" + "cont" @\ do + "succeeds" @| checkSignatoryCont # pconstant aSig # ctx @-> psucceeds + "fails" @| checkSignatoryCont # pconstant "41" # ctx @-> pfails + "termcont" @\ do + "succeeds" @| checkSignatoryTermCont # pconstant aSig # ctx @-> psucceeds + "fails" @| checkSignatoryTermCont # pconstant "41" # ctx @-> pfails + describe "getFields" . pgoldenSpec $ do + "0" @| getFields + describe "data recovery" $ do + describe "succeding property tests" $ do + it "recovering PAddress succeeds" $ + property (propPlutarchtypeCanBeRecovered @Address) + it "recovering PTokenName succeeds" $ + property (propPlutarchtypeCanBeRecovered @TokenName) + it "recovering PCredential succeeds" $ + property (propPlutarchtypeCanBeRecovered @Credential) + it "recovering PStakingCredential succeeds" $ + property (propPlutarchtypeCanBeRecovered @StakingCredential) + it "recovering PPubKeyHash succeeds" $ + property (propPlutarchtypeCanBeRecovered @PubKeyHash) + it "recovering PValidatorHash succeeds" $ + property (propPlutarchtypeCanBeRecovered @ValidatorHash) + it "recovering PValue succeeds" $ + property (propPlutarchtypeCanBeRecovered @Value) + it "recovering PCurrencySymbol succeeds" $ + property (propPlutarchtypeCanBeRecovered @CurrencySymbol) + it "recovering PMaybeData succeeds" $ + property prop_pmaybedata_can_be_recovered + +-------------------------------------------------------------------------------- + +{- | + An example 'PScriptContext' Term, + lifted with 'pconstant' +-} +ctx :: Term s PScriptContext +ctx = + pconstant + (ScriptContext info purpose) + +-- | Simple script context, with minting and a single input +info :: TxInfo +info = + TxInfo + { txInfoInputs = [inp] + , txInfoOutputs = [] + , txInfoFee = mempty + , txInfoMint = mint + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = signatories + , txInfoData = [] + , txInfoId = "b0" + } + +-- | A script input +inp :: TxInInfo +inp = + TxInInfo + { txInInfoOutRef = ref + , txInInfoResolved = + TxOut + { txOutAddress = + Address (ScriptCredential validator) Nothing + , txOutValue = mempty + , txOutDatumHash = Just datum + } + } + +-- | Minting a single token +mint :: Value +mint = Value.singleton sym "sometoken" 1 + +mintOtherToken :: Value +mintOtherToken = Value.singleton sym "othertoken" 1 + +mintOtherSymbol :: Value +mintOtherSymbol = Value.singleton "c7" "sometoken" 1 + +ref :: TxOutRef +ref = TxOutRef "a0" 0 + +purpose :: ScriptPurpose +purpose = Spending ref + +validator :: ValidatorHash +validator = "a1" + +datum :: DatumHash +datum = "d0" + +sym :: CurrencySymbol +sym = "c0" + +signatories :: [PubKeyHash] +signatories = ["ab01fe235c", "123014", "abcdef"] + +-------------------------------------------------------------------------------- + +getTxInfo :: Term s (PScriptContext :--> PAsData PTxInfo) +getTxInfo = + plam $ \ctx -> + pfield @"txInfo" # ctx + +getMint :: Term s (PAsData PTxInfo :--> PAsData (PValue 'Sorted 'NoGuarantees)) +getMint = + plam $ \info -> + pfield @"mint" # info + +-- | Get validator from first input in ScriptContext's TxInfo +getCredentials :: Term s PScriptContext -> Term s (PBuiltinList PData) +getCredentials ctx = + let inp = pfield @"inputs" #$ pfield @"txInfo" # ctx + in pmap # inputCredentialHash # inp + +{- | + Get the hash of the Credential in an input, treating + PubKey & ValidatorHash identically. +-} +inputCredentialHash :: Term s (PTxInInfo :--> PData) +inputCredentialHash = + phoistAcyclic $ + plam $ \inp -> + let credential :: Term _ (PAsData PCredential) + credential = + (pfield @"credential") + #$ (pfield @"address") + #$ (pfield @"resolved" # inp) + in phead #$ psndBuiltin #$ pasConstr # pforgetData credential + +-- | Get first CurrencySymbol from Value +getSym :: Term s (PValue 'Sorted 'NonZero :--> PAsData PCurrencySymbol) +getSym = + plam $ \v -> pfstBuiltin #$ phead # pto (pto v) + +-- | `checkSignatory` implemented using `runCont` +checkSignatoryCont :: forall s. Term s (PPubKeyHash :--> PScriptContext :--> PUnit) +checkSignatoryCont = plam $ \ph ctx' -> + pletFields @["txInfo", "purpose"] ctx' $ \ctx -> (`runCont` id) $ do + purpose <- cont (pmatch $ getField @"purpose" ctx) + pure $ case purpose of + PSpending _ -> + let signatories :: Term s (PBuiltinList (PAsData PPubKeyHash)) + signatories = pfield @"signatories" # getField @"txInfo" ctx + in pif + (pelem # pdata ph # signatories) + -- Success! + (pconstant ()) + -- Signature not present. + perror + _ -> + ptraceError "checkSignatoryCont: not a spending tx" + +-- | `checkSignatory` implemented using `runTermCont` +checkSignatoryTermCont :: Term s (PPubKeyHash :--> PScriptContext :--> PUnit) +checkSignatoryTermCont = plam $ \ph ctx' -> unTermCont $ do + ctx <- tcont $ pletFields @["txInfo", "purpose"] ctx' + tcont (pmatch $ getField @"purpose" ctx) >>= \case + PSpending _ -> do + let signatories = pfield @"signatories" # getField @"txInfo" ctx + pure $ + pif + (pelem # pdata ph # pfromData signatories) + -- Success! + (pconstant ()) + -- Signature not present. + perror + _ -> + pure $ ptraceError "checkSignatoryCont: not a spending tx" + +getFields :: Term s (PData :--> PBuiltinList PData) +getFields = phoistAcyclic $ plam $ \addr -> psndBuiltin #$ pasConstr # addr + +dummyCurrency :: CurrencySymbol +dummyCurrency = Value.currencySymbol "\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11\x11" + +------------------- Mocking a ScriptContext ---------------------------------------- + +validContext0 :: Term s PScriptContext +validContext0 = mkCtx validOutputs0 validDatums1 + +invalidContext1 :: Term s PScriptContext +invalidContext1 = mkCtx invalidOutputs1 validDatums1 + +mkCtx :: [TxOut] -> [(DatumHash, Datum)] -> Term s PScriptContext +mkCtx outs l = pconstant (ScriptContext (info' outs l) purpose) + where + info' :: [TxOut] -> [(DatumHash, Datum)] -> TxInfo + info' outs dat = + info + { txInfoData = dat + , txInfoOutputs = outs + } + +validOutputs0 :: [TxOut] +validOutputs0 = + [ TxOut + { txOutAddress = + Address (ScriptCredential validator) Nothing + , txOutValue = mempty + , txOutDatumHash = Just datum + } + ] + +invalidOutputs1 :: [TxOut] +invalidOutputs1 = + [ TxOut + { txOutAddress = + Address (ScriptCredential validator) Nothing + , txOutValue = mempty + , txOutDatumHash = Just datum + } + , TxOut + { txOutAddress = + Address (ScriptCredential validator) Nothing + , txOutValue = mempty + , txOutDatumHash = Nothing + } + ] + +validDatums1 :: [(DatumHash, Datum)] +validDatums1 = + [("d0", d0Dat)] + +-- | Mock datum that is a list of integers. +d0Dat :: Datum +d0Dat = Datum $ toBuiltinData d0DatValue + +d0DatValue :: [Integer] +d0DatValue = [1 .. 10] + +------------------- Property tests ------------------------------------------------- + +propPlutarchtypeCanBeRecovered :: + forall a. + ( Eq a + , Show a + , PConstant a + , PIsData (PConstanted a) + , PTryFrom PData (PAsData (PConstanted a)) + , PLifted (PConstanted a) ~ a + , ToData a + ) => + a -> + Property +propPlutarchtypeCanBeRecovered addr = + addr + === plift + ( unTermCont $ + pfromData . fst <$> tcont (ptryFrom @(PAsData (PConstanted a)) $ pforgetData $ pconstantData addr) + ) + +prop_pmaybedata_can_be_recovered :: Maybe StakingCredential -> Property +prop_pmaybedata_can_be_recovered addr = + addr + === plift + ( unTermCont $ + pfromData . fst + <$> tcont + (ptryFrom @(PAsData (PMaybeData PStakingCredential)) $ pforgetData $ pconstantData addr) + ) + +pshouldReallyBe :: ClosedTerm a -> ClosedTerm a -> Expectation +pshouldReallyBe a b = pshouldBe b a diff --git a/plutarch-test/plutarch-base/Plutarch/BoolSpec.hs b/plutarch-test/plutarch-base/Plutarch/BoolSpec.hs new file mode 100644 index 000000000..244c2949c --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/BoolSpec.hs @@ -0,0 +1,44 @@ +module Plutarch.BoolSpec (spec) where + +import Plutarch.Bool (pand, por) +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "bool" . pgoldenSpec $ do + "pnot" @\ do + "lam" @| pnot + "app" @| pnot # (pcon PTrue) @-> passertNot + "pand" @\ do + "tf" @| pcon PTrue #&& pcon PFalse @-> passertNot + "ft" @| pcon PFalse #&& pcon PTrue @-> passertNot + "tt" @| pcon PTrue #&& pcon PTrue @-> passert + "ff" @| pcon PFalse #&& pcon PFalse @-> passertNot + "laziness" @\ do + "pand" @| pand # pcon PFalse # pdelay perror @-> \p -> + passert $ pnot # pforce p + "op" @| pcon PFalse #&& perror @-> \p -> + passert $ pnot # p + "pand.perror" @\ do + -- FIXME + -- "false" @| pand # pcon PFalse # perror @-> pfails + -- "true" @| pand # pcon PTrue # perror @-> pfails + "op" @| pcon PTrue #&& perror @-> pfails + "por" @\ do + "tf" @| pcon PTrue #|| pcon PFalse @-> passert + "ft" @| pcon PFalse #|| pcon PTrue @-> passert + "tt" @| pcon PTrue #|| pcon PTrue @-> passert + "ff" @| pcon PFalse #|| pcon PFalse @-> passertNot + "laziness" @\ do + "por" @| por # pcon PTrue # pdelay perror @-> \p -> + passert (pforce p) + "op" @| pcon PTrue #|| perror @-> \p -> + passert p + "pand.perror" @\ do + -- FIXME + -- "false" @| por # pcon PFalse # perror @-> pfails + -- "true" @| por # pcon PTrue # perror @-> pfails + "op.true" @| pcon PTrue #|| perror @-> psucceeds + "op.false" @| pcon PFalse #|| perror @-> pfails diff --git a/plutarch-test/plutarch-base/Plutarch/ByteStringSpec.hs b/plutarch-test/plutarch-base/Plutarch/ByteStringSpec.hs new file mode 100644 index 000000000..681ac9ce2 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/ByteStringSpec.hs @@ -0,0 +1,42 @@ +module Plutarch.ByteStringSpec (spec) where + +import qualified Data.ByteString as BS +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "bytestring" . pgoldenSpec $ do + "empty" @| mempty #== phexByteStr "" @-> passert + "phexByteStr" + @| ( let a :: [String] = ["42", "ab", "df", "c9"] + in pconstant @PByteString (BS.pack $ map readByte a) #== phexByteStr (concat a) + ) + @-> passert + "plengthByteStr" @| (plengthBS # phexByteStr "012f") #== 2 @-> passert + "pconsBS" + @| ( let xs = phexByteStr "48fCd1" + in (plengthBS #$ pconsBS # 91 # xs) #== (1 + plengthBS # xs) + ) + @-> passert + "pindexByteStr" @| (pindexBS # phexByteStr "4102af" # 1) + @== pconstant @PInteger 0x02 + "psliceByteStr" @| (psliceBS # 2 # 3 # phexByteStr "4102afde5b2a") + @== phexByteStr "afde5b" + "eq" @| phexByteStr "12" #== phexByteStr "12" @-> passert + let s1 = phexByteStr "12" + s2 = phexByteStr "34" + "semigroup" @\ do + "concats" @| s1 <> s2 @== (phexByteStr "1234") + "laws" @\ do + "id.1" @| (mempty <> s1) #== s1 @-> passert + "id.2" @| s1 #== (mempty <> s1) @-> passert + +{- | Interpret a byte. + +>>> readByte "41" +65 +-} +readByte :: Num a => String -> a +readByte a = fromInteger $ read $ "0x" <> a diff --git a/plutarch-test/plutarch-base/Plutarch/EitherSpec.hs b/plutarch-test/plutarch-base/Plutarch/EitherSpec.hs new file mode 100644 index 000000000..391b30940 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/EitherSpec.hs @@ -0,0 +1,17 @@ +module Plutarch.EitherSpec (spec) where + +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "either" . pgoldenSpec $ do + "eq" @\ do + "true" @\ do + "left" @| pcon @(PEither PInteger PInteger) (PLeft 42) #== pcon (PLeft 42) @-> passert + "right" @| pcon @(PEither PInteger PInteger) (PRight 42) #== pcon (PRight 42) @-> passert + "false" @\ do + "left-right" @| pcon @(PEither PInteger PInteger) (PLeft 42) #== pcon (PRight 42) @-> passertNot + "left-left" @| pcon @(PEither PInteger PInteger) (PLeft 24) #== pcon (PLeft 42) @-> passertNot + "right-right" @| pcon @(PEither PInteger PInteger) (PRight 24) #== pcon (PRight 42) @-> passertNot diff --git a/plutarch-test/src/Plutarch/IntegerSpec.hs b/plutarch-test/plutarch-base/Plutarch/IntegerSpec.hs similarity index 66% rename from plutarch-test/src/Plutarch/IntegerSpec.hs rename to plutarch-test/plutarch-base/Plutarch/IntegerSpec.hs index 801ce9c83..61afe7ce7 100644 --- a/plutarch-test/src/Plutarch/IntegerSpec.hs +++ b/plutarch-test/plutarch-base/Plutarch/IntegerSpec.hs @@ -3,21 +3,24 @@ module Plutarch.IntegerSpec (spec) where import Plutarch import Plutarch.Prelude import Plutarch.Test +import Test.Hspec spec :: Spec spec = do describe "int" $ do describe "examples" $ do - goldens - All - [ ("add1", popaque add1) - , ("add1Hoisted", popaque add1Hoisted) - , ("example1", popaque example1) - , ("example2", popaque example2) - , ("fib", popaque fib) - , ("fib.app.9", popaque $ fib # 9) - , ("uglyDouble", popaque uglyDouble) - ] + pgoldenSpec $ do + "add1" @| add1 + "add1Hoisted" @| add1Hoisted + "example1" @| example1 + "example2" @| example2 + "fib" @\ do + "lam" @| fib + "app" @\ do + "9" @| fib # 9 @:-> \(p, _script, bench) -> do + p `pshouldBe` (34 :: Term _ PInteger) + bench `psatisfyWithinBenchmark` Benchmark 1_000_000_000 1_000_000 100 + "uglyDouble" @| uglyDouble add1 :: Term s (PInteger :--> PInteger :--> PInteger) add1 = plam $ \x y -> x + y + 1 diff --git a/plutarch-test/plutarch-base/Plutarch/LiftSpec.hs b/plutarch-test/plutarch-base/Plutarch/LiftSpec.hs new file mode 100644 index 000000000..d5f4fc80a --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/LiftSpec.hs @@ -0,0 +1,51 @@ +module Plutarch.LiftSpec (spec) where + +import Data.Text (Text) +import Plutarch.Api.V1 () +import PlutusLedgerApi.V1 (PubKeyHash (PubKeyHash), ScriptPurpose (Minting), TxOutRef (TxOutRef)) +import qualified PlutusTx + +import Plutarch.Lift (PLifted) +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec (Expectation, Spec, describe, it, shouldBe) + +spec :: Spec +spec = do + describe "lift" $ do + describe "plift" $ do + it "bool" $ do + plift (pcon PTrue) `shouldBe` True + plift (pcon PFalse) `shouldBe` False + plift (pconstant False) `shouldBe` False + plift (pconstant True) `shouldBe` True + it "list" $ do + plift (pconstant ([1, 2, 3] :: [Integer])) `shouldBe` [1, 2, 3] + plift (pconstant ("IOHK" :: Text, 42 :: Integer)) `shouldBe` ("IOHK", 42) + it "nested" $ do + -- List of pairs + let v1 = [("IOHK", 42), ("Plutus", 31)] :: [(Text, Integer)] + plift (pconstant v1) `shouldBe` v1 + -- List of pair of lists + let v2 = [("IOHK", [1, 2, 3]), ("Plutus", [9, 8, 7])] :: [(Text, [Integer])] + plift (pconstant v2) `shouldBe` v2 + it "data" $ do + let d :: PlutusTx.Data + d = PlutusTx.toData @(Either Bool Bool) $ Right False + plift (pconstant d) `shouldBe` d + describe "pconstant" $ do + it "string" $ do + pconstant @PString "abc" `pshouldBe` pconstant @PString "abc" + pconstant @PString "foo" `pshouldBe` ("foo" :: Term _ PString) + describe "pconstantData" $ do + pgoldenSpec $ do + "bool" @| pconstantData False + "int" @| pconstantData (42 :: Integer) + "pkh" @| pconstantData (PubKeyHash "04") + "minting" @| pconstantData (Minting "") + "txoutref" @| pconstantData (TxOutRef "41" 12) + it "works" $ testPConstantDataSan False + +testPConstantDataSan :: forall p. (PIsData p, PLift p, PlutusTx.ToData (PLifted p)) => PLifted p -> Expectation +testPConstantDataSan x = + pconstantData @p x `pshouldBe` pdata (pconstant @p x) diff --git a/plutarch-test/plutarch-base/Plutarch/ListSpec.hs b/plutarch-test/plutarch-base/Plutarch/ListSpec.hs new file mode 100644 index 000000000..0556d2aac --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/ListSpec.hs @@ -0,0 +1,125 @@ +module Plutarch.ListSpec (spec, integerList) where + +import Data.List (find) + +import Plutarch.List (pconvertLists, pfoldl') +import Plutarch.Prelude + +import Hedgehog (Property) +import qualified Hedgehog.Gen as Gen +import Hedgehog.Internal.Property (Property (propertyTest)) +import qualified Hedgehog.Range as Range +import Plutarch.Test +import Plutarch.Test.Property +import Plutarch.Test.Property.Gen (genInteger, genList) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.Hedgehog (hedgehog) + +integerList :: [Integer] -> Term s (PList PInteger) +integerList xs = pconvertLists #$ pconstant @(PBuiltinList PInteger) xs + +spec :: Spec +spec = do + describe "list" $ do + describe "properties" $ do + describe "find" $ do + it "plutarch level find mirrors haskell level find" . hedgehog . propertyTest $ prop_pfindEquiv + describe "elemAt" $ do + it "plutarch level elemAt mirrors haskell level elemAt" . hedgehog . propertyTest $ prop_pelemAtEquiv + pgoldenSpec $ do + let xs10 :: Term _ (PList PInteger) + xs10 = integerList [1 .. 10] + numList :: Term _ (PBuiltinList PInteger) + numList = pconstant [1 .. 5] + "pmatch" @| pmatch (integerList [1, 3, 1]) (const perror) @-> pfails + "phead" @| 1 #== (phead # xs10) @-> passert + "ptail" @| integerList [2 .. 10] #== ptail # xs10 @-> passert + "pnull" @\ do + "empty" @| (pnull # integerList []) @-> passert + "nonempty" @| (pnot #$ pnull # xs10) @-> passert + "pconcat" @\ do + "identity" @| (pconcat # xs10 # pnil #== pconcat # pnil # xs10) #&& (pconcat # pnil # xs10 #== xs10) @-> passert + "pmap" @\ do + "eg" @| pmap # (plam $ \x -> x + x) # xs10 #== (integerList $ fmap (* 2) [1 .. 10]) @-> passert + "identity" @| pmap @PList # (plam $ \(x :: Term _ PInteger) -> x) # pnil #== pnil @-> passert + "pfilter" @\ do + "evens" @| pfilter # (plam $ \x -> pmod # x # 2 #== 0) # xs10 #== integerList [2, 4, 6, 8, 10] @-> passert + "gt5" @| pfilter # (plam $ \x -> 5 #< x) # xs10 #== integerList [6 .. 10] @-> passert + "pzipWith" @\ do + "double" @| pzipWith' (+) # xs10 # xs10 #== integerList (fmap (* 2) [1 .. 10]) @-> passert + "pfoldl" @\ do + "nonempty" @| pfoldl # plam (-) # 0 # xs10 #== pconstant (foldl (-) 0 [1 .. 10]) @-> passert + "nonempty-primed" @| pfoldl' (-) # 0 # xs10 #== pconstant (foldl (-) 0 [1 .. 10]) @-> passert + "empty" @| pfoldl # plam (-) # 0 # integerList [] #== pconstant 0 @-> passert + "empty-primed" @| pfoldl' (-) # 0 # integerList [] #== pconstant 0 @-> passert + "elemAt" @\ do + "elemAt_3_[1..10]" @| pelemAt # 3 # integerList [1 .. 10] + "elemAt_0_[1..10]" @| pelemAt # 0 # integerList [1 .. 10] + "elemAt_9_[1..10]" @| pelemAt # 9 # integerList [1 .. 10] + "find" @\ do + "find_(==3)_[1..4]" @| pfind # plam (#== 3) #$ integerList [1 .. 4] + "find_(==5)_[1..4]" @| pfind # plam (#== 5) #$ integerList [1 .. 4] + -- Two ways of matching on a list + "x1+x2" @\ do + -- Via HeadList and TailList only. + "builtin" @| (phead #$ ptail # numList) + (phead # numList) + -- Via ChooseList (twice invoked) + "pmatch" + @| pmatch numList + $ \case + PNil -> perror + PCons x xs -> + pmatch xs $ \case + PNil -> perror + PCons y _ -> + x + y + -- Various ways of uncons'ing a list + "uncons" @\ do + -- ChooseList builtin, like uncons but fails on null lists + "ChooseList" + @| pmatch numList + $ \case + PNil -> perror + PCons _x xs -> + xs + -- Retrieving head and tail of a list + "head-and-tail" + @| plet (phead # numList) + $ \_x -> + ptail # numList + -- Retrieve head and tail using builtins, but fail on null lists. + "head-and-tail-and-null" + @| plet (pnull # numList) + $ \isEmpty -> + pmatch isEmpty $ \case + PTrue -> perror + PFalse -> plet (phead # numList) $ \_x -> + ptail # numList + +-- plutarch level find mirrors haskell level find +prop_pfindEquiv :: Property +prop_pfindEquiv = + prop_haskEquiv + @( 'OnPEq) + @( 'TotalFun) + (find @[] @Integer even) + (pfind # peven) + (genList genInteger :* Nil) + where + peven :: Term s (PInteger :--> PBool) + peven = plam $ \n -> pmod # n # 2 #== 0 + +-- plutarch level elemAt mirrors haskell level elemAt +prop_pelemAtEquiv :: Property +prop_pelemAtEquiv = + prop_haskEquiv + @( 'OnBoth) + @( 'PartialFun) + elemAt + pelemAt + $ Gen.integral (Range.linear (-10) 100) + :* Gen.list (Range.linear 0 100) genInteger + :* Nil + +elemAt :: Integer -> [Integer] -> Integer +elemAt n xs = xs !! fromInteger n diff --git a/plutarch-test/plutarch-base/Plutarch/MaybeSpec.hs b/plutarch-test/plutarch-base/Plutarch/MaybeSpec.hs new file mode 100644 index 000000000..f5322526c --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/MaybeSpec.hs @@ -0,0 +1,22 @@ +module Plutarch.MaybeSpec (spec) where + +import Plutarch +import Plutarch.Bool (PEq ((#==))) +import Plutarch.Integer (PInteger) +import Plutarch.Maybe (PMaybe (PJust, PNothing), pfromJust) +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "maybe" . pgoldenSpec $ do + "eq" @\ do + "true" @\ do + "nothing" @| pcon @(PMaybe PInteger) PNothing #== pcon PNothing @-> passert + "just" @| pcon @(PMaybe PInteger) (PJust 42) #== pcon (PJust 42) @-> passert + "false" @\ do + "nothing-just" @| pcon @(PMaybe PInteger) PNothing #== pcon (PJust 42) @-> passertNot + "just-just" @| pcon @(PMaybe PInteger) (PJust 24) #== pcon (PJust 42) @-> passertNot + "pfromJust" @\ do + "nothing" @| pfromJust # pcon PNothing @-> pfails + "just" @| pfromJust # pcon (PJust 42) #== (42 :: Term _ PInteger) @-> passert diff --git a/plutarch-test/plutarch-base/Plutarch/PIsDataSpec.hs b/plutarch-test/plutarch-base/Plutarch/PIsDataSpec.hs new file mode 100644 index 000000000..3b08a35aa --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/PIsDataSpec.hs @@ -0,0 +1,237 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.PIsDataSpec (spec) where + +import Data.Text.Encoding (encodeUtf8) + +import Data.Functor.Compose (Compose (Compose)) +import Data.String (fromString) +import PlutusLedgerApi.V1 ( + Address (Address), + Credential (PubKeyCredential, ScriptCredential), + CurrencySymbol, + ScriptPurpose (Minting, Rewarding, Spending), + StakingCredential (StakingHash), + TxOutRef (TxOutRef), + ) + +import Generics.SOP (NS (S, Z)) +import qualified PlutusTx + +import Test.Tasty.QuickCheck (Arbitrary, property) + +import Plutarch.Api.V1 +import Plutarch.Api.V1.Tuple (pbuiltinPairFromTuple, ptupleFromBuiltin) +import Plutarch.Builtin (pforgetData, ppairDataBuiltin) +import Plutarch.DataRepr (PDataSum (PDataSum)) +import Plutarch.Lift (PLifted) +import Plutarch.Prelude +import Plutarch.SpecTypes (PTriplet (PTriplet)) +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "pisdata" $ do + propertySet @PBool "PBool" + propertySet @PInteger "PInteger" + propertySet @PUnit "PUnit" + describe "equality" . pgoldenSpec $ do + "PData" @\ do + "1" + @| (let dat = pconstant @PData (PlutusTx.List [PlutusTx.Constr 1 [PlutusTx.I 0]]) in dat #== dat) + @-> passert + "2" + @| (pnot #$ pconstant @PData (PlutusTx.Constr 0 []) #== pconstant @PData (PlutusTx.I 42)) + @-> passert + "PAsData" @\ do + "1" + @| let dat = pdata @PInteger 42 + in dat #== dat + @-> passert + "1" + @| (pnot #$ pdata (phexByteStr "12") #== pdata (phexByteStr "ab")) + @-> passert + describe "ppair" . pgoldenSpec $ do + -- pfromData (pdata (I 1, B 0x41)) ≡ (I 1, I A) + "simple" + @| ( ppairDataBuiltin @_ @PInteger @PByteString + # pconstantData @PInteger 1 + #$ pdata (pconstant $ encodeUtf8 "A") + ) + @-> \p -> + pfromData (pdata p) `pshouldBe` p + -- pfromdata (pdata (ptxid 0x41, pscriptcredential 0x82)) ≡ (ptxid 0x41, pscriptcredential 0x82) + let scPair = + ppairDataBuiltin + # pconstantData @PTxId "41" + #$ pconstantData (ScriptCredential "82") + "scriptcredential" @| scPair @-> \p -> + pfromData (pdata p) `pshouldBe` p + let scTuple = pdata $ ptuple # pconstantData @PTxId "41" #$ pconstantData $ ScriptCredential "82" + "isomorphism" @\ do + "pforgetData" @| pforgetData (pdata scPair) @== pforgetData scTuple + "pbuiltinPairFromTuple" @| pfromData (pbuiltinPairFromTuple scTuple) @== scPair + "ptupleFromBuiltin" @| ptupleFromBuiltin (pdata scPair) @== scTuple + -- Data construction tests + describe "constr" . pgoldenSpec $ do + -- Sum of products construction + "sop" @\ do + "4wheeler" @\ do + let datrec = + pdcons + # pconstantData @PInteger 2 #$ pdcons + # pconstantData @PInteger 5 #$ pdcons + # pconstantData @PInteger 42 #$ pdcons + # pconstantData @PInteger 0 + # pdnil + expected = + pconstant $ + PlutusTx.Constr 0 [PlutusTx.I 2, PlutusTx.I 5, PlutusTx.I 42, PlutusTx.I 0] + "normal" + @| pcon (PFourWheeler datrec) @== expected + "pdatasum" + @| pcon @(PInner PVehicle) (PDataSum . Z $ Compose datrec) @== expected + "2wheeler" @\ do + let datrec = pdcons # pconstantData @PInteger 5 #$ pdcons # pconstantData @PInteger 0 # pdnil + expected = pconstant $ PlutusTx.Constr 1 [PlutusTx.I 5, PlutusTx.I 0] + "normal" + @| pcon (PTwoWheeler datrec) @== expected + "pdatasum" + @| pcon @(PInner PVehicle) (PDataSum . S . Z $ Compose datrec) @== expected + "immovable" @\ do + let datrec = pdnil + expected = pconstant $ PlutusTx.Constr 2 [] + "normal" + @| pcon (PImmovableBox datrec) @== expected + "pdatasum" + @| pcon @(PInner PVehicle) (PDataSum . S . S . Z $ Compose datrec) @== expected + -- Product construction + "prod" @\ do + "1" @\ do + let datrec = + pdcons + # pconstantData @PCurrencySymbol "ab" #$ pdcons + # pconstantData @PCurrencySymbol "41" #$ pdcons + # pconstantData @PCurrencySymbol "0e" + # pdnil + expected = + pconstant $ + PlutusTx.Constr + 0 + [ PlutusTx.toData @CurrencySymbol "ab" + , PlutusTx.toData @CurrencySymbol "41" + , PlutusTx.toData @CurrencySymbol "0e" + ] + "normal" + @| pcon (PTriplet datrec) @== expected + "pdatasum" + @| pcon @(PInner (PTriplet PCurrencySymbol)) (PDataSum . Z $ Compose datrec) + @== expected + "2" @\ do + let minting = Minting "" + spending = Spending $ TxOutRef "ab" 0 + rewarding = Rewarding . StakingHash $ PubKeyCredential "da" + + datrec = + pdcons + # pconstantData minting #$ pdcons + # pconstantData spending #$ pdcons + # pconstantData rewarding + # pdnil + expected = + pconstant $ + PlutusTx.Constr + 0 + [PlutusTx.toData minting, PlutusTx.toData spending, PlutusTx.toData rewarding] + "normal" + @| pcon (PTriplet datrec) @== expected + "datasum" + @| pcon @(PInner (PTriplet PScriptPurpose)) (PDataSum . Z $ Compose datrec) + @== expected + -- Enumerable sum type construction + "enum" @\ do + "PA" @| pcon (PA pdnil) @== pconstant (PlutusTx.Constr 0 []) + "PB" @| pcon (PB pdnil) @== pconstant (PlutusTx.Constr 1 []) + -- Relation between pconstant and pcon + "pconstant-pcon-rel" + @| ( let valHash = "01" + addr = Address (ScriptCredential $ fromString valHash) Nothing + pscriptCredential :: Term s PCredential + pscriptCredential = + pcon $ + PScriptCredential $ + pdcons # pdata (pcon $ PValidatorHash $ phexByteStr valHash) # pdnil + in pconstant addr + @== pcon (PAddress $ pdcons # pdata pscriptCredential #$ pdcons # pdata (pcon $ PDNothing pdnil) # pdnil) + ) + +propertySet :: + forall p. + ( PIsData p + , PLift p + , PlutusTx.ToData (PLifted p) + , PlutusTx.FromData (PLifted p) + , Eq (PLifted p) + , Show (PLifted p) + , Arbitrary (PLifted p) + ) => + String -> + Spec +propertySet typeName = do + describe typeName $ do + specify ("x ~ " <> typeName <> ": pfromData (pdata x) ≡ x") $ + property $ ptoFromEqual @p + specify ("x ~ " <> typeName <> ": pfromData (PlutusTx.toData x) ≡ x") $ + property $ pfromDataCompat @p + specify ("x ~ " <> typeName <> ": PlutusTx.fromData (pdata x) ≡ Just x") $ + property $ pdataCompat @p + +ptoFromEqual :: + forall p. + ( PIsData p + , PLift p + ) => + PLifted p -> + _ +ptoFromEqual t = pfromData (pdata $ pconstant @p t) `pshouldBe` pconstant @p t + +pfromDataCompat :: + forall p. + ( PIsData p + , PlutusTx.ToData (PLifted p) + , PLift p + , Eq (PLifted p) + , Show (PLifted p) + ) => + PLifted p -> + IO () +pfromDataCompat x = plift (pfromData $ pconstantData @p x) `shouldBe` x + +pdataCompat :: + forall p. + ( PLift p + , PIsData p + , PlutusTx.FromData (PLifted p) + , Eq (PLifted p) + , Show (PLifted p) + ) => + PLifted p -> + IO () +pdataCompat x = PlutusTx.fromData @(PLifted p) (plift $ pforgetData $ pdata $ pconstant @p x) `shouldBe` Just x + +data PVehicle (s :: S) + = PFourWheeler (Term s (PDataRecord '["_0" ':= PInteger, "_1" ':= PInteger, "_2" ':= PInteger, "_3" ':= PInteger])) + | PTwoWheeler (Term s (PDataRecord '["_0" ':= PInteger, "_1" ':= PInteger])) + | PImmovableBox (Term s (PDataRecord '[])) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData) +instance DerivePlutusType PVehicle where type DPTStrat _ = PlutusTypeData + +data PEnumType (s :: S) + = PA (Term s (PDataRecord '[])) + | PB (Term s (PDataRecord '[])) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData) +instance DerivePlutusType PEnumType where type DPTStrat _ = PlutusTypeData diff --git a/plutarch-test/plutarch-base/Plutarch/PLamSpec.hs b/plutarch-test/plutarch-base/Plutarch/PLamSpec.hs new file mode 100644 index 000000000..e11c44655 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/PLamSpec.hs @@ -0,0 +1,71 @@ +module Plutarch.PLamSpec (spec) where + +import Data.ByteString (ByteString) +import qualified PlutusCore as PLC + +import Plutarch.Prelude +import Plutarch.Test +import Plutarch.Unsafe (punsafeBuiltin) +import Test.Hspec + +spec :: Spec +spec = do + describe "plam" . pgoldenSpec $ do + "id" @| plam (\x -> x) + "flip.const" @| plam (\_ y -> y) + "plet" @| plam (\x _ -> plet x $ \_ -> perror) + "primitives" @\ do + "bool" @\ do + "true" @| plam $ \_ -> pconstant True + "int" @\ do + "0" @| plam $ \_ -> (0 :: Term _ PInteger) + "1" @| plam $ \_ -> (1 :: Term _ PInteger) + "512" @| plam $ \_ -> (512 :: Term _ PInteger) + "1048576" @| plam $ \_ -> (1048576 :: Term _ PInteger) + "bytestring" @\ do + "1" @| plam $ \_ -> pconstant ("1" :: ByteString) + "1111111" @| plam $ \_ -> pconstant ("1111111" :: ByteString) + "unit" @\ do + "list" @| plam $ \_ -> pconstant ([()] :: [()]) + "()" @| plam $ \_ -> pconstant () + "id" @| plam $ \x -> x + "fun" @\ do + "lam+" @| plam $ \_ -> (plam (+) :: Term _ (PInteger :--> PInteger :--> PInteger)) + "+" @| (plam (+) :: Term _ (PInteger :--> PInteger :--> PInteger)) + "η-reduction-optimisations" @\ do + "λx y. addInteger x y => addInteger" + @| plam + $ \x y -> (x :: Term _ PInteger) + y + "λx y. hoist (force mkCons) x y => force mkCons" + @| plam + $ \x y -> (pforce $ punsafeBuiltin PLC.MkCons) # x # y + "λx y. hoist mkCons x y => mkCons x y" + @| plam + $ \x y -> (punsafeBuiltin PLC.MkCons) # x # y + "λx y. hoist (λx y. x + y - y - x) x y => λx y. x + y - y - x" + @| plam + $ \x y -> (phoistAcyclic $ plam $ \(x :: Term _ PInteger) y -> x + y - y - x) # x # y + "λx y. x + x" + @| plam + $ \(x :: Term _ PInteger) (_ :: Term _ PInteger) -> x + x + "let x = addInteger in x 1 1" + @| plet (punsafeBuiltin PLC.AddInteger) + $ \x -> x # (1 :: Term _ PInteger) # (1 :: Term _ PInteger) + "let x = 0 in x => 0" + @| plet 0 + $ \(x :: Term _ PInteger) -> x + "let x = hoist (λx. x + x) in 0 => 0" + @| plet (phoistAcyclic $ plam $ \(x :: Term _ PInteger) -> x + x) + $ \_ -> (0 :: Term _ PInteger) + "let x = hoist (λx. x + x) in x" + @| plet (phoistAcyclic $ plam $ \(x :: Term _ PInteger) -> x + x) + $ \x -> x + "λx y. sha2_256 x y =>!" + @| (plam $ \x y -> punsafeBuiltin PLC.Sha2_256 # x # y) + "let f = hoist (λx. x) in λx y. f x y => λx y. x y" + @| (plam $ \x y -> (phoistAcyclic $ plam $ \x -> x) # x # y) + "let f = hoist (λx. x True) in λx y. f x y => λx y. (λz. z True) x y" + @| (plam $ \x y -> ((phoistAcyclic $ plam $ \x -> x # pcon PTrue)) # x # y) + "λy. (λx. x + x) y" + @| plam + $ \y -> (plam $ \(x :: Term _ PInteger) -> x + x) # y diff --git a/plutarch-test/plutarch-base/Plutarch/POrdSpec.hs b/plutarch-test/plutarch-base/Plutarch/POrdSpec.hs new file mode 100644 index 000000000..7414b6e28 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/POrdSpec.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.POrdSpec (spec) where + +import Data.ByteString (ByteString) + +import PlutusLedgerApi.V1 ( + Address (Address), + Credential (PubKeyCredential, ScriptCredential), + PubKeyHash (PubKeyHash), + StakingCredential (StakingHash, StakingPtr), + ValidatorHash (ValidatorHash), + ) +import qualified PlutusTx +import qualified PlutusTx.Builtins as PlutusTx + +import Test.QuickCheck.Instances () + +import Test.Tasty.QuickCheck (Arbitrary, arbitrary, oneof, property) + +import Plutarch.Api.V1 (PAddress, PCredential (PPubKeyCredential, PScriptCredential), PMaybeData) +import Plutarch.Lift ( + DerivePConstantViaNewtype (DerivePConstantViaNewtype), + PConstantDecl, + PUnsafeLiftDecl (PLifted), + ) +import Plutarch.Prelude + +import Plutarch.SpecTypes (PTriplet (PTriplet), Triplet (Triplet)) +import Plutarch.Test +import Test.Hspec (Spec, describe, shouldBe, specify) + +spec :: Spec +spec = do + describe "pisdata" $ do + describe "ord.property" $ do + propertySet @PBool "PBool" + propertySet @(PMaybeData PInteger) "PMaybeData PInteger" + propertySet @(PTriplet PInteger) "PMaybeData PInteger" + propertySet @PAddress' "PAddress" + describe "lt" . pgoldenSpec $ do + "PCredential" @\ do + let c1 = PubKeyCredential "" + c2 = ScriptCredential "41" + "derived" @\ ltWith (#<) c1 c2 + "pmatch" @\ ltWith ltCred c1 c2 + "pmatch-pdatarecord" @\ ltWith ltCred' c1 c2 + "PTriplet" @\ do + let c1 = Triplet @Integer 1 2 3 + c2 = Triplet 1 3 5 + "derived" @\ ltWith (#<) c1 c2 + "pmatch" @\ ltWith ltTrip c1 c2 + "pmatch-pdatarecord" @\ ltWith ltTrip' c1 c2 + describe "lte" . pgoldenSpec $ do + "PCredential" @\ do + let c1 = PubKeyCredential "" + c2 = ScriptCredential "41" + "derived" @\ lteWith (#<=) c1 c2 + "pmatch" @\ lteWith lteCred c1 c2 + "pmatch-pdatarecord" @\ lteWith lteCred' c1 c2 + "PTriplet" @\ do + let c1 = Triplet @Integer 1 2 3 + c2 = Triplet 1 3 5 + "derived" @\ lteWith (#<=) c1 c2 + "pmatch" @\ lteWith lteTrip c1 c2 + "pmatch-pdatarecord" @\ lteWith lteTrip' c1 c2 + where + ltWith :: + PLift p => + (forall s. Term s p -> Term s p -> Term s PBool) -> + PLifted p -> + PLifted p -> + PlutarchGoldens + ltWith f x y = do + "true" + @| (pconstant x `f` pconstant y) + @-> passert + "false" + @| (pconstant y `f` pconstant x) + @-> passertNot + lteWith :: + PLift p => + (forall s. Term s p -> Term s p -> Term s PBool) -> + PLifted p -> + PLifted p -> + PlutarchGoldens + lteWith f x y = do + "true" + @\ do + "eq" + @| (pconstant x `f` pconstant x) + @-> passert + "less" + @| (pconstant x `f` pconstant y) + @-> passert + "false" + @| (pconstant y `f` pconstant x) + @-> passertNot + +propertySet :: + forall p. + ( PIsData p + , PLiftData p + , POrd p + , Ord (PLifted p) + , Show (PLifted p) + , Arbitrary (PLifted p) + ) => + String -> + Spec +propertySet typeName' = do + describe typeName' $ do + let typeName = '(' : typeName' ++ ")" + specify ("(#<) @" <> typeName <> " ≡ (<) @" <> typeName) $ + property $ pltIso @p + specify ("(#<=) @" <> typeName <> " ≡ (<=) @" <> typeName) $ + property $ plteIso @p + specify ("(#==) @" <> typeName <> " ≡ (==) @" <> typeName) $ + property $ peqIso @p + +pltIso :: forall p. (PLift p, POrd p, Arbitrary (PLifted p), Ord (PLifted p)) => PLifted p -> PLifted p -> IO () +pltIso a b = plift (pconstant @p a #< pconstant b) `shouldBe` (a < b) + +plteIso :: forall p. (PLift p, POrd p, Arbitrary (PLifted p), Ord (PLifted p)) => PLifted p -> PLifted p -> IO () +plteIso a b = plift (pconstant @p a #<= pconstant b) `shouldBe` (a <= b) + +peqIso :: forall p. (PLift p, PEq p, Arbitrary (PLifted p), Eq (PLifted p)) => PLifted p -> PLifted p -> IO () +peqIso a b = plift (pconstant @p a #== pconstant b) `shouldBe` (a == b) + +newtype PAddress' s = PAddress' (Term s PAddress) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd) +instance DerivePlutusType PAddress' where type DPTStrat _ = PlutusTypeNewtype + +instance PUnsafeLiftDecl PAddress' where type PLifted PAddress' = Address' + +newtype Address' = Address' Address + deriving stock (Show, Eq, Ord) + deriving newtype (PlutusTx.FromData, PlutusTx.ToData) + deriving (PConstantDecl) via (DerivePConstantViaNewtype Address' PAddress' PAddress) + +instance Arbitrary Address' where + arbitrary = Address' <$> arbitraryAddr + where + arbitraryAddr = Address <$> arbitraryCred <*> arbitraryMaybeStakingCred + arbitraryCred = + oneof + [ PubKeyCredential . PubKeyHash . PlutusTx.toBuiltin @ByteString <$> arbitrary + , ScriptCredential . ValidatorHash . PlutusTx.toBuiltin @ByteString <$> arbitrary + ] + arbitraryStakingCred = + oneof + [ StakingHash <$> arbitraryCred + , StakingPtr <$> arbitrary <*> arbitrary <*> arbitrary + ] + arbitraryMaybeStakingCred = oneof [pure Nothing, Just <$> arbitraryStakingCred] + +-- A bunch of boilerplate purely for a bit more informative benchmarks. + +-- manual 'pmatch' + manual field extraction impl. +_pmatchHelperCred :: + (Term s PByteString -> Term s PByteString -> Term s PBool) -> + Term s PCredential -> + Term s PCredential -> + Term s PBool +_pmatchHelperCred f cred1 cred2 = unTermCont $ do + x <- tcont $ pmatch cred1 + y <- tcont $ pmatch cred2 + pure $ case (x, y) of + (PPubKeyCredential a, PPubKeyCredential b) -> + pto (pfromData $ pfield @"_0" # a) `f` pto (pfromData $ pfield @"_0" # b) + (PPubKeyCredential _, PScriptCredential _) -> pconstant True + (PScriptCredential _, PPubKeyCredential _) -> pconstant False + (PScriptCredential a, PScriptCredential b) -> + pto (pfromData $ pfield @"_0" # a) `f` pto (pfromData $ pfield @"_0" # b) + +ltCred :: Term s PCredential -> Term s PCredential -> Term s PBool +ltCred = _pmatchHelperCred (#<) + +lteCred :: Term s PCredential -> Term s PCredential -> Term s PBool +lteCred = _pmatchHelperCred (#<=) + +-- manual 'pmatch' + 'PDataRecord' Ord impl. +_pmatchDataRecHelperCred :: + (forall l. POrd (PDataRecord l) => Term s (PDataRecord l) -> Term s (PDataRecord l) -> Term s PBool) -> + Term s PCredential -> + Term s PCredential -> + Term s PBool +_pmatchDataRecHelperCred f cred1 cred2 = unTermCont $ do + x <- tcont $ pmatch cred1 + y <- tcont $ pmatch cred2 + pure $ case (x, y) of + (PPubKeyCredential a, PPubKeyCredential b) -> a `f` b + (PPubKeyCredential _, PScriptCredential _) -> pconstant True + (PScriptCredential _, PPubKeyCredential _) -> pconstant False + (PScriptCredential a, PScriptCredential b) -> a `f` b + +ltCred' :: Term s PCredential -> Term s PCredential -> Term s PBool +ltCred' = _pmatchDataRecHelperCred (#<) + +lteCred' :: Term s PCredential -> Term s PCredential -> Term s PBool +lteCred' = _pmatchDataRecHelperCred (#<=) + +-- manual 'pmatch' + manual field extraction impl. +ltTrip :: Term s (PTriplet PInteger) -> Term s (PTriplet PInteger) -> Term s PBool +ltTrip trip1 trip2 = unTermCont $ do + a <- tcont $ pletFields @'["x", "y", "z"] trip1 + b <- tcont $ pletFields @'["x", "y", "z"] trip2 + + x <- tcont . plet . pfromData $ getField @"x" a + x' <- tcont . plet . pfromData $ getField @"x" b + pure $ + x #< x' + #|| ( x #== x' + #&& unTermCont + ( do + y <- tcont . plet . pfromData $ getField @"y" a + y' <- tcont . plet . pfromData $ getField @"y" b + pure $ y #< y' #|| (y #== y' #&& pfromData (getField @"z" a) #< pfromData (getField @"z" b)) + ) + ) + +lteTrip :: Term s (PTriplet PInteger) -> Term s (PTriplet PInteger) -> Term s PBool +lteTrip trip1 trip2 = unTermCont $ do + a <- tcont $ pletFields @'["x", "y", "z"] trip1 + b <- tcont $ pletFields @'["x", "y", "z"] trip2 + + x <- tcont . plet . pfromData $ getField @"x" a + x' <- tcont . plet . pfromData $ getField @"x" b + pure $ + x #< x' + #|| ( x #== x' + #&& unTermCont + ( do + y <- tcont . plet . pfromData $ getField @"y" a + y' <- tcont . plet . pfromData $ getField @"y" b + pure $ y #< y' #|| (y #== y' #&& pfromData (getField @"z" a) #<= pfromData (getField @"z" b)) + ) + ) + +-- manual 'pmatch' + 'PDataRecord' Ord impl. +_pmatchDataRecHelperTrip :: + (forall l. POrd (PDataRecord l) => Term s (PDataRecord l) -> Term s (PDataRecord l) -> Term s PBool) -> + Term s (PTriplet PInteger) -> + Term s (PTriplet PInteger) -> + Term s PBool +_pmatchDataRecHelperTrip f trip1 trip2 = unTermCont $ do + PTriplet a <- tcont $ pmatch trip1 + PTriplet b <- tcont $ pmatch trip2 + pure $ a `f` b + +ltTrip' :: Term s (PTriplet PInteger) -> Term s (PTriplet PInteger) -> Term s PBool +ltTrip' = _pmatchDataRecHelperTrip (#<) + +lteTrip' :: Term s (PTriplet PInteger) -> Term s (PTriplet PInteger) -> Term s PBool +lteTrip' = _pmatchDataRecHelperTrip (#<=) diff --git a/plutarch-test/plutarch-base/Plutarch/PairSpec.hs b/plutarch-test/plutarch-base/Plutarch/PairSpec.hs new file mode 100644 index 000000000..45f1e6c0e --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/PairSpec.hs @@ -0,0 +1,27 @@ +module Plutarch.PairSpec (spec) where + +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "pair" . pgoldenSpec $ do + "eq" @\ do + "true" + @| pcon @(PPair PInteger PString) (PPair 42 "Hello") + #== pcon (PPair 42 "Hello") + @-> passert + "false" @\ do + "fst" + @| pcon @(PPair PInteger PString) (PPair 42 "Hello") + #== pcon (PPair 24 "Hello") + @-> passertNot + "snd" + @| pcon @(PPair PInteger PString) (PPair 42 "Hello") + #== pcon (PPair 42 "World") + @-> passertNot + "both" + @| pcon @(PPair PInteger PString) (PPair 42 "Hello") + #== pcon (PPair 24 "World") + @-> passertNot diff --git a/plutarch-test/plutarch-base/Plutarch/PlutusTypeSpec.hs b/plutarch-test/plutarch-base/Plutarch/PlutusTypeSpec.hs new file mode 100644 index 000000000..eedb9de56 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/PlutusTypeSpec.hs @@ -0,0 +1,304 @@ +{-# LANGUAGE CPP #-} + +module Plutarch.PlutusTypeSpec (spec) where + +import Data.Functor.Compose (Compose (Compose)) +import Data.SOP.NS (NS (S, Z)) + +import Plutarch.Api.V1 ( + PAddress (PAddress), + PCredential (PPubKeyCredential, PScriptCredential), + PScriptPurpose (PCertifying, PMinting, PRewarding, PSpending), + ) +import Plutarch.Builtin (pasByteStr, pasConstr) +import Plutarch.DataRepr (PDataSum (PDataSum)) +import Plutarch.Prelude +import Plutarch.Test +import Plutarch.Unit () +import PlutusLedgerApi.V1 (DCert (DCertGenesis), toData) +import PlutusLedgerApi.V1.Address (Address (Address)) +import PlutusLedgerApi.V1.Contexts (ScriptPurpose (Certifying, Minting, Rewarding, Spending), TxOutRef (TxOutRef)) +import PlutusLedgerApi.V1.Credential ( + Credential (PubKeyCredential, ScriptCredential), + StakingCredential (StakingPtr), + ) + +import Test.Hspec + +spec :: Spec +spec = do + describe "plutustype" $ do + describe "example" . pgoldenSpec $ do + "swap" @\ do + "A" @| swap (pcon A) @== pcon B + "B" @| swap (pcon B) @== pcon A + "scottenc" @\ do + "PMaybe" + @| ( let a = 42 :: Term s PInteger + in pmatch (pcon $ PJust a) $ \case + PJust x -> x + -- We expect this perror not to be evaluated eagerly when mx + -- is a PJust. + PNothing -> perror + ) + "PPair" + @| ( let a = 42 :: Term s PInteger + b = "Universe" :: Term s PString + in pmatch (pcon (PPair a b) :: Term s (PPair PInteger PString)) $ \(PPair _ y) -> y + ) + describe "instances-sanity" $ do + it "PBuiltinList" $ do + pmatchTargetEval $ pconstant [1 :: Integer, 2, 3, 4] + deconstrSpec + +{- | For comparing typed and untyped data deconstruction approaches. + +We ideally want the typed and raw versions to have as little deviation as possible. +-} +deconstrSpec :: Spec +deconstrSpec = do + describe "deconstr" . pgoldenSpec $ do + "matching" @\ do + "typed" @\ do + "newtype" @\ do + "normal" + @| plam + ( \x -> pmatch x $ \(PAddress addrFields) -> + addrFields + ) + # pconstant addrPC + "datasum" + @| ( plam + ( \x -> pmatch (pupcast @(PInner PAddress) x) $ \(PDataSum datsum) -> case datsum of + Z (Compose addrFields) -> addrFields + _ -> perror + ) + # pconstant addrPC + ) + "sumtype(ignore-fields)" @\ do + "normal" + @| plam + ( \x -> pmatch x $ \case + PMinting _ -> pconstant () + _ -> perror + ) + # pconstant minting + "datasum" + @| plam + ( \x -> pmatch (pupcast @(PInner PScriptPurpose) x) $ \(PDataSum datsum) -> case datsum of + Z _ -> pconstant () + _ -> perror + ) + # pconstant minting + "sumtype(partial-match)" @\ do + "normal" + @| plam + ( \x -> pmatch x $ \case + PMinting hs -> hs + _ -> perror + ) + # pconstant minting + "datasum" + @| plam + ( \x -> pmatch (pupcast @(PInner PScriptPurpose) x) $ \(PDataSum datsum) -> case datsum of + Z (Compose hs) -> hs + _ -> perror + ) + # pconstant minting + "sumtype(exhaustive)" @\ do + ("normal" @\) $ + benchPurpose $ + plam + ( \x -> pmatch x $ \case + PMinting f -> plet f $ const $ phexByteStr "01" + PSpending f -> plet f $ const $ phexByteStr "02" + PRewarding f -> plet f $ const $ phexByteStr "03" + PCertifying f -> plet f $ const $ phexByteStr "04" + ) + ("datasum" @\) $ + benchPurpose $ + plam + ( \x -> pmatch (pupcast @(PInner PScriptPurpose) x) $ \(PDataSum datsum) -> case datsum of + Z (Compose f) -> plet f $ const $ phexByteStr "01" + S (Z (Compose f)) -> plet f $ const $ phexByteStr "02" + S (S (Z (Compose f))) -> plet f $ const $ phexByteStr "03" + S (S (S (Z (Compose f)))) -> plet f $ const $ phexByteStr "04" + _ -> perror + ) + "sumtype(exhaustive)(ignore-fields)" @\ do + ("normal" @\) $ + benchPurpose $ + plam + ( \x -> pmatch x $ \case + PMinting _ -> phexByteStr "01" + PSpending _ -> phexByteStr "02" + PRewarding _ -> phexByteStr "03" + PCertifying _ -> phexByteStr "04" + ) + ("datasum" @\) $ + benchPurpose $ + plam + ( \x -> pmatch (pupcast @(PInner PScriptPurpose) x) $ \(PDataSum datsum) -> case datsum of + Z _ -> phexByteStr "01" + S (Z _) -> phexByteStr "02" + S (S (Z _)) -> phexByteStr "03" + S (S (S (Z _))) -> phexByteStr "04" + _ -> perror + ) + "raw" @\ do + "newtype" + @| plam + ( \x -> + psndBuiltin #$ pasConstr # x + ) + #$ pconstant + (toData addrPC) + "sumtype(ignore-fields)" + @| plam + ( \x -> + pif + ((pfstBuiltin #$ pasConstr # x) #== 0) + (pconstant ()) + perror + ) + #$ pconstant (toData minting) + "sumtype(partial-match)" + @| plam + ( \x -> + plet (pasConstr # x) $ \d -> + pif + (pfstBuiltin # d #== 0) + (psndBuiltin # d) + perror + ) + #$ pconstant (toData minting) + "sumtype(exhaustive)" @\ do + benchPurpose' $ + plam + ( \x -> + plet (pasConstr # x) $ \d -> + plet (pfstBuiltin # d) $ \constr -> + plet (psndBuiltin # d) $ \_ -> + pif + (constr #== 1) + (phexByteStr "02") + $ pif + (constr #== 2) + (phexByteStr "03") + $ pif + (constr #== 3) + (phexByteStr "04") + $ phexByteStr "01" + ) + "sumtype(exhaustive)(ignore-fields)" @\ do + benchPurpose' $ + plam + ( \x -> do + plet (pfstBuiltin #$ pasConstr # x) $ \constr -> + pif + (constr #== 1) + (phexByteStr "02") + $ pif + (constr #== 2) + (phexByteStr "03") + $ pif + (constr #== 3) + (phexByteStr "04") + $ phexByteStr "01" + ) + "fields" @\ do + "typed" @\ do + "extract-single" + @| plam + ( \x -> + pfield @"credential" # x + ) + # pconstant addrSC + "raw" @\ do + "extract-single" + @| plam + ( \x -> + phead #$ psndBuiltin #$ pasConstr # x + ) + #$ pconstant + $ toData addrSC + "combined" @\ do + "typed" @\ do + "toValidatorHash" + @| plam + ( \x -> + pmatch (pfromData $ pfield @"credential" # x) $ \case + PPubKeyCredential _ -> + pcon PNothing + PScriptCredential credFields -> + pcon . PJust $ pto $ pfromData $ pfield @"_0" # credFields + ) + # pconstant addrSC + "raw" @\ do + "toValidatorHash" + @| plam + ( \x -> + let cred = phead #$ psndBuiltin #$ pasConstr # x + in plet (pasConstr # cred) $ \deconstrCred -> + pif + (pfstBuiltin # deconstrCred #== 0) + (pcon PNothing) + $ pcon . PJust $ pasByteStr #$ phead #$ psndBuiltin # deconstrCred + ) + # pconstant (toData addrSC) + where + addrSC = Address (ScriptCredential "ab") Nothing + addrPC = Address (PubKeyCredential "ab") Nothing + minting :: ScriptPurpose + minting = Minting "" + spending = Spending (TxOutRef "ab" 0) + rewarding = Rewarding (StakingPtr 42 0 7) + certifying = Certifying DCertGenesis + -- Bench given function feeding in all 4 types of script purpose (typed). + benchPurpose :: ClosedTerm (PScriptPurpose :--> PByteString) -> PlutarchGoldens + benchPurpose f = do + "minting" @| f # pconstant minting + "spending" @| f # pconstant spending + "rewarding" @| f # pconstant rewarding + "certifying" @| f # pconstant certifying + -- Bench given function feeding in all 4 types of script purpose (untyped). + benchPurpose' :: ClosedTerm (PData :--> PByteString) -> PlutarchGoldens + benchPurpose' f = do + "minting" @| f #$ pconstant $ toData minting + "spending" @| f #$ pconstant $ toData spending + "rewarding" @| f #$ pconstant $ toData rewarding + "certifying" @| f #$ pconstant $ toData certifying + +-- | Make sure the target of 'pmatch' is only evaluated once. +pmatchTargetEval :: PlutusType p => ClosedTerm p -> Expectation +pmatchTargetEval target = + pmatch (ptrace (pconstant tag) target) (\x -> plet (pcon x) $ \_ -> pconstant ()) + `ptraces` replicate 1 tag + where + tag = "evaluating" + +{- TODO: + - move over the testcase with pmatchTargetEval + - add more sanity checks +describe "sanity checks" $ do + describe "PBuiltinList" $ do + let p :: Term s (PBuiltinList PInteger) + p = pconstant [1,2,3,4] + it "works" $ + -} + +data AB (s :: S) + = A + | B + deriving stock (Generic) + deriving anyclass (PlutusType) +instance DerivePlutusType AB where type DPTStrat _ = PlutusTypeScott + +{- | + Instead of using `pcon'` and `pmatch'` directly, + use 'pcon' and 'pmatch', to hide the `PInner` type. +-} +swap :: Term s AB -> Term s AB +swap x = pmatch x $ \case + A -> pcon B + B -> pcon A diff --git a/plutarch-test/plutarch-base/Plutarch/RationalSpec.hs b/plutarch-test/plutarch-base/Plutarch/RationalSpec.hs new file mode 100644 index 000000000..64aff8ff6 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/RationalSpec.hs @@ -0,0 +1,50 @@ +module Plutarch.RationalSpec (spec) where + +import Plutarch.Prelude +import Plutarch.Rational (pproperFraction, ptruncate) +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + let rat :: Term s PRational -> Term s PRational + rat = id + assertRat :: ClosedTerm PRational -> ClosedTerm PRational -> Expectation + assertRat x p = passert $ p #== x + describe "rational" . pgoldenSpec $ do + "literal" @| rat 0.5 + "ops" @\ do + "+" @| rat (1 / 2 + 1 / 2) @-> assertRat 1 + "-" @| rat (1 / 2 - 1 / 3) @-> assertRat (1 / 6) + "*" @| rat ((1 - 3 / 2) * (2 - 5 / 2)) @-> assertRat (1 / 4) + "harmonic-sum" @| rat (1 / 2 + 1 / 3 + 1 / 4 + 1 / 5) + @-> assertRat (77 / 60) + "multi-product" @| rat (1 / 2 * 2 / 3 * 3 / 4 * 4 / 5 * 5 / 6) + @-> assertRat (1 / 6) + "compare" @| rat (2 / 9) #< rat (3 / 10) @-> passert + "round" @\ do + -- NOTE: These will eventually be replaced by property tests. + "5/3" @| pround # rat (5 / 3) @== pconstant @PInteger 2 + "4/3" @| pround # rat (4 / 3) @== pconstant @PInteger 1 + "-5/2" @| pround # rat (-5 / 2) @== pconstant @PInteger (-2) + "-1/4" @| pround # rat (-1 / 4) @== pconstant @PInteger 0 + "truncate" @\ do + "5/4" @| ptruncate # rat (5 / 4) @== pconstant @PInteger 1 + "7/4" @| ptruncate # rat (7 / 4) @== pconstant @PInteger 1 + "1/4" @| ptruncate # rat (1 / 4) @== pconstant @PInteger 0 + "-7/4" @| ptruncate # rat (-7 / 4) @== pconstant @PInteger (-1) + "properFraction" @\ do + let mkP r a b = pmatch (pproperFraction # r) $ \(PPair x y) -> + x #== a #&& y #== b + "-1/2" @| mkP (-1 / 2) 0 (-1 / 2) @-> passert + "-3/2" @| mkP (-3 / 2) (-1) (-1 / 2) @-> passert + "-4/3" @| mkP (-4 / 3) (-1) (-1 / 3) @-> passert + "data" @\ do + "id" @\ do + "0.5" @| rat 0.5 @-> assertRat (pfromData (pdata 0.5)) + "2" @| rat 2 @-> assertRat (pfromData (pdata 2)) + "11/3" @| rat 11 / 3 @-> assertRat (pfromData (pdata $ 11 / 3)) + "div by 0" @\ do + "1/0" @| ((1 :: Term s PRational) / 0) @-> pfails + "recip 0" @| recip (0 :: Term s PRational) @-> pfails + "1/(1-1)" @| ((1 :: Term s PRational) / (1 - 1)) @-> pfails diff --git a/plutarch-test/src/Plutarch/RecursionSpec.hs b/plutarch-test/plutarch-base/Plutarch/RecursionSpec.hs similarity index 64% rename from plutarch-test/src/Plutarch/RecursionSpec.hs rename to plutarch-test/plutarch-base/Plutarch/RecursionSpec.hs index bc2c1ec06..889c4c0f5 100644 --- a/plutarch-test/src/Plutarch/RecursionSpec.hs +++ b/plutarch-test/plutarch-base/Plutarch/RecursionSpec.hs @@ -6,24 +6,21 @@ import Plutarch import Plutarch.Bool (pif, (#==)) import Plutarch.Integer (PInteger) +import Plutarch.Lift (pconstant) import Plutarch.Test +import Test.Hspec spec :: Spec spec = do describe "recursion" $ do - describe "example" $ do - -- compilation - describe "iterateN" $ - golden All iterateN - -- tests - describe "iterateN (10) (+1) 0 == 10" $ do - let p :: Term s PInteger - p = 10 - it "works" $ (iterateN # 10 # succ # 0) #@?= p - describe "iterateN 10 (*2) 1 == 1024" $ do - let p :: Term s PInteger - p = 1024 - it "works" $ (iterateN # 10 # double # 1) #@?= p + describe "example" . pgoldenSpec $ do + "iterateN" @\ do + "lam" @| iterateN + "app" @\ do + "succ" @| iterateN # 10 # succ # 0 + @== pconstant @PInteger 10 + "double" @| iterateN # 10 # double # 1 + @== pconstant @PInteger 1024 succ :: Term s (PInteger :--> PInteger) succ = plam $ \x -> x + 1 diff --git a/plutarch-test/src/Plutarch/ScriptsSpec.hs b/plutarch-test/plutarch-base/Plutarch/ScriptsSpec.hs similarity index 74% rename from plutarch-test/src/Plutarch/ScriptsSpec.hs rename to plutarch-test/plutarch-base/Plutarch/ScriptsSpec.hs index 5654e016e..fe8e570d2 100644 --- a/plutarch-test/src/Plutarch/ScriptsSpec.hs +++ b/plutarch-test/plutarch-base/Plutarch/ScriptsSpec.hs @@ -17,13 +17,17 @@ module Plutarch.ScriptsSpec ( spec, ) where +import qualified Codec.CBOR.Write as Write +import Codec.Serialise (Serialise, encode) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as Base16 +import Data.Coerce (coerce) +import Data.Default (def) import Data.Text (Text) +import qualified Data.Text.Encoding as TE -import qualified Plutus.V1.Ledger.Api as Plutus -import qualified Plutus.V1.Ledger.Crypto as Plutus +import qualified PlutusLedgerApi.V1 as Plutus -import Data.Aeson.Extras (encodeSerialise) -import Plutarch (ClosedTerm, POpaque, popaque) import Plutarch.Api.V1 ( PScriptContext, mintingPolicySymbol, @@ -36,40 +40,32 @@ import Plutarch.Api.V1 ( type PStakeValidator, type PValidator, ) -import Plutarch.Api.V1.Crypto (PPubKey, PPubKeyHash, PSignature (PSignature)) +import Plutarch.Api.V1.Crypto (PPubKeyHash) import Plutarch.Builtin (pasByteStr) +import Plutarch.Crypto (pverifyEd25519Signature) import Plutarch.Prelude -import Plutarch.Test ( - PlutarchGolden (PrintTerm), - getGoldenFilePrefix, - golden, - goldenFilePath, - ) +import Plutarch.Test +import Test.Hspec spec :: Spec spec = do - describe "scripts" $ do - describe "auth_validator" $ do - prefix <- getGoldenFilePrefix - golden PrintTerm authValidatorTerm - it "hash" $ do - pureGoldenTextFile - (goldenFilePath "goldens" prefix "hash") - validatorHashEncoded - describe "auth_policy" $ do - prefix <- getGoldenFilePrefix - golden PrintTerm authPolicyTerm - it "hash" $ - pureGoldenTextFile - (goldenFilePath "goldens" prefix "hash") - policySymEncoded - describe "auth_stake_validator" $ do - prefix <- getGoldenFilePrefix - golden PrintTerm authStakeValidatorTerm - it "hash" $ - pureGoldenTextFile - (goldenFilePath "goldens" prefix "hash") - stakeValidatorHashEncoded + describe "scripts" . pgoldenSpec $ do + "auth_validator" @\ do + "0" @| authValidatorTerm + "hash" @| pconstant validatorHashEncoded + "auth_policy" @\ do + "0" @| authPolicyTerm + "hash" @| pconstant policySymEncoded + "auth_stake_validator" @\ do + "0" @| authStakeValidatorTerm + "hash" @| pconstant stakeValidatorHashEncoded + +encodeSerialise :: Serialise a => a -> Text +encodeSerialise = TE.decodeUtf8 . Base16.encode . Write.toStrictByteString . encode + +type PSignature = PByteString +type PPubKey = PByteString +type PubKey = ByteString {- | A parameterized Validator which may be unlocked @@ -83,7 +79,7 @@ authorizedValidator :: Term s POpaque authorizedValidator authKey datumMessage redeemerSig _ctx = pif - (pverifySignature # pto authKey # datumMessage # pto redeemerSig) + (pverifyEd25519Signature # authKey # datumMessage # redeemerSig) (popaque $ pcon PUnit) perror @@ -123,7 +119,7 @@ authorizedStakeValidator authHash _redeemer ctx = (popaque $ pcon PUnit) perror -adminPubKey :: Plutus.PubKey +adminPubKey :: PubKey adminPubKey = "11661a8aca9b09bb93eefda295b5da2be3f944d1f4253ab29da17db580f50d02d26218e33fbba5e0cc1b0c0cadfb67a5f9a90157dcc19eecd7c9373b0415c888" adminPubKeyHash :: Plutus.PubKeyHash @@ -134,8 +130,7 @@ adminPubKeyHash = "cc1360b04bdd0825e0c6552abb2af9b4df75b71f0c7cca20256b1f4f" `pwrapValidatorFromData` -} authValidatorCompiled :: Plutus.Validator -authValidatorCompiled = - mkValidator authValidatorTerm +authValidatorCompiled = mkValidator def authValidatorTerm authValidatorTerm :: ClosedTerm PValidator authValidatorTerm = @@ -143,7 +138,7 @@ authValidatorTerm = authorizedValidator (pconstant adminPubKey) (pasByteStr # datum) - (pcon $ PSignature $ pasByteStr # redeemer) + (pasByteStr # redeemer) ctx -- | `validatorHash` gets the Plutus `ValidatorHash` @@ -152,8 +147,7 @@ authValidatorHash = validatorHash authValidatorCompiled -- | Similarly, for a MintingPolicy authPolicyCompiled :: Plutus.MintingPolicy -authPolicyCompiled = - mkMintingPolicy authPolicyTerm +authPolicyCompiled = mkMintingPolicy def authPolicyTerm authPolicyTerm :: ClosedTerm PMintingPolicy authPolicyTerm = @@ -170,8 +164,7 @@ authPolicySymbol = -- | ...And for a StakeValidator authStakeValidatorCompiled :: Plutus.StakeValidator -authStakeValidatorCompiled = - mkStakeValidator authStakeValidatorTerm +authStakeValidatorCompiled = mkStakeValidator def authStakeValidatorTerm authStakeValidatorTerm :: ClosedTerm PStakeValidator authStakeValidatorTerm = @@ -207,12 +200,12 @@ stakeValidatorEncoded = encodeSerialise authStakeValidatorCompiled Also note that this is not the addr1/CIP-0019 Address encoding of the script. -} validatorHashEncoded :: Text -validatorHashEncoded = encodeSerialise authValidatorHash +validatorHashEncoded = encodeSerialise (coerce authValidatorHash :: Plutus.BuiltinByteString) -- | The same goes for `CurrencySymbol` policySymEncoded :: Text -policySymEncoded = encodeSerialise authPolicySymbol +policySymEncoded = encodeSerialise (coerce authPolicySymbol :: Plutus.BuiltinByteString) -- | ... And `StakeValidatorHash` stakeValidatorHashEncoded :: Text -stakeValidatorHashEncoded = encodeSerialise authStakeValidatorHash +stakeValidatorHashEncoded = encodeSerialise (coerce authStakeValidatorHash :: Plutus.BuiltinByteString) diff --git a/plutarch-test/plutarch-base/Plutarch/ShowSpec.hs b/plutarch-test/plutarch-base/Plutarch/ShowSpec.hs new file mode 100644 index 000000000..ab4fcba6f --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/ShowSpec.hs @@ -0,0 +1,79 @@ +module Plutarch.ShowSpec (spec) where + +import Control.Monad (forM_) +import Data.String (IsString (fromString)) +import qualified Data.Text as T + +import Plutarch.ListSpec (integerList) +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + let str x = pconstant @PString x + describe "show" . pgoldenSpec $ do + "unit" @| pshow (pcon PUnit) @== str "()" + "bool" @\ do + "true" @| pshow (pcon PTrue) @== str "PTrue" + "false" @| pshow (pcon PFalse) @== str "PFalse" + "int" @\ do + "0" @| pshow (pconstant @PInteger 0) @== str "0" + forM_ [5, 10, 14, 102] $ \n -> do + (fromString $ show n) + @| pshow (pconstant @PInteger n) + @== pconstant (T.pack $ show n) + (fromString $ show (-n)) + @| pshow (pconstant @PInteger (-n)) + @== pconstant (T.pack $ show (-n)) + "bytestring" @\ do + "empty" @| pshow (phexByteStr "") @== str "0x" + "1" @| pshow (phexByteStr "14") @== str "0x14" + "2" @| pshow (phexByteStr "14AF") @== str "0x14af" + "3" @| pshow (phexByteStr "14AF03") @== str "0x14af03" + "n" @| pshow (phexByteStr "FFFFFF") @== str "0xffffff" + "0" @| pshow (phexByteStr "000000") @== str "0x000000" + "str" @\ do + "empty" @| pshow (str "") @== str "\"\"" + "hello123" @| pshow (str "hello123") @== str "\"hello123\"" + "quoted" @| pshow (str "hello\"123") @== str "\"hello\\\"123\"" + "slash" @| pshow (str "foo\\bar") @== str "\"foo\\bar\"" + "unicode" @| pshow (str "vis-à-vis") @== str "\"vis-à-vis\"" + "unicode-quoted" @| pshow (str "vis-\"à\"-vis") @== str "\"vis-\\\"à\\\"-vis\"" + "maybe" @\ do + "nothing" + @| pshow @(PMaybe PInteger) (pcon PNothing) + @== str "PNothing" + "just" + @| pshow @(PMaybe PInteger) (pcon $ PJust $ pconstant @PInteger 42) + @== str "PJust 42" + "either" @\ do + "right" + @| pshow (pcon @(PEither PUnit PInteger) $ PRight 42) + @== str "PRight 42" + -- Test automatic injection of `(..)`. + "maybe.either" + @| pshow (pcon $ PJust $ pcon @(PEither PInteger PUnit) $ PLeft 42) + @== str "PJust (PLeft 42)" + "list" @\ do + "nil" @| pshow (integerList []) @== str "[]" + "1" @| pshow (integerList [1]) @== str "[1]" + "1,2,3" @| pshow (integerList [1, 2, 3]) @== str "[1, 2, 3]" + "builtinlist" @\ do + let xs3 = pconstant @(PBuiltinList PInteger) [1, 2, 3] + xs0 = pconstant @(PBuiltinList PInteger) [] + "nil" @| pshow xs0 @== str "[]" + "1,2,3" @| pshow xs3 @== str "[1, 2, 3]" + "pair" @\ do + "int-str" + @| pshow (pcon @(PPair PInteger PString) $ PPair 42 "hello") + @== str "PPair 42 \"hello\"" + "int-list" + @| pshow (pcon @(PPair PInteger (PBuiltinList PInteger)) $ PPair 42 $ pconstant [1, 2, 3]) + @== str "PPair 42 [1, 2, 3]" + "rational" @\ do + let rat :: Term s PRational -> Term s PRational + rat = id + "1/2" + @| pshow (rat $ 1 / 2) + @== str "1/2" diff --git a/plutarch-test/plutarch-base/Plutarch/SpecTypes.hs b/plutarch-test/plutarch-base/Plutarch/SpecTypes.hs new file mode 100644 index 000000000..bb4d83970 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/SpecTypes.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} + +module Plutarch.SpecTypes (Triplet (..), PTriplet (..)) where + +import qualified PlutusTx + +import Plutarch.DataRepr ( + DerivePConstantViaData (DerivePConstantViaData), + PDataFields, + ) +import Plutarch.Lift ( + PConstantDecl (PConstanted), + PUnsafeLiftDecl (PLifted), + ) +import Plutarch.Prelude +import Test.Tasty.QuickCheck (Arbitrary, arbitrary) + +data Triplet a = Triplet a a a + deriving stock (Show, Eq, Ord) + +{- | + We can defined a data-type using PDataRecord, with labeled fields. + + With an appropriate instance of 'PIsDataRepr', we can automatically + derive 'PDataFields'. +-} +newtype PTriplet (a :: PType) (s :: S) + = PTriplet + ( Term + s + ( PDataRecord + '[ "x" ':= a + , "y" ':= a + , "z" ':= a + ] + ) + ) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PEq, PPartialOrd, POrd, PDataFields) + +instance DerivePlutusType (PTriplet a) where type DPTStrat _ = PlutusTypeData + +PlutusTx.makeIsDataIndexed ''Triplet [('Triplet, 0)] + +instance PLiftData a => PUnsafeLiftDecl (PTriplet a) where + type PLifted (PTriplet a) = Triplet (PLifted a) + +deriving via + (DerivePConstantViaData (Triplet a) (PTriplet (PConstanted a))) + instance + PConstantData a => PConstantDecl (Triplet a) + +instance Arbitrary a => Arbitrary (Triplet a) where + arbitrary = Triplet <$> arbitrary <*> arbitrary <*> arbitrary diff --git a/plutarch-test/plutarch-base/Plutarch/StringSpec.hs b/plutarch-test/plutarch-base/Plutarch/StringSpec.hs new file mode 100644 index 000000000..ae0c67886 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/StringSpec.hs @@ -0,0 +1,19 @@ +module Plutarch.StringSpec (spec) where + +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "str" $ do + pgoldenSpec $ do + "eq" @| "foo" #== pconstant @PString "foo" @-> passert + "semigroup" @\ do + let s1 = pconstant @PString "foo" + s2 = pconstant @PString "bar" + "laws" @\ do + "id.1" @| (mempty <> s1) #== s1 @-> passert + "id.2" @| s1 #== (mempty <> s1) @-> passert + "concat" @| s1 <> s2 #== pconstant @PString "foobar" @-> passert + "mempty" @| mempty #== pconstant @PString "" @-> passert diff --git a/plutarch-test/plutarch-base/Plutarch/TraceSpec.hs b/plutarch-test/plutarch-base/Plutarch/TraceSpec.hs new file mode 100644 index 000000000..32a334c9c --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/TraceSpec.hs @@ -0,0 +1,38 @@ +module Plutarch.TraceSpec (spec) where + +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "trace" . pgoldenSpec $ do + "ptrace" @\ do + "one" @| ptrace "foo" (pcon PUnit) @-> \p -> + ptraces p ["foo"] + "two" @| ptrace "foo" (ptrace "bar" (pcon PUnit)) @-> \p -> + ptraces p ["foo", "bar"] + "ptraceShowId" @\ do + let x = pcon @(PEither PUnit PInteger) $ PRight 42 + "right-42" @| ptraceShowId x @-> \p -> + p `ptraces` ["PRight 42"] + "ptraceIfTrue" @\ do + "true" @| ptraceIfTrue "foo" (pcon PTrue) @-> \p -> + p `ptraces` ["foo"] + "false" @| ptraceIfTrue "foo" (pcon PFalse) @-> \p -> + p `ptraces` [] + "ptraceIfFalse" @\ do + "true" @| ptraceIfFalse "foo" (pcon PTrue) @-> \p -> + p `ptraces` [] + "false" @| ptraceIfFalse "foo" (pcon PFalse) @-> \p -> + p `ptraces` ["foo"] + "chained" @\ do + "false.true.false" + @| ptraceIfFalse "foo" (ptraceIfTrue "bar" $ pcon PFalse) + @-> \p -> p `ptraces` ["foo"] + "ptrace.true.false" + @| ptrace "foo" (ptraceIfTrue "bar" $ pcon PFalse) + @-> \p -> p `ptraces` ["foo"] + "ptrace.true.true" + @| ptrace "foo" (ptraceIfTrue "bar" $ pcon PTrue) + @-> \p -> p `ptraces` ["foo", "bar"] diff --git a/plutarch-test/plutarch-base/Plutarch/UPLCSpec.hs b/plutarch-test/plutarch-base/Plutarch/UPLCSpec.hs new file mode 100644 index 000000000..cdbddb154 --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/UPLCSpec.hs @@ -0,0 +1,49 @@ +module Plutarch.UPLCSpec (spec) where + +import qualified PlutusCore as PLC + +import Plutarch.Internal (punsafeConstantInternal) +import Plutarch.Prelude +import Plutarch.Test +import Plutarch.Unsafe (punsafeBuiltin) +import Test.Hspec + +spec :: Spec +spec = do + -- Tests for the behaviour of UPLC itself. + describe "uplc-behaviour" . pgoldenSpec $ do + "2:[1]" + @| ( let l :: Term _ (PBuiltinList PInteger) = + punsafeConstantInternal . PLC.Some $ + PLC.ValueOf (PLC.DefaultUniApply PLC.DefaultUniProtoList PLC.DefaultUniInteger) [1] + in pforce (punsafeBuiltin PLC.MkCons) # (2 :: Term _ PInteger) # l + ) + "fails:True:[1]" + @| ( let l :: Term _ (PBuiltinList POpaque) = + punsafeConstantInternal . PLC.Some $ + PLC.ValueOf (PLC.DefaultUniApply PLC.DefaultUniProtoList PLC.DefaultUniInteger) [1] + in pforce (punsafeBuiltin PLC.MkCons) # pcon PTrue # l @-> pfails + ) + "(2,1)" + @| punsafeConstantInternal . PLC.Some + $ PLC.ValueOf + ( PLC.DefaultUniApply + (PLC.DefaultUniApply PLC.DefaultUniProtoPair PLC.DefaultUniInteger) + PLC.DefaultUniInteger + ) + (1, 2) + "fails:MkPair-1-2" + @| punsafeBuiltin PLC.MkPairData # (1 :: Term _ PInteger) # (2 :: Term _ PInteger) + @-> pfails + describe "uplc-misc" . pgoldenSpec $ do + "perror" @| perror @-> pfails + -- FIXME readd test + -- "perror.arg" @| perror # (1 :: Term s PInteger) @-> pfails + "laziness" @\ do + "f.d" @| (pforce . pdelay $ (0 :: Term s PInteger)) + "d.f.d" @| (pdelay . pforce . pdelay $ (0 :: Term s PInteger)) + "hoist" @\ do + -- hoist id 0 => 0 + "id.0" @| phoistAcyclic $ plam $ \x -> x # (0 :: Term s PInteger) + -- hoist fstPair => fstPair + "fstPair" @| phoistAcyclic (punsafeBuiltin PLC.FstPair) diff --git a/plutarch-test/plutarch-base/Plutarch/UnitSpec.hs b/plutarch-test/plutarch-base/Plutarch/UnitSpec.hs new file mode 100644 index 000000000..534b8168a --- /dev/null +++ b/plutarch-test/plutarch-base/Plutarch/UnitSpec.hs @@ -0,0 +1,16 @@ +module Plutarch.UnitSpec (spec) where + +import Plutarch +import Plutarch.Prelude +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "unit" . pgoldenSpec $ do + "pcon" @| pcon PUnit + "pmatch" @| pmatch (pcon PUnit) (\case PUnit -> pcon PTrue) @-> passert + "compare" @\ do + "==" @| pcon PUnit #== pcon PUnit @-> passert + "<" @| pcon PUnit #< pcon PUnit @-> passertNot + "<=" @| pcon PUnit #<= pcon PUnit @-> passert diff --git a/plutarch-test/plutarch-extra/ExtraSpec.hs b/plutarch-test/plutarch-extra/ExtraSpec.hs new file mode 100644 index 000000000..25d177796 --- /dev/null +++ b/plutarch-test/plutarch-extra/ExtraSpec.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=ExtraSpec #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} diff --git a/plutarch-test/plutarch-extra/Plutarch/Extra/ApiSpec.hs b/plutarch-test/plutarch-extra/Plutarch/Extra/ApiSpec.hs new file mode 100644 index 000000000..50b4f3182 --- /dev/null +++ b/plutarch-test/plutarch-extra/Plutarch/Extra/ApiSpec.hs @@ -0,0 +1,62 @@ +module Plutarch.Extra.ApiSpec (spec) where + +import Plutarch.Extra.Api +import Plutarch.Prelude + +import Plutarch.Api.V1 (PScriptPurpose (PSpending)) +import Plutarch.ApiSpec (d0DatValue, inp, validContext0, validOutputs0) +import Plutarch.Extra.TermCont (pmatchC) +import Plutarch.Maybe (pfromJust) +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = do + describe "extra.api" $ do + let ctx = validContext0 + pgoldenSpec $ do + "pfindOwnInput" + @| ( unTermCont $ do + ctxF <- tcont $ pletFields @["txInfo", "purpose"] ctx + pmatchC (getField @"purpose" ctxF) >>= \case + PSpending outRef' -> do + let outRef = pfield @"_0" # outRef' + inputs = pfield @"inputs" # (getField @"txInfo" ctxF) + pure $ pfindOwnInput # inputs # outRef + _ -> + pure perror + ) + @-> \res -> + passert (pfromJust # res #== pconstant inp) + "pgetContinuingOutputs" + @| ( unTermCont $ do + ctxF <- tcont $ pletFields @["txInfo", "purpose"] ctx + pmatchC (getField @"purpose" ctxF) >>= \case + PSpending outRef' -> do + let outRef = pfield @"_0" # outRef' + inputs = pfield @"inputs" #$ getField @"txInfo" ctxF + outputs = pfield @"outputs" #$ getField @"txInfo" ctxF + pure $ pgetContinuingOutputs # inputs # outputs # outRef + _ -> + pure perror + ) + @-> \txOuts -> + passert $ txOuts #== pconstant validOutputs0 + "pparseDatum" + @| ( pparseDatum @(PBuiltinList (PAsData PInteger)) + # pconstant "d0" + #$ pfield @"datums" + #$ pfield @"txInfo" + # ctx + ) + @-> \res -> + passert $ res #== pcon (PJust $ pdata $ d0DatTerm) + +-- | The Plutarch term we expect when decoding `d0Dat`. +d0DatTerm :: Term s (PBuiltinList (PAsData PInteger)) +d0DatTerm = liftList $ flip fmap d0DatValue $ \i -> pdata $ pconstant i + +liftList :: PLift a => [Term s a] -> Term s (PBuiltinList a) +liftList = \case + [] -> pnil + (x : xs) -> pcons # x # liftList xs diff --git a/plutarch-test/plutarch-extra/Plutarch/Extra/ByteStringSpec.hs b/plutarch-test/plutarch-extra/Plutarch/Extra/ByteStringSpec.hs new file mode 100644 index 000000000..8870240f3 --- /dev/null +++ b/plutarch-test/plutarch-extra/Plutarch/Extra/ByteStringSpec.hs @@ -0,0 +1,22 @@ +module Plutarch.Extra.ByteStringSpec (spec) where + +import Data.Char (ord) + +import Plutarch.Extra.ByteString (pallBS, pisHexDigit) + +import Plutarch.Prelude + +import Plutarch.ListSpec (integerList) + +import Plutarch.Test +import Test.Hspec + +spec :: Spec +spec = describe "extra.bytestring" . pgoldenSpec $ do + "allandhexdigit" @\ do + "allas" @| pallBS # plam (#== pconstant (toInteger $ ord 'a')) # pconstant "aaaaaaaaaaaaa" @-> passert + "not all as" @| pallBS # plam (#== pconstant (toInteger $ ord 'a')) # pconstant "aaaaaabaaaaa" @-> passertNot + "allhex" @| pallBS # pisHexDigit # pconstant "5a7c18eae8778d15344f" @-> passert + "notallhex" @| pallBS # pisHexDigit # pconstant "5a7c18eae8778g15344f" @-> passertNot + "pisHexDigit" @| pall @PList # pisHexDigit # integerList (toInteger . ord <$> "1234567890abcdef") @-> passert + "pisNoneHexDigit" @| pany @PList # pisHexDigit # integerList (toInteger . ord <$> "ghikjklmnopqrstuvwxyz !@#$%^&*()[]{}`~") @-> passertNot diff --git a/plutarch-test/plutarch-extra/Plutarch/Extra/IntervalSpec.hs b/plutarch-test/plutarch-extra/Plutarch/Extra/IntervalSpec.hs new file mode 100644 index 000000000..97709dcb1 --- /dev/null +++ b/plutarch-test/plutarch-extra/Plutarch/Extra/IntervalSpec.hs @@ -0,0 +1,284 @@ +module Plutarch.Extra.IntervalSpec (spec) where + +import Plutarch.Api.V1.Interval (PInterval) +import Plutarch.Extra.Interval ( + pafter, + palways, + pbefore, + pcontains, + pfrom, + phull, + pintersection, + pinterval, + pmember, + pnever, + psingleton, + pto, + ) +import Plutarch.Prelude hiding (psingleton, pto) + +import Hedgehog (Property, PropertyT, assert, forAll, property) +import qualified Hedgehog.Gen as Gen (int, list) +import Hedgehog.Internal.Property (propertyTest) +import qualified Hedgehog.Range as Range (constantBounded, singleton) +import Plutarch.Test (passert, passertNot, pgoldenSpec, psucceeds, (@->), (@\), (@|)) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.Hedgehog (hedgehog) + +spec :: Spec +spec = do + describe "extra.intervalutils" $ do + describe "fixtures" $ do + let i1 :: Term s (PInterval PInteger) + i1 = mkInterval 1 2 + i2 :: Term s (PInterval PInteger) + i2 = mkInterval 3 5 + i3 :: Term s (PInterval PInteger) + i3 = mkInterval 2 4 + i4 :: Term s (PInterval PInteger) + i4 = mkInterval 4 4 + i5 :: Term s (PInterval PInteger) + i5 = mkInterval 3 4 + pgoldenSpec $ do + "constants" @\ do + "always" @| palways @PInteger @-> psucceeds + "never" @| pnever @PInteger @-> psucceeds + "contains" @\ do + "in interval" @| pcontains # i2 # i4 @-> passert + "out interval" @| pcontains # i4 # i2 @-> passertNot + "always" @| pcontains # palways @PInteger # i1 @-> passert + "never" @| pcontains # pnever @PInteger # i1 @-> passertNot + "member" @\ do + "[b,c], a < b" @| pmember # pconstantData 1 # i3 @-> passertNot + "[b,c], a = b" @| pmember # pconstantData 2 # i3 @-> passert + "[b,c], a > b, a < c" @| pmember # pconstantData 3 # i3 @-> passert + "[b,c], a = c" @| pmember # pconstantData 4 # i3 @-> passert + "[b,c], a > c" @| pmember # pconstantData 5 # i3 @-> passertNot + "hull" @\ do + let theHull :: Term s (PInterval PInteger) + theHull = phull # (psingleton # pconstantData 3) # (psingleton # pconstantData 5) + "hull 3 5 contains 3 5" @| pcontains # theHull # i2 @-> passert + "2 not member of hull 3 5" @| pmember # pconstantData 2 # theHull @-> passertNot + "6 not member of hull 3 5" @| pmember # pconstantData 2 # theHull @-> passertNot + "intersection" @\ do + "intesection [2,4] [3,5] contains [3,4]" + @| pcontains # (pintersection # i3 # i2) # i5 + "intesection [3,5] [2,4] contains [3,4]" + @| pcontains # (pintersection # i2 # i3) # i5 + + describe "member" $ do + it "a is a member of [b, c] iff b <= a and a <= c" . hedgehog + . propertyTest + $ prop_member + describe "always" $ do + it "always contains everything" . hedgehog . propertyTest $ prop_always + describe "never" $ do + it "never contains nothing" . hedgehog . propertyTest $ prop_never + describe "hull" $ do + it "hull of a and b contains a and b" . hedgehog . propertyTest $ + prop_hull + describe "intersection" $ do + it "intersection of a and b is contained in a and b" . hedgehog + . propertyTest + $ prop_intersection + describe "contains" $ do + describe "contains on bounded intervals" $ do + it "[a, b] contains [c, d] iff a <= c and d <= b" . hedgehog + . propertyTest + $ prop_containsBounded + describe "contains on unbounded (from above) intervals" $ do + it "[a, inf] contains [c, d] iff a <= c" . hedgehog + . propertyTest + $ prop_containsUnboundedUpper + describe "contains on unbounded (from below) intervals" $ do + it "[-inf, b] contains [c, d] iff d <= b" . hedgehog + . propertyTest + $ prop_containsUnboundedLower + describe "before" $ do + it "a is before [b, c] iff a < b" . hedgehog + . propertyTest + $ prop_before + describe "after" $ do + it "a is after [b, c] iff c < a" . hedgehog + . propertyTest + $ prop_after + +prop_member :: Property +prop_member = property $ do + [a, b, c] <- genIntegerList 3 + assert $ checkMember a b c + +prop_always :: Property +prop_always = property $ do + [a, b] <- genIntegerList 2 + assert $ checkAlways a b + +prop_never :: Property +prop_never = property $ do + [a, b] <- genIntegerList 2 + assert $ checkNever a b + +prop_hull :: Property +prop_hull = property $ do + [a, b, c, d] <- genIntegerList 4 + assert $ checkHull a b c d + +prop_intersection :: Property +prop_intersection = property $ do + [a, b, c, d] <- genIntegerList 4 + assert $ checkIntersection a b c d + +prop_containsBounded :: Property +prop_containsBounded = property $ do + [a, b, c, d] <- genIntegerList 4 + assert $ checkBoundedContains a b c d + +prop_containsUnboundedUpper :: Property +prop_containsUnboundedUpper = property $ do + [a, b, c] <- genIntegerList 3 + assert $ checkUnboundedUpperContains a b c + +prop_containsUnboundedLower :: Property +prop_containsUnboundedLower = property $ do + [a, b, c] <- genIntegerList 3 + assert $ checkUnboundedLowerContains a b c + +prop_before :: Property +prop_before = property $ do + [a, b, c] <- genIntegerList 3 + assert $ checkBefore a b c + +prop_after :: Property +prop_after = property $ do + [a, b, c] <- genIntegerList 3 + assert $ checkAfter a b c + +checkMember :: Integer -> Integer -> Integer -> Bool +checkMember a b c = actual == expected + where + i :: Term s (PInterval PInteger) + i = mkInterval b c + + actual = plift $ pmember # pconstantData a # i + expected = (min b c <= a) && (a <= max b c) + +checkAlways :: Integer -> Integer -> Bool +checkAlways a b = plift $ pcontains # palways # i + where + i :: Term s (PInterval PInteger) + i = mkInterval a b + +checkNever :: Integer -> Integer -> Bool +checkNever a b = not (plift $ pcontains # pnever # i) + where + i :: Term s (PInterval PInteger) + i = mkInterval a b + +checkHull :: Integer -> Integer -> Integer -> Integer -> Bool +checkHull a b c d = plift $ (pcontains # i3 # i1) #&& (pcontains # i3 # i2) + where + i1 :: Term s (PInterval PInteger) + i1 = mkInterval a b + + i2 :: Term s (PInterval PInteger) + i2 = mkInterval c d + + i3 :: Term s (PInterval PInteger) + i3 = phull # i1 # i2 + +checkIntersection :: Integer -> Integer -> Integer -> Integer -> Bool +checkIntersection a b c d = plift $ (pcontains # i1 # i3) #&& (pcontains # i2 # i3) + where + i1 :: Term s (PInterval PInteger) + i1 = mkInterval a b + + i2 :: Term s (PInterval PInteger) + i2 = mkInterval c d + + i3 :: Term s (PInterval PInteger) + i3 = pintersection # i1 # i2 + +checkBoundedContains :: Integer -> Integer -> Integer -> Integer -> Bool +checkBoundedContains a b c d = actual == expected + where + i1 :: Term s (PInterval PInteger) + i1 = mkInterval a b + i2 :: Term s (PInterval PInteger) + i2 = mkInterval c d + + expected :: Bool + expected = (min a b <= min c d) && (max c d <= max a b) + + actual' :: ClosedTerm PBool + actual' = pcontains # i1 # i2 + actual = plift actual' + +checkUnboundedUpperContains :: Integer -> Integer -> Integer -> Bool +checkUnboundedUpperContains a b c = actual == expected + where + i1 :: Term s (PInterval PInteger) + i1 = pfrom # pconstantData a + i2 :: Term s (PInterval PInteger) + i2 = mkInterval b c + + expected :: Bool + expected = a <= min b c + + actual' :: ClosedTerm PBool + actual' = pcontains # i1 # i2 + actual = plift actual' + +checkUnboundedLowerContains :: Integer -> Integer -> Integer -> Bool +checkUnboundedLowerContains a b c = actual == expected + where + i1 :: Term s (PInterval PInteger) + i1 = pto # pconstantData a + i2 :: Term s (PInterval PInteger) + i2 = mkInterval b c + + expected :: Bool + expected = a >= max b c + + actual' :: ClosedTerm PBool + actual' = pcontains # i1 # i2 + actual = plift actual' + +checkBefore :: Integer -> Integer -> Integer -> Bool +checkBefore a b c = actual == expected + where + i :: Term s (PInterval PInteger) + i = mkInterval b c + + expected :: Bool + expected = a < min b c + + actual' :: ClosedTerm PBool + actual' = pbefore # pconstant a # i + actual = plift actual' + +checkAfter :: Integer -> Integer -> Integer -> Bool +checkAfter a b c = actual == expected + where + i :: Term s (PInterval PInteger) + i = mkInterval b c + + expected :: Bool + expected = max b c < a + + actual' :: ClosedTerm PBool + actual' = pafter # pconstant a # i + actual = plift actual' + +mkInterval :: forall s. Integer -> Integer -> Term s (PInterval PInteger) +mkInterval a' b' = pinterval # pconstantData a # pconstantData b + where + a = min a' b' + b = max a' b' + +genIntegerList :: Monad m => Int -> PropertyT m [Integer] +genIntegerList n = + (fmap . fmap) toInteger $ + forAll $ + Gen.list + (Range.singleton n) + (Gen.int Range.constantBounded) diff --git a/plutarch-test/plutarch-extra/Plutarch/Extra/ListSpec.hs b/plutarch-test/plutarch-extra/Plutarch/Extra/ListSpec.hs new file mode 100644 index 000000000..78be1e786 --- /dev/null +++ b/plutarch-test/plutarch-extra/Plutarch/Extra/ListSpec.hs @@ -0,0 +1,36 @@ +module Plutarch.Extra.ListSpec (spec) where + +import Plutarch.Extra.List (pcheckSorted, preverse) +import Plutarch.Prelude + +import Hedgehog (Property) +import Hedgehog.Internal.Property (propertyTest) +import Plutarch.Test +import Plutarch.Test.Property +import Plutarch.Test.Property.Gen (genInteger, genList) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.Hedgehog (hedgehog) + +spec :: Spec +spec = do + describe "extra.listutils" $ do + describe "properties" $ do + describe "reverse" $ do + it "plutarch level reversing behaves like haskell level reversing" . hedgehog . propertyTest $ prop_preverseEquiv + pgoldenSpec $ do + "reverse" @\ do + "reverse_[1..5]" @| preverse # marshal [1 .. 5 :: Integer] + "isSorted" @\ do + "[1..10]" @| pcheckSorted # marshal [1 .. 10 :: Integer] @-> passert + "reverse_[1..10]" @| (pnot #$ pcheckSorted #$ marshal $ reverse [1 .. 10 :: Integer]) @-> passert + "reverse_[]" @| preverse # marshal ([] :: [Integer]) + +-- plutarch level reversing behaves like haskell level reversing +prop_preverseEquiv :: Property +prop_preverseEquiv = do + prop_haskEquiv + @( 'OnPEq) + @( 'TotalFun) + (reverse :: [Integer] -> [Integer]) + preverse + (genList genInteger :* Nil) diff --git a/plutarch-test/plutarch-test.cabal b/plutarch-test/plutarch-test.cabal index 5639f3328..ac8f0e0b0 100644 --- a/plutarch-test/plutarch-test.cabal +++ b/plutarch-test/plutarch-test.cabal @@ -1,11 +1,6 @@ -cabal-version: 2.4 +cabal-version: 3.0 name: plutarch-test -version: 1.1.0 - -flag development - description: Enable tracing functions within plutarch. - manual: True - default: False +version: 1.2.0 common c default-language: Haskell2010 @@ -13,9 +8,11 @@ common c NoStarIsType BangPatterns BinaryLiterals + BlockArguments ConstrainedClassMethods ConstraintKinds DataKinds + DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable @@ -34,6 +31,7 @@ common c FlexibleContexts FlexibleInstances ForeignFunctionInterface + FunctionalDependencies GADTSyntax GeneralisedNewtypeDeriving HexFloatLiterals @@ -49,17 +47,20 @@ common c OverloadedStrings PartialTypeSignatures PatternGuards + PatternSynonyms PolyKinds PostfixOperators + QuantifiedConstraints RankNTypes RelaxedPolyRec + RoleAnnotations ScopedTypeVariables StandaloneDeriving StandaloneKindSignatures TraditionalRecordSyntax TupleSections TypeApplications - TypeFamilies + TypeFamilyDependencies TypeOperators TypeSynonymInstances ViewPatterns @@ -69,20 +70,33 @@ common c -Wno-partial-type-signatures -Wmissing-export-lists -Werror -Wincomplete-record-updates -Wmissing-deriving-strategies -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls - -fprint-explicit-kinds + -fprint-explicit-kinds -Wno-unrecognised-warning-flags common deps build-depends: - , aeson >=2.0 + , aeson >=2.0 , base , bytestring + , containers + , data-default + , directory , filepath , generics-sop + , hedgehog + , hspec + , hspec-core + , hspec-discover + , hspec-golden + , hspec-hedgehog + , mtl , plutarch - , plutarch-benchmark + , plutarch-extra , plutus-core , plutus-ledger-api , plutus-tx + , quickcheck-instances + , serialise + , sop-core , tasty , tasty-hunit , tasty-quickcheck @@ -91,39 +105,85 @@ common deps library import: c, deps - hs-source-dirs: src - exposed-modules: Plutarch.Test + hs-source-dirs: common + exposed-modules: + Plutarch.Test + Plutarch.Test.Property + + other-modules: + Plutarch.Test.Benchmark + Plutarch.Test.Golden + Plutarch.Test.ListSyntax + Plutarch.Test.Property.Extra + Plutarch.Test.Property.Gen + Plutarch.Test.Property.HaskEquiv + Plutarch.Test.Property.Marshal + Plutarch.Test.Run executable plutarch-test import: c, deps - type: exitcode-stdio-1.0 main-is: Main.hs - hs-source-dirs: src + hs-source-dirs: plutarch-base plutarch-extra common conditional ./. + build-depends: + , base16-bytestring + , cborg + , containers + , plutarch-test + , rank2classes + , serialise + + -- FIXME: Re-enable + -- if impl(ghc <9.0) + -- build-depends: + -- , plutus-tx-plugin + + -- other-modules: Plutarch.FFISpec if impl(ghc >=9.0) other-modules: Plutarch.FieldSpec Plutarch.MonadicSpec + Plutarch.TryFromSpec other-modules: + BaseSpec + ExtraSpec Plutarch.ApiSpec Plutarch.BoolSpec Plutarch.ByteStringSpec + Plutarch.EitherSpec + Plutarch.Extra.ApiSpec + Plutarch.Extra.ByteStringSpec + Plutarch.Extra.IntervalSpec + Plutarch.Extra.ListSpec Plutarch.IntegerSpec + Plutarch.LiftSpec Plutarch.ListSpec + Plutarch.MaybeSpec + Plutarch.PairSpec Plutarch.PIsDataSpec Plutarch.PLamSpec Plutarch.PlutusTypeSpec + Plutarch.POrdSpec Plutarch.RationalSpec Plutarch.RecursionSpec Plutarch.ScriptsSpec + Plutarch.ShowSpec + Plutarch.SpecTypes Plutarch.StringSpec Plutarch.Test + Plutarch.Test.Benchmark + Plutarch.Test.Golden + Plutarch.Test.ListSyntax + Plutarch.Test.Property + Plutarch.Test.Property.Extra + Plutarch.Test.Property.Gen + Plutarch.Test.Property.HaskEquiv + Plutarch.Test.Property.Marshal + Plutarch.Test.Run Plutarch.TraceSpec Plutarch.UnitSpec - Spec - - if flag(development) - cpp-options: -DDevelopment + Plutarch.UPLCSpec - ghc-options: -threaded -rtsopts -with-rtsopts=-N + -- FIXME remove -Wwarn=deprecations + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wwarn=deprecations diff --git a/plutarch-test/src/Main.hs b/plutarch-test/src/Main.hs deleted file mode 100644 index 9a040eda5..000000000 --- a/plutarch-test/src/Main.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Main (main) where - -import GHC.IO.Encoding (setLocaleEncoding, utf8) - -main :: IO () -main = do - setLocaleEncoding utf8 - pure () diff --git a/plutarch-test/src/Plutarch/ApiSpec.hs b/plutarch-test/src/Plutarch/ApiSpec.hs deleted file mode 100644 index 1c0b6145d..000000000 --- a/plutarch-test/src/Plutarch/ApiSpec.hs +++ /dev/null @@ -1,204 +0,0 @@ -module Plutarch.ApiSpec (spec, ctx) where - -import Test.Tasty.HUnit - -import Control.Monad.Trans.Cont (cont, runCont) -import Plutus.V1.Ledger.Api -import qualified Plutus.V1.Ledger.Interval as Interval -import qualified Plutus.V1.Ledger.Value as Value - -import Plutarch.Api.V1 ( - PCredential, - PCurrencySymbol, - PPubKeyHash, - PScriptContext, - PScriptPurpose (PSpending), - PTxInInfo, - PTxInfo, - PValue, - ) -import Plutarch.Builtin (pasConstr, pforgetData) -import Plutarch.Prelude -import Plutarch.Test - -spec :: Spec -spec = do - describe "api" $ do - describe "ctx" $ do - golden PrintTerm ctx - describe "get" $ do - describe "txInfo" $ do - let p = pfromData $ getTxInfo # ctx - golden All p - it "works" $ plift p @?= info - describe "mint" $ do - let p = pforgetData $ getMint #$ getTxInfo # ctx - golden All p - it "works" $ plift p @?= toData mint - describe "credentials" $ do - let p = getCredentials ctx - golden All p - it "works" $ plift p @?= [toData validator] - describe "sym" $ do - let p = pfromData $ getSym #$ pfromData $ getMint #$ getTxInfo # ctx - golden All p - it "works" $ plift p @?= sym - describe "example" $ do - -- The checkSignatory family of functions implicitly use tracing due to - -- monadic syntax, and as such we need two sets of tests here. - -- See Plutarch.MonadicSpec for GHC9 only syntax. - describe "signatory" . plutarchDevFlagDescribe $ do - let aSig :: PubKeyHash = "ab01fe235c" - describe "cont" $ do - let p = checkSignatoryCont # pconstant aSig # ctx - pe = checkSignatoryCont # pconstant "41" # ctx - golden All p - it "succeeds" $ psucceeds p - it "fails" $ pfails pe - describe "termcont" $ do - let p = checkSignatoryTermCont # pconstant aSig # ctx - pe = checkSignatoryTermCont # pconstant "41" # ctx - golden All p - it "succeeds" $ psucceeds p - it "fails" $ pfails pe - describe "getFields" $ - golden All getFields - --------------------------------------------------------------------------------- - -{- | - An example 'PScriptContext' Term, - lifted with 'pconstant' --} -ctx :: Term s PScriptContext -ctx = - pconstant - (ScriptContext info purpose) - --- | Simple script context, with minting and a single input -info :: TxInfo -info = - TxInfo - { txInfoInputs = [inp] - , txInfoOutputs = [] - , txInfoFee = mempty - , txInfoMint = mint - , txInfoDCert = [] - , txInfoWdrl = [] - , txInfoValidRange = Interval.always - , txInfoSignatories = signatories - , txInfoData = [] - , txInfoId = "b0" - } - --- | A script input -inp :: TxInInfo -inp = - TxInInfo - { txInInfoOutRef = ref - , txInInfoResolved = - TxOut - { txOutAddress = - Address (ScriptCredential validator) Nothing - , txOutValue = mempty - , txOutDatumHash = Just datum - } - } - --- | Minting a single token -mint :: Value -mint = Value.singleton sym "sometoken" 1 - -ref :: TxOutRef -ref = TxOutRef "a0" 0 - -purpose :: ScriptPurpose -purpose = Spending ref - -validator :: ValidatorHash -validator = "a1" - -datum :: DatumHash -datum = "d0" - -sym :: CurrencySymbol -sym = "c0" - -signatories :: [PubKeyHash] -signatories = ["ab01fe235c", "123014", "abcdef"] - --------------------------------------------------------------------------------- - -getTxInfo :: Term s (PScriptContext :--> PAsData PTxInfo) -getTxInfo = - plam $ \ctx -> - pfield @"txInfo" # ctx - -getMint :: Term s (PAsData PTxInfo :--> PAsData PValue) -getMint = - plam $ \info -> - pfield @"mint" # info - --- | Get validator from first input in ScriptContext's TxInfo -getCredentials :: Term s PScriptContext -> Term s (PBuiltinList PData) -getCredentials ctx = - let inp = pfield @"inputs" #$ pfield @"txInfo" # ctx - in pmap # inputCredentialHash # inp - -{- | - Get the hash of the Credential in an input, treating - PubKey & ValidatorHash identically. --} -inputCredentialHash :: Term s (PAsData PTxInInfo :--> PData) -inputCredentialHash = - phoistAcyclic $ - plam $ \inp -> - let credential :: Term _ (PAsData PCredential) - credential = - (pfield @"credential") - #$ (pfield @"address") - #$ (pfield @"resolved" # inp) - in phead #$ psndBuiltin #$ pasConstr # pforgetData credential - --- | Get first CurrencySymbol from Value -getSym :: Term s (PValue :--> PAsData PCurrencySymbol) -getSym = - plam $ \v -> pfstBuiltin #$ phead # pto (pto v) - --- | `checkSignatory` implemented using `runCont` -checkSignatoryCont :: forall s. Term s (PPubKeyHash :--> PScriptContext :--> PUnit) -checkSignatoryCont = plam $ \ph ctx' -> - pletFields @["txInfo", "purpose"] ctx' $ \ctx -> (`runCont` id) $ do - purpose <- cont (pmatch $ hrecField @"purpose" ctx) - pure $ case purpose of - PSpending _ -> - let signatories :: Term s (PBuiltinList (PAsData PPubKeyHash)) - signatories = pfield @"signatories" # hrecField @"txInfo" ctx - in pif - (pelem # pdata ph # signatories) - -- Success! - (pconstant ()) - -- Signature not present. - perror - _ -> - ptraceError "checkSignatoryCont: not a spending tx" - --- | `checkSignatory` implemented using `runTermCont` -checkSignatoryTermCont :: Term s (PPubKeyHash :--> PScriptContext :--> PUnit) -checkSignatoryTermCont = plam $ \ph ctx' -> unTermCont $ do - ctx <- tcont $ pletFields @["txInfo", "purpose"] ctx' - tcont (pmatch $ hrecField @"purpose" ctx) >>= \case - PSpending _ -> do - let signatories = pfield @"signatories" # hrecField @"txInfo" ctx - pure $ - pif - (pelem # pdata ph # pfromData signatories) - -- Success! - (pconstant ()) - -- Signature not present. - perror - _ -> - pure $ ptraceError "checkSignatoryCont: not a spending tx" - -getFields :: Term s (PData :--> PBuiltinList PData) -getFields = phoistAcyclic $ plam $ \addr -> psndBuiltin #$ pasConstr # addr diff --git a/plutarch-test/src/Plutarch/BoolSpec.hs b/plutarch-test/src/Plutarch/BoolSpec.hs deleted file mode 100644 index d7622df4d..000000000 --- a/plutarch-test/src/Plutarch/BoolSpec.hs +++ /dev/null @@ -1,62 +0,0 @@ -module Plutarch.BoolSpec (spec) where - -import Plutarch -import Plutarch.Bool (PBool (PFalse, PTrue), pand, pnot, por, (#&&), (#||)) -import Plutarch.Test - -spec :: Spec -spec = do - describe "bool" $ do - describe "pnot" $ do - goldens - All - [ ("lam", popaque pnot) - , ("app", popaque $ pnot #$ pcon PTrue) - ] - it "true" $ (pnot #$ pcon PTrue) #@?= pcon PFalse - it "false" $ (pnot #$ pcon PFalse) #@?= pcon PTrue - describe "pand" $ do - goldens - All - [ ("tf", pcon PTrue #&& pcon PFalse) - , ("ft", pcon PFalse #&& pcon PTrue) - , ("tt", pcon PTrue #&& pcon PTrue) - , ("ff", pcon PFalse #&& pcon PFalse) - ] - it "tf" $ (pcon PTrue #&& pcon PFalse) #@?= pcon PFalse - it "ft" $ (pcon PFalse #&& pcon PTrue) #@?= pcon PFalse - it "tt" $ (pcon PTrue #&& pcon PTrue) #@?= pcon PTrue - it "ff" $ (pcon PFalse #&& pcon PFalse) #@?= pcon PFalse - describe "laziness" $ do - let p1 = pand # pcon PFalse # pdelay perror - p2 = pcon PFalse #&& perror - goldens All [("pand", popaque p1), ("op", popaque p2)] - it "pand" $ passert $ pnot # pforce p1 - it "op" $ passert $ pnot # p2 - it "pand.perror" $ do - pfails $ pand # pcon PFalse # perror - pfails $ pand # pcon PTrue # perror - pfails $ pcon PTrue #&& perror - describe "por" $ do - goldens - All - [ ("tf", pcon PTrue #|| pcon PFalse) - , ("ft", pcon PFalse #|| pcon PTrue) - , ("tt", pcon PTrue #|| pcon PTrue) - , ("ff", pcon PFalse #|| pcon PFalse) - ] - it "tf" $ (pcon PTrue #|| pcon PFalse) #@?= pcon PTrue - it "ft" $ (pcon PFalse #|| pcon PTrue) #@?= pcon PTrue - it "tt" $ (pcon PTrue #|| pcon PTrue) #@?= pcon PTrue - it "ff" $ (pcon PFalse #|| pcon PFalse) #@?= pcon PFalse - describe "laziness" $ do - let p1 = por # pcon PTrue # pdelay perror - p2 = pcon PTrue #|| perror - goldens All [("por", popaque p1), ("op", popaque p2)] - it "por" $ passert $ pforce p1 - it "op" $ passert p2 - it "pand.perror" $ do - pfails $ por # pcon PFalse # perror - pfails $ por # pcon PTrue # perror - passert $ pcon PTrue #|| perror - pfails $ pcon PFalse #|| perror diff --git a/plutarch-test/src/Plutarch/ByteStringSpec.hs b/plutarch-test/src/Plutarch/ByteStringSpec.hs deleted file mode 100644 index ad2bb6336..000000000 --- a/plutarch-test/src/Plutarch/ByteStringSpec.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Plutarch.ByteStringSpec (spec) where - -import qualified Data.ByteString as BS -import Plutarch.Prelude -import Plutarch.Test - -spec :: Spec -spec = do - describe "bytestring" $ do - it "empty" $ - passert $ mempty #== phexByteStr "" - describe "phexByteStr" $ do - let a :: [String] = ["42", "ab", "df", "c9"] - p = pconstant @PByteString (BS.pack $ map readByte a) #== phexByteStr (concat a) - golden Bench p - it "relation" $ passert p - describe "plengthByteStr" $ do - let p = (plengthBS # phexByteStr "012f") #== 2 - golden All p - it "works" $ passert p - describe "pconsBS" $ do - let xs = phexByteStr "48fCd1" - p = (plengthBS #$ pconsBS # 91 # xs) #== (1 + plengthBS # xs) - golden All p - it "works" $ passert p - describe "pindexByteStr" $ do - let p = (pindexBS # phexByteStr "4102af" # 1) #== pconstant @PInteger 0x02 - golden All p - it "works" $ passert p - describe "psliceByteStr" $ do - let p = (psliceBS # 2 # 3 # phexByteStr "4102afde5b2a") #== phexByteStr "afde5b" - golden All p - it "works" $ passert p - describe "eq" $ do - let p = phexByteStr "12" #== phexByteStr "12" - golden All p - it "works" $ passert p - describe "semigroup" $ do - let s1 = phexByteStr "12" - s2 = phexByteStr "34" - golden All $ s1 <> s2 - it "laws" $ do - passert $ (mempty <> s1) #== s1 - passert $ s1 #== (mempty <> s1) - it "concats" $ do - passert $ s1 <> s2 #== phexByteStr "1234" - -{- | Interpret a byte. - ->>> readByte "41" -65 --} -readByte :: Num a => String -> a -readByte a = fromInteger $ read $ "0x" <> a diff --git a/plutarch-test/src/Plutarch/ListSpec.hs b/plutarch-test/src/Plutarch/ListSpec.hs deleted file mode 100644 index fc81dfc40..000000000 --- a/plutarch-test/src/Plutarch/ListSpec.hs +++ /dev/null @@ -1,63 +0,0 @@ -module Plutarch.ListSpec (spec) where - -import Plutarch.List (pconvertLists, pfoldl') -import Plutarch.Prelude -import Plutarch.Test - -integerList :: [Integer] -> Term s (PList PInteger) -integerList xs = pconvertLists #$ pconstant @(PBuiltinList PInteger) xs - -spec :: Spec -spec = do - describe "list" $ do - let xs10 :: Term _ (PList PInteger) - xs10 = integerList [1 .. 10] - describe "pmatch" $ do - let p = pmatch (integerList [1, 3, 1]) $ \_ -> perror - golden PrintTerm p - describe "phead" $ do - let p = phead # xs10 - golden All p - it "works" $ passert $ p #== 1 - describe "ptail" $ do - let p = ptail # xs10 - golden All p - it "works" $ passert $ p #== integerList [2 .. 10] - describe "pnull" $ do - let p0 = pnull # integerList [] - p1 = pnull # xs10 - goldens All [("p0", p0), ("p1", p1)] - it "empty" $ passert p0 - it "nonempty" $ passert $ pnot # p1 - describe "pconcat" $ do - describe "identity" $ do - let xs :: Term s (PList PInteger) - xs = psingleton # (fromInteger @(Term _ PInteger) 0) - p = pconcat # xs # pnil - golden All p - it "works" $ passert $ p #== xs - describe "pmap" $ do - let p = pmap # (plam $ \x -> x + x) # xs10 - golden All p - it "eg" $ passert $ p #== (integerList $ fmap (* 2) [1 .. 10]) - it "identity" $ passert $ pmap @PList # (plam $ \(x :: Term _ PInteger) -> x) # pnil #== pnil - describe "pfilter" $ do - let p1 = pfilter # (plam $ \x -> pmod # x # 2 #== 0) # xs10 - p2 = pfilter # (plam $ \x -> 5 #< x) # xs10 - goldens All [("p1", p1), ("p2", p2)] - it "p1" $ passert $ p1 #== integerList [2, 4, 6, 8, 10] - it "p2" $ passert $ p2 #== integerList [6 .. 10] - describe "pzipWith" $ do - let p = pzipWith' (+) # xs10 # xs10 - golden All p - it "works" $ passert $ p #== integerList (fmap (* 2) [1 .. 10]) - describe "pfoldl" $ do - let p1 = pfoldl # plam (-) # 0 # xs10 - p1' = pfoldl' (-) # 0 # xs10 - p2 = pfoldl # plam (-) # 0 # integerList [] - p2' = pfoldl' (-) # 0 # integerList [] - goldens All [("p1", p1), ("p1'", p1'), ("p2", p2), ("p2'", p2)] - it "nonempty" $ passert $ p1 #== pconstant (foldl (-) 0 [1 .. 10]) - it "nonempty'" $ passert $ p1' #== pconstant (foldl (-) 0 [1 .. 10]) - it "empty" $ passert $ p2 #== pconstant 0 - it "empty'" $ passert $ p2' #== pconstant 0 diff --git a/plutarch-test/src/Plutarch/MonadicSpec.hs b/plutarch-test/src/Plutarch/MonadicSpec.hs deleted file mode 100644 index b62bb8fd4..000000000 --- a/plutarch-test/src/Plutarch/MonadicSpec.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE QualifiedDo #-} - -module Plutarch.MonadicSpec (spec) where - -import Plutus.V1.Ledger.Api - -import Plutarch.Api.V1 ( - PAddress (PAddress), - PCredential, - PMaybeData, - PPubKeyHash, - PScriptContext, - PScriptPurpose (PSpending), - PStakingCredential, - ) -import qualified Plutarch.ApiSpec as ApiSpec -import qualified Plutarch.Monadic as P -import Plutarch.Prelude -import Plutarch.Test - -spec :: Spec -spec = do - describe "monadic" $ do - describe "api.example" $ do - -- The checkSignatory family of functions implicitly use tracing due to - -- monadic syntax, and as such we need two sets of tests here. - describe "signatory" . plutarchDevFlagDescribe $ do - let aSig :: PubKeyHash = "ab01fe235c" - describe "haskell" $ do - let p = checkSignatory # pconstant aSig # ApiSpec.ctx - pe = checkSignatory # pconstant "41" # ApiSpec.ctx - golden All p - it "succeeds" $ psucceeds p - it "fails" $ pfails pe - describe "getFields" $ - golden All getFields - -checkSignatory :: Term s (PPubKeyHash :--> PScriptContext :--> PUnit) -checkSignatory = plam $ \ph ctx' -> - pletFields @["txInfo", "purpose"] ctx' $ \ctx -> P.do - PSpending _ <- pmatch $ ctx.purpose - let signatories = pfield @"signatories" # ctx.txInfo - pif - (pelem # pdata ph # pfromData signatories) - -- Success! - (pconstant ()) - -- Signature not present. - perror - -getFields :: Term s (PAddress :--> PDataRecord '["credential" ':= PCredential, "stakingCredential" ':= PMaybeData PStakingCredential]) -getFields = phoistAcyclic $ - plam $ \addr -> P.do - PAddress addrFields <- pmatch addr - addrFields diff --git a/plutarch-test/src/Plutarch/PIsDataSpec.hs b/plutarch-test/src/Plutarch/PIsDataSpec.hs deleted file mode 100644 index 2bc7a302b..000000000 --- a/plutarch-test/src/Plutarch/PIsDataSpec.hs +++ /dev/null @@ -1,102 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} - -module Plutarch.PIsDataSpec (spec) where - -import Data.Text.Encoding (encodeUtf8) - -import Plutarch.Api.V1 -import Plutarch.Api.V1.Tuple (pbuiltinPairFromTuple, ptupleFromBuiltin) -import Plutarch.Builtin (pforgetData, ppairDataBuiltin) -import Plutarch.Lift (PLifted) -import Plutarch.Prelude - -import Plutus.V1.Ledger.Credential (Credential (ScriptCredential)) -import qualified PlutusTx - -import Plutarch.Test -import Test.Tasty.QuickCheck (Arbitrary, property) - -spec :: Spec -spec = do - describe "pisdata" $ do - propertySet @PBool "PBool" - propertySet @PInteger "PInteger" - propertySet @PUnit "PUnit" - describe "ppair" $ do - describe "pfromData (pdata (I 1, B 0x41)) ≡ (I 1, I 2)" $ do - let p :: Term s (PBuiltinPair (PAsData PInteger) (PAsData PByteString)) - p = - ppairDataBuiltin # pconstantData @PInteger 1 - -- ByteString doesn't have a ToData instance - can't use pconstantData.... - #$ pdata - $ pconstant $ encodeUtf8 "A" - it "works" $ pfromData (pdata p) #@?= p - describe "pfromData (pdata (PTxId 0x41, PScriptCredential 0x82)) ≡ (PTxId 0x41, PScriptCredential 0x82)" $ do - let p = - ppairDataBuiltin - # pconstantData @PTxId "41" #$ pconstantData - $ ScriptCredential "82" - it "works" $ pfromData (pdata p) #@?= p - describe "ptuple isomorphism" $ do - let p = - ppairDataBuiltin - # pconstantData @PTxId "41" #$ pconstantData - $ ScriptCredential "82" - tup = pdata $ ptuple # pconstantData @PTxId "41" #$ pconstantData $ ScriptCredential "82" - it "works" $ pforgetData (pdata p) #@?= pforgetData tup - it "works" $ pfromData (pbuiltinPairFromTuple tup) #@?= p - it "works" $ ptupleFromBuiltin (pdata p) #@?= tup - -propertySet :: - forall p. - ( PIsData p - , PLift p - , PlutusTx.ToData (PLifted p) - , PlutusTx.FromData (PLifted p) - , Eq (PLifted p) - , Show (PLifted p) - , Arbitrary (PLifted p) - ) => - String -> - Spec -propertySet typeName = do - describe typeName $ do - specify ("x ~ " <> typeName <> ": pfromData (pdata x) ≡ x") $ - property $ ptoFromEqual @p - specify ("x ~ " <> typeName <> ": pfromData (PlutusTx.toData x) ≡ x") $ - property $ pfromDataCompat @p - specify ("x ~ " <> typeName <> ": PlutusTx.fromData (pdata x) ≡ Just x") $ - property $ pdataCompat @p - -ptoFromEqual :: - forall p. - ( PIsData p - , PLift p - ) => - PLifted p -> - _ -ptoFromEqual t = pfromData (pdata $ pconstant @p t) `pshouldBe` pconstant @p t - -pfromDataCompat :: - forall p. - ( PIsData p - , PlutusTx.ToData (PLifted p) - , PLift p - , Eq (PLifted p) - , Show (PLifted p) - ) => - PLifted p -> - IO () -pfromDataCompat x = plift (pfromData $ pconstantData @p x) `shouldBe` x - -pdataCompat :: - forall p. - ( PLift p - , PIsData p - , PlutusTx.FromData (PLifted p) - , Eq (PLifted p) - , Show (PLifted p) - ) => - PLifted p -> - IO () -pdataCompat x = PlutusTx.fromData @(PLifted p) (plift $ pforgetData $ pdata $ pconstant @p x) `shouldBe` Just x diff --git a/plutarch-test/src/Plutarch/PLamSpec.hs b/plutarch-test/src/Plutarch/PLamSpec.hs deleted file mode 100644 index 4d387c894..000000000 --- a/plutarch-test/src/Plutarch/PLamSpec.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Plutarch.PLamSpec (spec) where - -import Plutarch -import Plutarch.Test - -spec :: Spec -spec = do - describe "plam" $ do - describe "id" $ do - golden PrintTerm $ plam (\x -> x) - describe "flip.const" $ do - golden PrintTerm $ plam (\_ y -> y) - describe "plet" $ do - golden PrintTerm $ plam (\x _ -> plet x $ \_ -> perror) diff --git a/plutarch-test/src/Plutarch/PlutusTypeSpec.hs b/plutarch-test/src/Plutarch/PlutusTypeSpec.hs deleted file mode 100644 index 0f3319f5c..000000000 --- a/plutarch-test/src/Plutarch/PlutusTypeSpec.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Plutarch.PlutusTypeSpec (spec) where - -import Plutarch -import Plutarch.Prelude - -import Plutarch.Test - -spec :: Spec -spec = do - describe "plutustype" $ do - describe "example" $ do - describe "A encoded as 0" $ do - let p :: Term s PInteger - p = 0 - it "works" (pcon A #@?= p) - describe "B encoded as 1" $ do - let p :: Term s PInteger - p = 1 - it "works" $ pcon B #@?= p - describe "swap A == B" $ do - it "works" $ swap (pcon A) #@?= pcon B - describe "swap B == A" $ do - it "works" $ swap (pcon B) #@?= pcon A - describe "instances-sanity" $ do - plutarchDevFlagDescribe $ do - it "PBuiltinList" $ do - pmatchTargetEval $ pconstant [1 :: Integer, 2, 3, 4] - --- | Make sure the target of 'pmatch' is only evaluated once. -pmatchTargetEval :: PlutusType p => ClosedTerm p -> Expectation -pmatchTargetEval target = - pmatch (ptrace (pconstant tag) target) (\x -> plet (pcon x) $ \_ -> pconstant ()) - `ptraces` replicate 1 tag - where - tag = "evaluating" - -{- TODO: - - move over the testcase with pmatchTargetEval - - add more sanity checks -describe "sanity checks" $ do - describe "PBuiltinList" $ do - let p :: Term s (PBuiltinList PInteger) - p = pconstant [1,2,3,4] - it "works" $ - -} - -{- | - A Sum type, which can be encoded as an Enum --} -data AB (s :: S) = A | B - -{- | - AB is encoded as an Enum, using values of PInteger - internally. --} -instance PlutusType AB where - type PInner AB _ = PInteger - - pcon' A = 0 - pcon' B = 1 - - pmatch' x f = - pif (x #== 0) (f A) (f B) - -{- | - Instead of using `pcon'` and `pmatch'` directly, - use 'pcon' and 'pmatch', to hide the `PInner` type. --} -swap :: Term s AB -> Term s AB -swap x = pmatch x $ \case - A -> pcon B - B -> pcon A diff --git a/plutarch-test/src/Plutarch/RationalSpec.hs b/plutarch-test/src/Plutarch/RationalSpec.hs deleted file mode 100644 index 5acff7efe..000000000 --- a/plutarch-test/src/Plutarch/RationalSpec.hs +++ /dev/null @@ -1,62 +0,0 @@ -module Plutarch.RationalSpec (spec) where - -import Plutarch.Prelude -import Plutarch.Rational (pproperFraction, ptruncate) -import Plutarch.Test - -spec :: Spec -spec = do - describe "rational" $ do - describe "literal" $ do - let p = 0.5 :: Term s PRational - golden PrintTerm p - describe "ops" $ do - let p1 = (1 / 2 + 1 / 2) :: Term s PRational - p2 = 1 / 2 - 1 / 3 :: Term s PRational - p3 = (1 - 3 / 2) * (2 - 5 / 2) :: Term s PRational - goldens - All - [ ("+", p1) - , ("-", p2) - , ("*", p3) - ] - it "+" $ passert $ p1 #== 1 - it "-" $ passert $ p2 #== 1 / 6 - it "*" $ passert $ p3 #== 1 / 4 - it "harmonic-sum" $ - passert $ 1 / 2 + 1 / 3 + 1 / 4 + 1 / 5 #== (77 / 60 :: Term s PRational) - it "multi-product" $ - passert $ 1 / 2 * 2 / 3 * 3 / 4 * 4 / 5 * 5 / 6 #== (1 / 6 :: Term s PRational) - describe "compare" $ do - let p1 = 2 / 9 #< (3 / 10 :: Term s PRational) - goldens All [("<", p1)] - it "<" $ passert p1 - describe "round" $ do - -- NOTE: These will eventually be replaced by property tests. - it "5/3" $ passert $ pround # (5 / 3) #== 2 - it "4/3" $ passert $ pround # (4 / 3) #== 1 - it "-5/2" $ passert $ pround # (-5 / 2) #== -2 - it "-1/4" $ passert $ pround # (-1 / 4) #== 0 - describe "truncate" $ do - it "5/4" $ passert $ ptruncate # (5 / 4) #== 1 - it "7/4" $ passert $ ptruncate # (7 / 4) #== 1 - it "1/4" $ passert $ ptruncate # (1 / 4) #== 0 - it "-7/4" $ passert $ ptruncate # (-7 / 4) #== -1 - describe "properFraction" $ do - it "-1/2" $ - passert $ - pmatch (pproperFraction # (-1 / 2)) $ \(PPair x y) -> - x #== 0 #&& y #== (-1 / 2) - it "-3/2" $ - passert $ - pmatch (pproperFraction # (-3 / 2)) $ \(PPair x y) -> - x #== -1 #&& y #== (-1 / 2) - it "-4/3" $ - passert $ - pmatch (pproperFraction # (-4 / 3)) $ \(PPair x y) -> - x #== -1 #&& y #== (-1 / 3) - describe "data" $ do - describe "id" $ do - it "0.5" $ passert $ (0.5 :: Term s PRational) #== pfromData (pdata 0.5) - it "2" $ passert $ (2 :: Term s PRational) #== pfromData (pdata 2) - it "11/3" $ passert $ (11 / 3 :: Term s PRational) #== pfromData (pdata $ 11 / 3) diff --git a/plutarch-test/src/Plutarch/StringSpec.hs b/plutarch-test/src/Plutarch/StringSpec.hs deleted file mode 100644 index 55a866d25..000000000 --- a/plutarch-test/src/Plutarch/StringSpec.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Plutarch.StringSpec (spec) where - -import Plutarch.Prelude -import Plutarch.Test - -spec :: Spec -spec = do - describe "str" $ do - describe "eq" $ do - let p = "foo" #== pconstant @PString "foo" - golden All p - it "works" $ passert p - describe "semigroup" $ do - let s1 = pconstant @PString "foo" - s2 = pconstant @PString "bar" - golden All $ s1 <> s2 - it "laws" $ do - passert $ (mempty <> s1) #== s1 - passert $ s1 #== (mempty <> s1) - it "concats" $ do - passert $ s1 <> s2 #== pconstant @PString "foobar" - it "mempty" $ do - passert $ mempty #== pconstant @PString "" diff --git a/plutarch-test/src/Plutarch/Test.hs b/plutarch-test/src/Plutarch/Test.hs deleted file mode 100644 index 7993c2e79..000000000 --- a/plutarch-test/src/Plutarch/Test.hs +++ /dev/null @@ -1,199 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ImpredicativeTypes #-} - --- | Common functions for testing Plutarch code -module Plutarch.Test ( - -- | Plutarch specific `Expectation` operators - passert, - pfails, - psucceeds, - ptraces, - pshouldBe, - (#@?=), - plutarchDevFlagDescribe, - -- | Golden testing - -- - -- Typically you want to use `golden`. For grouping multiple goldens, use - -- `goldens`. - golden, - goldens, - PlutarchGolden (All, Bench, PrintTerm), - getGoldenFilePrefix, - goldenFilePath, -) where - -import Control.Monad (when) -import qualified Data.Aeson.Text as Aeson -import Data.Kind (Type) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import System.FilePath - -import Plutarch -import Plutarch.Benchmark (benchmarkScript') -import Plutarch.Bool (PBool (PTrue)) -import Plutarch.Evaluate (evaluateScript) -import qualified Plutus.V1.Ledger.Scripts as Scripts - -{- | - Like `shouldBe` but but for Plutarch terms --} -pshouldBe :: ClosedTerm a -> ClosedTerm b -> Expectation -pshouldBe x y = do - p1 <- fmap printScript $ eval $ compile x - p2 <- fmap printScript $ eval $ compile y - p1 `shouldBe` p2 - where - eval :: Scripts.Script -> IO Scripts.Script - eval s = case evaluateScript s of - Left e -> expectationFailure $ "Script evaluation failed: " <> show e - Right (_, _, x') -> pure x' - -{- Like `@?=` but for Plutarch terms -} -(#@?=) :: ClosedTerm a -> ClosedTerm b -> Expectation -(#@?=) = pshouldBe - -{- Asserts the term to be true -} -passert :: ClosedTerm a -> Expectation -passert p = p #@?= pcon PTrue - -{- Asserts the term evaluates successfully without failing -} -psucceeds :: ClosedTerm a -> Expectation -psucceeds p = - case evaluateScript (compile p) of - Left _ -> expectationFailure $ "Term failed to evaluate" - Right _ -> pure () - -{- Like `printTerm` but evaluates the term beforehand. - - All evaluation failures are treated as equivalent to a `perror`. Plutus does - not provide an accurate way to tell if the program evalutes to `Error` or not; - see https://github.com/input-output-hk/plutus/issues/4270 - --} -printTermEvaluated :: ClosedTerm a -> String -printTermEvaluated p = - case evaluateScript (compile p) of - Left _ -> printTerm perror - Right (_, _, x) -> printScript x - -{- | Asserts that the term evaluates successfully with the given trace sequence - - See also: `plutarchDevFlagDescribe` --} -ptraces :: ClosedTerm a -> [Text] -> Expectation -ptraces p develTraces = - case evaluateScript (compile p) of - Left _ -> expectationFailure $ "Term failed to evaluate" - Right (_, traceLog, _) -> do -#ifdef Development - traceLog `shouldBe` develTraces -#else - -- Tracing is disabled in non-developed modes, so we should expect an - -- empty trace log. - let noTraces = const [] develTraces - traceLog `shouldBe` noTraces -#endif - -{- | Like `describe`, but determines description from `Development` CPP flag - - Useful to create two sets of othersise identical group of tests that differ - only by `Development` flag. This has the effect of creating two sets of golden - tests (with different filepaths) for corresponding flag values. - - Typically meant to be used in conjunction with `ptraces`. --} -plutarchDevFlagDescribe :: forall (outers :: [Type]) inner. TestDefM outers inner () -> TestDefM outers inner () - --- CPP support isn't great in fourmolu. -{- ORMOLU_DISABLE -} -plutarchDevFlagDescribe m = -#ifdef Development - describe "dev=true" m -#else - describe "dev=false" m -#endif -{- ORMOLU_ENABLE -} - -{- Asserts the term evaluates without success -} -pfails :: ClosedTerm a -> Expectation -pfails p = do - case evaluateScript (compile p) of - Left _ -> pure () - Right _ -> expectationFailure $ "Term succeeded" - -{- Whether to run all or a particular golden test - - Typically you want to use `All` -- this produces printTerm and benchmark - goldens. - - Occasionally you want `PrintTerm` because you don't care to benchmark that - program. - - Use `Bench` to only benchmark the program. --} -data PlutarchGolden - = All - | Bench - | PrintTerm - deriving stock (Eq, Show) - -hasBenchGolden :: PlutarchGolden -> Bool -hasBenchGolden = \case - PrintTerm -> False - _ -> True - -hasPrintTermGolden :: PlutarchGolden -> Bool -hasPrintTermGolden = \case - Bench -> False - _ -> True - -{- Run golden tests on the given Plutarch program -} -golden :: PlutarchGolden -> ClosedTerm a -> Spec -golden pg p = - goldens pg [("0", popaque p)] - -{- | Like `golden` but for multiple programs - - Multiple programs use a single golden file. Each output separated from the - keyword with a space. --} -goldens :: PlutarchGolden -> [(String, ClosedTerm a)] -> Spec -goldens pg ps = do - name <- getGoldenFilePrefix - describe "golden" $ do - -- Golden test for UPLC - when (hasPrintTermGolden pg) $ do - it "uplc" $ - pureGoldenTextFile (goldenFilePath "goldens" name "uplc") $ - multiGolden ps $ \p -> - T.pack $ printTerm p - it "uplc.eval" $ - let evaluateds = flip fmap ps $ \(s, p) -> (s, printTermEvaluated p) - in pureGoldenTextFile (goldenFilePath "goldens" name "uplc.eval") $ - multiGolden evaluateds T.pack - -- Golden test for Plutus benchmarks - when (hasBenchGolden pg) $ - it "bench" $ - pureGoldenTextFile (goldenFilePath "goldens" name "bench") $ - multiGolden ps $ \p -> - TL.toStrict $ Aeson.encodeToLazyText $ benchmarkScript' $ compile p - --- | Get a golden filename prefix from the test description path -getGoldenFilePrefix :: - forall (outers :: [Type]) (inner :: Type). - TestDefM outers inner String -getGoldenFilePrefix = - T.unpack . T.intercalate "." . drop 1 . reverse <$> getTestDescriptionPath - --- | Get the golden file name given the basepath, an optional suffix and a name -goldenFilePath :: FilePath -> String -> String -> FilePath -goldenFilePath base name suffix = - base - (name <> "." <> suffix <> ".golden") - -multiGolden :: forall a. [(String, a)] -> (a -> T.Text) -> Text -multiGolden xs f = - T.intercalate "\n" $ - (\(s, x) -> T.pack s <> " " <> f x) <$> xs diff --git a/plutarch-test/src/Plutarch/TraceSpec.hs b/plutarch-test/src/Plutarch/TraceSpec.hs deleted file mode 100644 index 4b312dcb1..000000000 --- a/plutarch-test/src/Plutarch/TraceSpec.hs +++ /dev/null @@ -1,48 +0,0 @@ -module Plutarch.TraceSpec (spec) where - -import Plutarch.Prelude -import Plutarch.Test - -spec :: Spec -spec = do - describe "trace" . plutarchDevFlagDescribe $ do - describe "ptrace" $ do - let p1 = ptrace "foo" (pcon PUnit) - p2 = ptrace "foo" (ptrace "bar" (pcon PUnit)) - goldens - All - [ ("one", p1) - , ("two", p2) - ] - it "traces one" $ p1 `ptraces` ["foo"] - it "traces two" $ p2 `ptraces` ["foo", "bar"] - describe "ptraceIfTrue" $ do - let p1 = ptraceIfTrue "foo" (pcon PTrue) - p2 = ptraceIfTrue "foo" (pcon PFalse) - goldens - All - [ ("true", p1) - , ("false", p2) - ] - it "true" $ p1 `ptraces` ["foo"] - it "false" $ p2 `ptraces` [] - describe "ptraceIfFalse" $ do - let p1 = ptraceIfFalse "foo" (pcon PTrue) - p2 = ptraceIfFalse "foo" (pcon PFalse) - goldens - All - [ ("true", p1) - , ("false", p2) - ] - it "true" $ p1 `ptraces` [] - it "false" $ p2 `ptraces` ["foo"] - describe "more traces" $ do - it "false.true.false" $ - ptraceIfFalse "foo" (ptraceIfTrue "bar" $ pcon PFalse) - `ptraces` ["foo"] - it "ptrace.true.false" $ - ptrace "foo" (ptraceIfTrue "bar" $ pcon PFalse) - `ptraces` ["foo"] - it "ptrace.true.true" $ - ptrace "foo" (ptraceIfTrue "bar" $ pcon PTrue) - `ptraces` ["foo", "bar"] diff --git a/plutarch-test/src/Plutarch/UnitSpec.hs b/plutarch-test/src/Plutarch/UnitSpec.hs deleted file mode 100644 index 45cc96c98..000000000 --- a/plutarch-test/src/Plutarch/UnitSpec.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Plutarch.UnitSpec (spec) where - -import Plutarch -import Plutarch.Prelude -import Plutarch.Test - -spec :: Spec -spec = do - describe "unit" $ do - describe "pcon" $ do - golden All $ pcon PUnit - describe "pmatch" $ do - let p = pmatch (pcon PUnit) (\case PUnit -> pcon PTrue) - golden All p - it "works" $ passert p - describe "compare" $ do - let pEq = pcon PUnit #== pcon PUnit - pLt = pcon PUnit #< pcon PUnit - pLe = pcon PUnit #<= pcon PUnit - goldens - All - [ ("==", pEq) - , ("<", pLt) - , ("<=", pLe) - ] - it "==" $ passert pEq - it "<" $ passert $ pnot # pLt - it "<=" $ passert pLe diff --git a/plutarch.cabal b/plutarch.cabal index 192d8d27e..54c0e53a0 100644 --- a/plutarch.cabal +++ b/plutarch.cabal @@ -1,14 +1,10 @@ -cabal-version: 2.4 +cabal-version: 3.0 name: plutarch -version: 1.1.0 +version: 1.2.0 author: Las Safin license: MIT extra-source-files: README.md - -flag development - description: Enable tracing functions within plutarch. - manual: True - default: False +tested-with: GHC ==9.2.3 common c default-language: Haskell2010 @@ -16,9 +12,12 @@ common c NoStarIsType BangPatterns BinaryLiterals + BlockArguments ConstrainedClassMethods ConstraintKinds DataKinds + DefaultSignatures + DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable @@ -28,15 +27,14 @@ common c DeriveTraversable DerivingStrategies DerivingVia - DoAndIfThenElse EmptyCase EmptyDataDecls EmptyDataDeriving ExistentialQuantification ExplicitForAll FlexibleContexts - FlexibleInstances ForeignFunctionInterface + FunctionalDependencies GADTSyntax GeneralisedNewtypeDeriving HexFloatLiterals @@ -52,33 +50,39 @@ common c OverloadedStrings PartialTypeSignatures PatternGuards + PatternSynonyms PolyKinds PostfixOperators + QuantifiedConstraints RankNTypes RelaxedPolyRec + RoleAnnotations ScopedTypeVariables StandaloneDeriving StandaloneKindSignatures TraditionalRecordSyntax TupleSections TypeApplications - TypeFamilies + TypeFamilyDependencies TypeOperators TypeSynonymInstances ViewPatterns ghc-options: - -Wall -Wcompat -Wincomplete-uni-patterns -Wno-unused-do-bind - -Wno-partial-type-signatures -Wmissing-export-lists -Werror - -Wincomplete-record-updates -Wmissing-deriving-strategies - -Wno-name-shadowing -Wunused-foralls -fprint-explicit-foralls - -fprint-explicit-kinds + -Weverything -Wno-unused-do-bind -Wno-missing-kind-signatures + -Wno-partial-type-signatures -Werror -Wno-implicit-prelude + -Wno-name-shadowing -Wno-unsafe -Wno-missing-safe-haskell-mode + -Wno-missing-local-signatures -Wno-prepositive-qualified-module + -Wno-missing-import-lists -fprint-explicit-foralls + -fprint-equality-relations -fprint-explicit-kinds + -fprint-explicit-coercions -Wno-all-missed-specializations + -Wno-unrecognised-warning-flags library import: c exposed-modules: Plutarch - Plutarch.Api.Internal.Scripts + Plutarch.Api.Internal.Hashing Plutarch.Api.V1 Plutarch.Api.V1.Address Plutarch.Api.V1.AssocMap @@ -92,6 +96,9 @@ library Plutarch.Api.V1.Tuple Plutarch.Api.V1.Tx Plutarch.Api.V1.Value + Plutarch.Api.V2 + Plutarch.Api.V2.Contexts + Plutarch.Api.V2.Tx Plutarch.Bool Plutarch.Builtin Plutarch.ByteString @@ -100,29 +107,43 @@ library Plutarch.DataRepr.Internal Plutarch.DataRepr.Internal.Field Plutarch.DataRepr.Internal.FromData - Plutarch.DataRepr.Internal.Generic Plutarch.DataRepr.Internal.HList Plutarch.DataRepr.Internal.HList.Utils Plutarch.Either Plutarch.Evaluate + Plutarch.FFI Plutarch.Integer Plutarch.Internal + Plutarch.Internal.Generic + Plutarch.Internal.Newtype Plutarch.Internal.Other Plutarch.Internal.PLam Plutarch.Internal.PlutusType + Plutarch.Internal.Quantification + Plutarch.Internal.ScottEncoding Plutarch.Internal.TypeFamily + Plutarch.Internal.Witness Plutarch.Lift Plutarch.List Plutarch.Maybe Plutarch.Monadic + Plutarch.Num Plutarch.Pair + Plutarch.Positive Plutarch.Prelude + Plutarch.Pretty + Plutarch.Pretty.Internal.BuiltinConstant + Plutarch.Pretty.Internal.Config + Plutarch.Pretty.Internal.Name + Plutarch.Pretty.Internal.TermUtils + Plutarch.Pretty.Internal.Types Plutarch.Rational - Plutarch.Rec - Plutarch.Rec.TH + Plutarch.Reducible + Plutarch.Show Plutarch.String Plutarch.TermCont Plutarch.Trace + Plutarch.TryFrom Plutarch.Unit Plutarch.Unsafe @@ -132,58 +153,17 @@ library , constraints , containers , cryptonite + , data-default , flat , generics-sop - , hashable + , lens , memory , mtl , plutus-core , plutus-ledger-api , plutus-tx - , rank2classes + , prettyprinter + , random , serialise , sop-core - , template-haskell , text - , transformers - - if flag(development) - cpp-options: -DDevelopment - --- Everything below this line is deleted for GHC 8.10 - -test-suite examples - import: c - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: examples - default-extensions: - OverloadedRecordDot - QualifiedDo - - other-modules: - Examples.ConstrData - Examples.LetRec - Examples.Lift - Utils - - build-depends: - , aeson - , base - , bytestring - , generics-sop - , plutarch - , plutus-core - , plutus-ledger-api - , plutus-tx - , rank2classes >=1.4.4 - , serialise - , tasty - , tasty-golden - , tasty-hunit - , text - , transformers - - --, shrinker - if flag(development) - cpp-options: -DDevelopment diff --git a/plutus-bytestring.patch b/plutus-bytestring.patch new file mode 100644 index 000000000..e909dfd9c --- /dev/null +++ b/plutus-bytestring.patch @@ -0,0 +1,22 @@ +From 5671d4906c545a3e37bab5cc6ea355f45fb9adb7 Mon Sep 17 00:00:00 2001 +From: Las Safin +Date: Mon, 18 Apr 2022 16:30:57 +0000 +Subject: [PATCH] plutus-ledger-api: Hide import of `singleton` + +--- + plutus-ledger-api/src/Plutus/V1/Ledger/Api.hs | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/plutus-ledger-api/src/Plutus/V1/Ledger/Api.hs b/plutus-ledger-api/src/Plutus/V1/Ledger/Api.hs +index 31f903444f..f5fe77f97e 100644 +--- a/plutus-ledger-api/src/Plutus/V1/Ledger/Api.hs ++++ b/plutus-ledger-api/src/Plutus/V1/Ledger/Api.hs +@@ -119,7 +119,7 @@ import Control.Monad.Except + import Control.Monad.Writer + import Data.Bifunctor + import Data.ByteString.Lazy (fromStrict) +-import Data.ByteString.Short ++import Data.ByteString.Short hiding (singleton) + import Data.Coerce (coerce) + import Data.Either + import Data.SatInt