From ad249b5a8642e1b81a84549d5f06f90f44c33e21 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 19 Dec 2024 13:48:22 +0200 Subject: [PATCH 1/2] Tests which fail on master --- .../GoldenTests/sorted.cbor.size.golden | 2 +- .../GoldenTests/sorted.large.budget.golden | 2 +- .../Validator/GoldenTests/sorted.pir.golden | 56 +++--- .../GoldenTests/sorted.small.budget.golden | 2 +- .../Validator/GoldenTests/sorted.uplc.golden | 167 ++++++++++-------- .../GoldenTests/unsorted.cbor.size.golden | 2 +- .../GoldenTests/unsorted.large.budget.golden | 2 +- .../Validator/GoldenTests/unsorted.pir.golden | 56 +++--- .../GoldenTests/unsorted.small.budget.golden | 2 +- .../GoldenTests/unsorted.uplc.golden | 124 +++++++------ 10 files changed, 230 insertions(+), 185 deletions(-) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden index 3827a8bde10..0e7b65dcfe3 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden @@ -1 +1 @@ -2132 \ No newline at end of file +2144 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden index 599c961fc12..ea0e30324d6 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 601476171, exBudgetMemory = ExMemory 2971818} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 604948171, exBudgetMemory = ExMemory 2993518} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden index f9cb8fd93bc..3a89a11658f 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden @@ -491,26 +491,30 @@ program Nothing : Maybe a in letrec - !go : list (pair data data) -> List (Tuple2 data data) - = \(l : list (pair data data)) -> - chooseList - {pair data data} - {unit -> List (Tuple2 data data)} - l - (\(ds : unit) -> Nil {Tuple2 data data}) - (\(ds : unit) -> - Cons - {Tuple2 data data} - (let - !p : pair data data = headList {pair data data} l - in - Tuple2 - {data} - {data} - (fstPair {data} {data} p) - (sndPair {data} {data} p)) - (go (tailList {pair data data} l))) - () + ~caseData_go : list (pair data data) -> List (Tuple2 data data) + = (let + a = pair data data + in + /\r -> + \(z : r) (f : a -> list a -> r) (xs : list a) -> + chooseList + {a} + {all dead. r} + xs + (/\dead -> z) + (/\dead -> f (headList {a} xs) (tailList {a} xs)) + {r}) + {List (Tuple2 data data)} + (Nil {Tuple2 data data}) + (\(x : pair data data) (xs : list (pair data data)) -> + Cons + {Tuple2 data data} + (Tuple2 + {data} + {data} + (fstPair {data} {data} x) + (sndPair {data} {data} x)) + (caseData_go xs)) in let !fun : List (Tuple2 data data) -> Bool @@ -5329,11 +5333,13 @@ program (/\dead -> Just {List (Tuple2 data data)} - (go - (unMapData - (headList - {data} - (tailList {data} (sndPair {integer} {list data} ds)))))) + (let + !d : data + = headList + {data} + (tailList {data} (sndPair {integer} {list data} ds)) + in + caseData_go (unMapData d))) (/\dead -> Bool_match (ifThenElse {Bool} (equalsInteger 2 x) True False) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden index b4f2588f1b2..dae76885acc 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 91525157, exBudgetMemory = ExMemory 413605} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 91749157, exBudgetMemory = ExMemory 415005} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden index fc56140d431..a60c0e68235 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden @@ -10,7 +10,7 @@ program (\validateParamValue -> (\validateParamValues -> (\runRules -> - (\go -> + (\caseData_go -> (\cse -> (\cse -> (\cse -> @@ -56,16 +56,19 @@ program (delay (delay (constr 0 - [ (go - (unMapData + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList (force - headList + tailList (force - tailList (force - (force - sndPair) - cse))))) ]))) + sndPair) + cse)))) ]))) (delay (delay (force @@ -742,18 +745,7 @@ program (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 3 [ (constr 1 [ cse @@ -769,7 +761,18 @@ program (constr 3 [ (constr 1 [ cse - , cse ]) ])) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 3 [ (constr 1 @@ -790,7 +793,8 @@ program , (constr 1 [ cse , (constr 1 - [ cse + [ (cse + 10) , (constr 0 [ ]) ]) ]) ]) , (constr 0 @@ -808,8 +812,7 @@ program [ (constr 1 [ ]) , (constr 1 - [ (cse - 10) + [ cse , cse ]) ])) (constr 1 [ (constr 0 @@ -835,71 +838,83 @@ program , (constr 0 [ ]) ])) (constr 1 - [ (cse - 4) + [ cse , (constr 0 [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + [ cse , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (cse + 4) , (constr 0 [ ]) ])) - (cse - 2)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (cse - 100)) - (cse - 1)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (cse 5)) - (constr 0 - [ (constr 1 - []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 1)) - (cse 10)) - (unsafeRatio 4)) - (unsafeRatio 0)) - (unsafeRatio 3)) - (unsafeRatio 9)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 1)) - (unsafeRatio 51)) + 5)) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 1)) + (cse 2)) + (cse 10)) + (cse 100)) + (cse 1)) + (unsafeRatio 51)) + (unsafeRatio 3)) + (unsafeRatio 0)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 9)) + (unsafeRatio 4)) + (unsafeRatio 1)) (fix1 - (\go l -> - force (force chooseList) - l - (\ds -> constr 0 []) - (\ds -> - constr 1 - [ ((\p -> - constr 0 - [ (force (force fstPair) - p) - , (force (force sndPair) - p) ]) - (force headList l)) - , (go (force tailList l)) ]) - ()))) + (\caseData_go arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x xs -> + constr 1 + [ (constr 0 + [ (force + (force + fstPair) + x) + , (force + (force + sndPair) + x) ]) + , (force + (caseData_go + (delay + (\x -> + x))) + xs) ]) + (force headList xs) + (force tailList + xs)))))) + (delay (\x -> x)))) (fix1 (\runRules ds cparams -> force diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden index bc29fcae9c2..fa95f75a6f8 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden @@ -1 +1 @@ -2127 \ No newline at end of file +2139 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden index 3742ab98948..21778ed1a59 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 960426341, exBudgetMemory = ExMemory 4867088} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 963898341, exBudgetMemory = ExMemory 4888788} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden index d3676b47593..55d72d55a41 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden @@ -423,26 +423,30 @@ program Nothing : Maybe a in letrec - !go : list (pair data data) -> List (Tuple2 data data) - = \(l : list (pair data data)) -> - chooseList - {pair data data} - {unit -> List (Tuple2 data data)} - l - (\(ds : unit) -> Nil {Tuple2 data data}) - (\(ds : unit) -> - Cons - {Tuple2 data data} - (let - !p : pair data data = headList {pair data data} l - in - Tuple2 - {data} - {data} - (fstPair {data} {data} p) - (sndPair {data} {data} p)) - (go (tailList {pair data data} l))) - () + ~caseData_go : list (pair data data) -> List (Tuple2 data data) + = (let + a = pair data data + in + /\r -> + \(z : r) (f : a -> list a -> r) (xs : list a) -> + chooseList + {a} + {all dead. r} + xs + (/\dead -> z) + (/\dead -> f (headList {a} xs) (tailList {a} xs)) + {r}) + {List (Tuple2 data data)} + (Nil {Tuple2 data data}) + (\(x : pair data data) (xs : list (pair data data)) -> + Cons + {Tuple2 data data} + (Tuple2 + {data} + {data} + (fstPair {data} {data} x) + (sndPair {data} {data} x)) + (caseData_go xs)) in let !cfg : List (Tuple2 integer ParamValue) @@ -5263,11 +5267,13 @@ program (/\dead -> Just {List (Tuple2 data data)} - (go - (unMapData - (headList - {data} - (tailList {data} (sndPair {integer} {list data} ds)))))) + (let + !d : data + = headList + {data} + (tailList {data} (sndPair {integer} {list data} ds)) + in + caseData_go (unMapData d))) (/\dead -> Bool_match (ifThenElse {Bool} (equalsInteger 2 x) True False) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden index 3f487d3f64f..06ca3589258 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 89279267, exBudgetMemory = ExMemory 402103} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 89503267, exBudgetMemory = ExMemory 403503} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden index a2502224c04..aa9ab75018b 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden @@ -10,7 +10,7 @@ program (\cse -> (\validateParamValue -> (\validateParamValues -> - (\go -> + (\caseData_go -> (\cse -> (\cse -> (\cse -> @@ -58,16 +58,19 @@ program (delay (delay (constr 0 - [ (go - (unMapData + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList (force - headList + tailList (force - tailList (force - (force - sndPair) - cse))))) ]))) + sndPair) + cse)))) ]))) (delay (delay (force @@ -812,7 +815,10 @@ program [ ]) , (constr 1 [ cse - , cse ]) ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ]) ]) ])) (constr 3 @@ -824,10 +830,7 @@ program [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ]) ]) ])) (constr 1 @@ -850,7 +853,8 @@ program , (constr 1 [ cse , (constr 1 - [ cse + [ (cse + 10) , (constr 0 [ ]) ]) ]) ]) , (constr 0 @@ -860,16 +864,16 @@ program [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 [ cse - , cse ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 [ (constr 0 @@ -912,53 +916,67 @@ program , (constr 0 [ ]) ])) (constr 1 - [ (cse - 1) + [ cse , (constr 0 [ ]) ])) (cse - 10)) + 2)) (cse - 10)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) + 1)) + (cse + 5)) (cse - 5)) - (cse 2)) - (cse 100)) - (cse 1)) + 100)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (cse 4)) + (cse 10)) (constr 0 [ (constr 1 []) , (constr 1 [ 1 , (constr 0 [ ]) ]) ])) - (cse 4)) - (unsafeRatio 9)) - (unsafeRatio 3)) - (unsafeRatio 1)) - (unsafeRatio 0)) - (unsafeRatio 4)) - (unsafeRatio 51)) + (cse 1)) + (unsafeRatio 1)) + (unsafeRatio 51)) + (unsafeRatio 0)) + (unsafeRatio 4)) + (unsafeRatio 9)) + (unsafeRatio 3)) (constr 1 [0, (constr 0 [])])) (fix1 - (\go l -> - force (force chooseList) - l - (\ds -> constr 0 []) - (\ds -> - constr 1 - [ ((\p -> - constr 0 - [ (force (force fstPair) - p) - , (force (force sndPair) - p) ]) - (force headList l)) - , (go (force tailList l)) ]) - ()))) + (\caseData_go arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x xs -> + constr 1 + [ (constr 0 + [ (force + (force + fstPair) + x) + , (force + (force + sndPair) + x) ]) + , (force + (caseData_go + (delay + (\x -> + x))) + xs) ]) + (force headList xs) + (force tailList + xs)))))) + (delay (\x -> x)))) (cse (\arg_0 arg_1 -> arg_1))) (cse (\arg_0 arg_1 -> arg_0))) (force From 57e74cd66bd32efdf671f40b987862b8bc596825 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Fri, 20 Dec 2024 12:35:23 +0200 Subject: [PATCH 2/2] Use data-backed SC --- .../Cardano/Constitution/Validator/Common.hs | 47 +- .../Constitution/Validator/GoldenTests.hs | 2 +- .../GoldenTests/sorted.cbor.size.golden | 2 +- .../GoldenTests/sorted.large.budget.golden | 2 +- .../Validator/GoldenTests/sorted.pir.golden | 249 ++- .../GoldenTests/sorted.small.budget.golden | 2 +- .../Validator/GoldenTests/sorted.uplc.golden | 1808 ++++++++-------- .../GoldenTests/unsorted.cbor.size.golden | 2 +- .../GoldenTests/unsorted.large.budget.golden | 2 +- .../Validator/GoldenTests/unsorted.pir.golden | 249 ++- .../GoldenTests/unsorted.small.budget.golden | 2 +- .../GoldenTests/unsorted.uplc.golden | 1871 +++++++++-------- .../Constitution/Validator/PropTests.hs | 2 +- .../Constitution/Validator/TestsCommon.hs | 2 +- cardano-constitution/test/Helpers/CekTests.hs | 21 +- .../src/PlutusLedgerApi/Data/V3.hs | 3 + plutus-tx/src/PlutusTx/Data/AssocMap.hs | 21 + 17 files changed, 2421 insertions(+), 1866 deletions(-) diff --git a/cardano-constitution/src/Cardano/Constitution/Validator/Common.hs b/cardano-constitution/src/Cardano/Constitution/Validator/Common.hs index 40b7f9ca979..a97f88eaafa 100644 --- a/cardano-constitution/src/Cardano/Constitution/Validator/Common.hs +++ b/cardano-constitution/src/Cardano/Constitution/Validator/Common.hs @@ -16,13 +16,14 @@ import Control.Category hiding ((.)) import Cardano.Constitution.Config import Data.Coerce -import PlutusLedgerApi.V3 as V3 +import PlutusLedgerApi.Data.V3 import PlutusTx.Builtins qualified as B import PlutusTx.Builtins.Internal qualified as BI +import PlutusTx.Data.AssocMap import PlutusTx.NonCanonicalRational as NCRatio import PlutusTx.Prelude as Tx hiding (toList) -type ConstitutionValidator = BuiltinData -- ^ ScriptContext, deep inside is the changed-parameters proposal +type ConstitutionValidator = ScriptContext -- ^ ScriptContext, deep inside is the changed-parameters proposal -> BuiltinUnit -- ^ No-error means the proposal conforms to the constitution -- OPTIMIZE: operate on BuiltinList directly, needs major refactoring of sorted&unsorted Validators @@ -70,37 +71,13 @@ validateParamValue = \case meaningWithActual = (`meaning` actualValue) {-# INLINABLE validateParamValue #-} -scriptContextToValidGovAction :: BuiltinData -> Maybe ChangedParams -scriptContextToValidGovAction = scriptContextToScriptInfo - >>> scriptInfoToProposalProcedure - >>> proposalProcedureToGovernanceAction - >>> governanceActionToValidGovAction - where - scriptContextToScriptInfo :: BuiltinData -> BuiltinData -- aka ScriptContext -> ScriptInfo - scriptContextToScriptInfo = BI.unsafeDataAsConstr - >>> BI.snd - >>> BI.tail - >>> BI.tail - >>> BI.head - - scriptInfoToProposalProcedure :: BuiltinData -> BuiltinData - scriptInfoToProposalProcedure (BI.unsafeDataAsConstr -> si) = - if BI.fst si `B.equalsInteger` 5 -- Constructor Index of `ProposingScript` - then BI.head (BI.tail (BI.snd si)) - else traceError "Not a ProposalProcedure. This should not ever happen, because ledger should guard before, against it." - - proposalProcedureToGovernanceAction :: BuiltinData -> BuiltinData - proposalProcedureToGovernanceAction = BI.unsafeDataAsConstr - >>> BI.snd - >>> BI.tail - >>> BI.tail - >>> BI.head - - governanceActionToValidGovAction :: BuiltinData -> Maybe ChangedParams - governanceActionToValidGovAction (BI.unsafeDataAsConstr -> govAction@(BI.fst -> govActionConstr)) - -- Constructor Index of `ChangedParams` is 0 - | govActionConstr `B.equalsInteger` 0 = Just (B.unsafeDataAsMap (BI.head (BI.tail (BI.snd govAction)))) - -- Constructor Index of `TreasuryWithdrawals` is 2 - | govActionConstr `B.equalsInteger` 2 = Nothing -- means treasurywithdrawal - | otherwise = traceError "Not a ChangedParams or TreasuryWithdrawals. This should not ever happen, because ledger should guard before, against it." +scriptContextToValidGovAction :: ScriptContext -> Maybe ChangedParams +scriptContextToValidGovAction ScriptContext {scriptContextScriptInfo = scriptInfo} = + case scriptInfo of + ProposingScript _ ProposalProcedure { ppGovernanceAction = ppGovAct } -> + case ppGovAct of + ParameterChange _ cparams _ -> Just (B.unsafeDataAsMap . toBuiltinData $ cparams) + TreasuryWithdrawals _ _ -> Nothing + _ -> traceError "Not a ChangedParams or TreasuryWithdrawals. This should not ever happen, because ledger should guard before, against it." + _ -> Nothing {-# INLINABLE scriptContextToValidGovAction #-} diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs index 8e7572ec59b..9409435205e 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs @@ -85,7 +85,7 @@ runForBudget :: (ToData ctx) -> ExBudget runForBudget v ctx = let vPs = UPLC._progTerm $ getPlcNoAnn $ v - `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + `unsafeApplyCode` liftCode110 (unsafeFromBuiltinData $ toBuiltinData ctx) in case UPLC.runCekDeBruijn defaultCekParametersForTesting counting noEmitter vPs of -- Here, we guard against the case that a ConstitutionValidator **FAILS EARLY** (for some reason), -- resulting in misleading low budget costs. diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden index 0e7b65dcfe3..583f9c4ebef 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.cbor.size.golden @@ -1 +1 @@ -2144 \ No newline at end of file +2331 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden index ea0e30324d6..2b725aee0c5 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 604948171, exBudgetMemory = ExMemory 2993518} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 610315640, exBudgetMemory = ExMemory 3014402} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden index 3a89a11658f..96e9001a514 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden @@ -489,6 +489,28 @@ program data (Maybe :: * -> *) a | Maybe_match where Just : a -> Maybe a Nothing : Maybe a + !`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` : + all a. (\a -> data -> a) a -> data -> Maybe a + = /\a -> + \(`$dUnsafeFromData` : (\a -> data -> a) a) (d : data) -> + let + !tup : pair integer (list data) = unConstrData d + !index : integer = fstPair {integer} {list data} tup + !args : list data = sndPair {integer} {list data} tup + in + Bool_match + (ifThenElse {Bool} (equalsInteger 1 index) True False) + {all dead. Maybe a} + (/\dead -> Nothing {a}) + (/\dead -> + Bool_match + (ifThenElse {Bool} (equalsInteger 0 index) True False) + {all dead. Maybe a} + (/\dead -> + Just {a} (`$dUnsafeFromData` (headList {data} args))) + (/\dead -> error {Maybe a}) + {all dead. dead}) + {all dead. dead} in letrec ~caseData_go : list (pair data data) -> List (Tuple2 data data) @@ -5281,73 +5303,184 @@ program \(ds : data) -> Maybe_match {List (Tuple2 data data)} - (let - !ds : data - = headList - {data} - (tailList - {data} - (tailList - {data} - (sndPair - {integer} - {list data} - (unConstrData - (let - !ds : data - = headList - {data} - (tailList - {data} - (tailList - {data} - (sndPair - {integer} - {list data} - (unConstrData ds)))) - ~si : pair integer (list data) = unConstrData ds + ((let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : data -> data -> data -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut + in + Bool_match + (ifThenElse + {Bool} + (equalsInteger 0 (fstPair {integer} {list data} tup)) + True + False) + {all dead. r} + (/\dead -> + let + !l : list data = sndPair {integer} {list data} tup + !l : list data = tailList {data} l + in + cont + (headList {data} l) + (headList {data} l) + (headList {data} (tailList {data} l))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : data) (ds : data) (ds : data) -> + (let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : integer -> data -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut + in + Bool_match + (ifThenElse + {Bool} + (equalsInteger 5 (fstPair {integer} {list data} tup)) + True + False) + {all dead. r} + (/\dead -> + let + !l : list data = sndPair {integer} {list data} tup + in + cont + (unIData (headList {data} l)) + (headList {data} (tailList {data} l))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : integer) (ds : data) -> + (let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : integer -> data -> data -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut + in + Bool_match + (ifThenElse + {Bool} + (equalsInteger 0 (fstPair {integer} {list data} tup)) + True + False) + {all dead. r} + (/\dead -> + let + !l : list data = sndPair {integer} {list data} tup + !l : list data = tailList {data} l + in + cont + (unIData (headList {data} l)) + (headList {data} l) + (headList {data} (tailList {data} l))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : integer) (ds : data) (ds : data) -> + (let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : Maybe data -> data -> Maybe bytestring -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut in Bool_match (ifThenElse {Bool} (equalsInteger - 5 - (fstPair {integer} {list data} si)) + 0 + (fstPair {integer} {list data} tup)) True False) - {all dead. data} + {all dead. r} (/\dead -> - headList - {data} - (tailList + let + !l : list data + = sndPair {integer} {list data} tup + !l : list data = tailList {data} l + in + cont + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` {data} - (sndPair {integer} {list data} si))) - (/\dead -> error {data}) - {all dead. dead}))))) - ~ds : pair integer (list data) = unConstrData ds - !x : integer = fstPair {integer} {list data} ds - in - Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) - {all dead. Maybe (List (Tuple2 data data))} - (/\dead -> - Just - {List (Tuple2 data data)} - (let - !d : data - = headList - {data} - (tailList {data} (sndPair {integer} {list data} ds)) - in - caseData_go (unMapData d))) - (/\dead -> - Bool_match - (ifThenElse {Bool} (equalsInteger 2 x) True False) - {all dead. Maybe (List (Tuple2 data data))} - (/\dead -> Nothing {List (Tuple2 data data)}) - (/\dead -> error {Maybe (List (Tuple2 data data))}) - {all dead. dead}) - {all dead. dead}) + (\(d : data) -> d) + (headList {data} l)) + (headList {data} l) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + {bytestring} + unBData + (headList {data} (tailList {data} l)))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : Maybe data) + (cparams : data) + (ds : Maybe bytestring) -> + Just + {List (Tuple2 data data)} + (caseData_go (unMapData cparams))) + (\(void : unit) -> + (let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : + (\k a -> list (pair data data)) data integer -> + Maybe bytestring -> + r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) + = unConstrData scrut + in + Bool_match + (ifThenElse + {Bool} + (equalsInteger + 2 + (fstPair {integer} {list data} tup)) + True + False) + {all dead. r} + (/\dead -> + let + !l : list data + = sndPair {integer} {list data} tup + in + cont + (unMapData (headList {data} l)) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + {bytestring} + unBData + (headList {data} (tailList {data} l)))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : + (\k a -> list (pair data data)) data integer) + (ds : Maybe bytestring) -> + Nothing {List (Tuple2 data data)}) + (\(void : unit) -> + error {Maybe (List (Tuple2 data data))}))) + (\(void : unit) -> Nothing {List (Tuple2 data data)})) + (\(void : unit) -> Nothing {List (Tuple2 data data)})) + (\(void : unit) -> + Unit_match + (error {Unit}) + {Maybe (List (Tuple2 data data))} + (error {Maybe (List (Tuple2 data data))}))) {all dead. unit} (\(cparams : List (Tuple2 data data)) -> /\dead -> diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden index dae76885acc..0e7c1d8f90a 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 91749157, exBudgetMemory = ExMemory 415005} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 97116626, exBudgetMemory = ExMemory 435889} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden index a60c0e68235..7790747aea3 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden @@ -10,8 +10,8 @@ program (\validateParamValue -> (\validateParamValues -> (\runRules -> - (\caseData_go -> - (\cse -> + (\`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` -> + (\caseData_go -> (\cse -> (\cse -> (\cse -> @@ -40,881 +40,1027 @@ program (\cse -> (\cse -> (\cse -> - (\fun - ds -> - force - (case - ((\cse -> - (\x -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - x) - (delay - (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList - (force - tailList - (force - (force - sndPair) - cse)))) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - error)))))))))) - (force - (force - fstPair) - cse)) - (unConstrData - (force - headList - (force - tailList - (force - tailList + (\cse -> + (\cse -> + (\cse -> + (\fun + ds -> + force + (case + ((\tup -> + force (force (force - sndPair) - (unConstrData - ((\cse -> - force + ifThenElse + (equalsInteger + 0 + (force (force - (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - cse)) - (delay - (delay - (force - headList + fstPair) + tup)) + (delay + (delay + ((\l -> + (\l -> + (\ds + ds -> + (\tup -> + force (force - tailList (force - (force - sndPair) - cse))))) - (delay - (delay - error))))) - (unConstrData - (force - headList - (force - tailList + ifThenElse + (equalsInteger + 5 + (force + (force + fstPair) + tup)) + (delay + (delay + ((\l -> + (\ds -> + (\tup -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + (force + (force + fstPair) + tup)) + (delay + (delay + ((\l -> + (\l -> + (\ds + ds -> + (\cse -> + (\cse -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + cse) + (delay + (delay + ((\l -> + (\l -> + (\ds + cparams + ds -> + constr 0 + [ (force + caseData_go + (unMapData + cparams)) ]) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + (\d -> + d) + (force + headList + l)) + (force + headList + l) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + unBData + (force + headList + (force + tailList + l)))) + (force + tailList + l)) + (force + (force + sndPair) + cse)))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 2 + cse) + (delay + (delay + ((\l -> + (\ds + ds -> + constr 1 + [ ]) + (unMapData + (force + headList + l)) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + unBData + (force + headList + (force + tailList + l)))) + (force + (force + sndPair) + cse)))) + (delay + (delay + error)))))))))) + (force + (force + fstPair) + cse)) + (unConstrData + (force + headList + (force + tailList + l)))) + (unIData + (force + headList + l)) + (force + headList + l)) + (force + tailList + l)) + (force + (force + sndPair) + tup)))) + (delay + (delay + (constr 1 + [ ])))))) + (unConstrData + (force + headList + (force + tailList + l)))) + (unIData + (force + headList + l))) + (force + (force + sndPair) + tup)))) + (delay + (delay + (constr 1 + [ ])))))) + (unConstrData + (force + headList + (force + tailList + l)))) + (force + headList + l) + (force + headList + l)) (force tailList - (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - (runRules - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + l)) + (force + (force + sndPair) + tup)))) + (delay + (delay + (case + error + [ error ])))))) + (unConstrData + ds)) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse , (constr 1 [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + [ ]) , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) - (constr 3 - [ (constr 1 - [ cse - , cse ]) ])) - (constr 3 - [ (constr 1 - [ cse + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse + , cse ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 3 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 0 [ (constr 1 + [ ]) + , (constr 1 [ cse , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ cse , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) (constr 1 [ (constr 0 [ (constr 0 [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (cse - 10) - , (constr 0 - [ ]) ]) ]) ]) + , cse ]) , (constr 0 [ ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 - [ cse + [ 0 , (constr 1 - [ cse + [ 1000000 , (constr 0 [ ]) ]) ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) (constr 1 [ (constr 0 [ (constr 0 [ ]) - , cse ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) + [ cse , (constr 0 [ ]) ])) (constr 1 [ cse , (constr 0 [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ (cse - 4) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) + (cse + 2)) + (cse + 1)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (cse + 100)) (cse 5)) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 1)) - (cse 2)) - (cse 10)) - (cse 100)) - (cse 1)) - (unsafeRatio 51)) - (unsafeRatio 3)) - (unsafeRatio 0)) - (constr 1 [0, (constr 0 [])])) + (cse + 10)) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 10)) + (cse 4)) + (cse 1)) + (unsafeRatio 4)) + (unsafeRatio 0)) + (unsafeRatio 51)) + (unsafeRatio 3)) + (unsafeRatio 1)) (unsafeRatio 9)) - (unsafeRatio 4)) - (unsafeRatio 1)) - (fix1 - (\caseData_go arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\x xs -> - constr 1 - [ (constr 0 - [ (force - (force - fstPair) - x) - , (force - (force - sndPair) - x) ]) - , (force - (caseData_go - (delay - (\x -> - x))) - xs) ]) - (force headList xs) - (force tailList - xs)))))) - (delay (\x -> x)))) + (constr 1 [0, (constr 0 [])])) + (fix1 + (\caseData_go arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x xs -> + constr 1 + [ (constr 0 + [ (force + (force + fstPair) + x) + , (force + (force + sndPair) + x) ]) + , (force + (caseData_go + (delay + (\x -> + x))) + xs) ]) + (force headList xs) + (force tailList + xs)))))) + (delay (\x -> x)))) + (\`$dUnsafeFromData` d -> + (\tup -> + (\index -> + (\args -> + force + (force + (force ifThenElse + (equalsInteger 1 index) + (delay + (delay (constr 1 []))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (delay + (constr 0 + [ (`$dUnsafeFromData` + (force + headList + args)) ]))) + (delay + (delay + error)))))))))) + (force (force sndPair) tup)) + (force (force fstPair) tup)) + (unConstrData d))) (fix1 (\runRules ds cparams -> force diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden index fa95f75a6f8..9e7afa3a473 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.cbor.size.golden @@ -1 +1 @@ -2139 \ No newline at end of file +2313 \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden index 21778ed1a59..16326914a45 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.large.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 963898341, exBudgetMemory = ExMemory 4888788} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 969025810, exBudgetMemory = ExMemory 4908172} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden index 55d72d55a41..54b0e42afbc 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden @@ -421,6 +421,28 @@ program data (Maybe :: * -> *) a | Maybe_match where Just : a -> Maybe a Nothing : Maybe a + !`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` : + all a. (\a -> data -> a) a -> data -> Maybe a + = /\a -> + \(`$dUnsafeFromData` : (\a -> data -> a) a) (d : data) -> + let + !tup : pair integer (list data) = unConstrData d + !index : integer = fstPair {integer} {list data} tup + !args : list data = sndPair {integer} {list data} tup + in + Bool_match + (ifThenElse {Bool} (equalsInteger 1 index) True False) + {all dead. Maybe a} + (/\dead -> Nothing {a}) + (/\dead -> + Bool_match + (ifThenElse {Bool} (equalsInteger 0 index) True False) + {all dead. Maybe a} + (/\dead -> + Just {a} (`$dUnsafeFromData` (headList {data} args))) + (/\dead -> error {Maybe a}) + {all dead. dead}) + {all dead. dead} in letrec ~caseData_go : list (pair data data) -> List (Tuple2 data data) @@ -5215,73 +5237,184 @@ program \(ds : data) -> Maybe_match {List (Tuple2 data data)} - (let - !ds : data - = headList - {data} - (tailList - {data} - (tailList - {data} - (sndPair - {integer} - {list data} - (unConstrData - (let - !ds : data - = headList - {data} - (tailList - {data} - (tailList - {data} - (sndPair - {integer} - {list data} - (unConstrData ds)))) - ~si : pair integer (list data) = unConstrData ds + ((let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : data -> data -> data -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut + in + Bool_match + (ifThenElse + {Bool} + (equalsInteger 0 (fstPair {integer} {list data} tup)) + True + False) + {all dead. r} + (/\dead -> + let + !l : list data = sndPair {integer} {list data} tup + !l : list data = tailList {data} l + in + cont + (headList {data} l) + (headList {data} l) + (headList {data} (tailList {data} l))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : data) (ds : data) (ds : data) -> + (let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : integer -> data -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut + in + Bool_match + (ifThenElse + {Bool} + (equalsInteger 5 (fstPair {integer} {list data} tup)) + True + False) + {all dead. r} + (/\dead -> + let + !l : list data = sndPair {integer} {list data} tup + in + cont + (unIData (headList {data} l)) + (headList {data} (tailList {data} l))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : integer) (ds : data) -> + (let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : integer -> data -> data -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut + in + Bool_match + (ifThenElse + {Bool} + (equalsInteger 0 (fstPair {integer} {list data} tup)) + True + False) + {all dead. r} + (/\dead -> + let + !l : list data = sndPair {integer} {list data} tup + !l : list data = tailList {data} l + in + cont + (unIData (headList {data} l)) + (headList {data} l) + (headList {data} (tailList {data} l))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : integer) (ds : data) (ds : data) -> + (let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : Maybe data -> data -> Maybe bytestring -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut in Bool_match (ifThenElse {Bool} (equalsInteger - 5 - (fstPair {integer} {list data} si)) + 0 + (fstPair {integer} {list data} tup)) True False) - {all dead. data} + {all dead. r} (/\dead -> - headList - {data} - (tailList + let + !l : list data + = sndPair {integer} {list data} tup + !l : list data = tailList {data} l + in + cont + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` {data} - (sndPair {integer} {list data} si))) - (/\dead -> error {data}) - {all dead. dead}))))) - ~ds : pair integer (list data) = unConstrData ds - !x : integer = fstPair {integer} {list data} ds - in - Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) - {all dead. Maybe (List (Tuple2 data data))} - (/\dead -> - Just - {List (Tuple2 data data)} - (let - !d : data - = headList - {data} - (tailList {data} (sndPair {integer} {list data} ds)) - in - caseData_go (unMapData d))) - (/\dead -> - Bool_match - (ifThenElse {Bool} (equalsInteger 2 x) True False) - {all dead. Maybe (List (Tuple2 data data))} - (/\dead -> Nothing {List (Tuple2 data data)}) - (/\dead -> error {Maybe (List (Tuple2 data data))}) - {all dead. dead}) - {all dead. dead}) + (\(d : data) -> d) + (headList {data} l)) + (headList {data} l) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + {bytestring} + unBData + (headList {data} (tailList {data} l)))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : Maybe data) + (cparams : data) + (ds : Maybe bytestring) -> + Just + {List (Tuple2 data data)} + (caseData_go (unMapData cparams))) + (\(void : unit) -> + (let + r = Maybe (List (Tuple2 data data)) + in + \(scrut : data) + (cont : + (\k a -> list (pair data data)) data integer -> + Maybe bytestring -> + r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) + = unConstrData scrut + in + Bool_match + (ifThenElse + {Bool} + (equalsInteger + 2 + (fstPair {integer} {list data} tup)) + True + False) + {all dead. r} + (/\dead -> + let + !l : list data + = sndPair {integer} {list data} tup + in + cont + (unMapData (headList {data} l)) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + {bytestring} + unBData + (headList {data} (tailList {data} l)))) + (/\dead -> fail ()) + {all dead. dead}) + ds + (\(ds : + (\k a -> list (pair data data)) data integer) + (ds : Maybe bytestring) -> + Nothing {List (Tuple2 data data)}) + (\(void : unit) -> + error {Maybe (List (Tuple2 data data))}))) + (\(void : unit) -> Nothing {List (Tuple2 data data)})) + (\(void : unit) -> Nothing {List (Tuple2 data data)})) + (\(void : unit) -> + Unit_match + (error {Unit}) + {Maybe (List (Tuple2 data data))} + (error {Maybe (List (Tuple2 data data))}))) {all dead. unit} (\(cparams : List (Tuple2 data data)) -> /\dead -> diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden index 06ca3589258..7772890a84b 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.small.budget.golden @@ -1 +1 @@ -ExBudget {exBudgetCPU = ExCPU 89503267, exBudgetMemory = ExMemory 403503} \ No newline at end of file +ExBudget {exBudgetCPU = ExCPU 94630736, exBudgetMemory = ExMemory 422887} \ No newline at end of file diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden index aa9ab75018b..5d473c19921 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden @@ -10,8 +10,8 @@ program (\cse -> (\validateParamValue -> (\validateParamValues -> - (\caseData_go -> - (\cse -> + (\`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` -> + (\caseData_go -> (\cse -> (\cse -> (\cse -> @@ -39,70 +39,29 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\cse -> - (\x -> - force + (\cfg -> + (\fun + ds -> + force + (case + ((\tup -> + force + (force + (force + ifThenElse + (equalsInteger + 0 (force (force - ifThenElse - (equalsInteger - 0 - x) - (delay - (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList - (force - tailList - (force - (force - sndPair) - cse)))) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - error)))))))))) - (force - (force - fstPair) - cse)) - (unConstrData - (force - headList - (force - tailList - (force - tailList - (force - (force - sndPair) - (unConstrData - ((\cse -> + fstPair) + tup)) + (delay + (delay + ((\l -> + (\l -> + (\ds + ds -> + (\tup -> force (force (force @@ -112,715 +71,842 @@ program (force (force fstPair) - cse)) + tup)) (delay (delay - (force - headList + ((\l -> + (\ds -> + (\tup -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + (force + (force + fstPair) + tup)) + (delay + (delay + ((\l -> + (\l -> + (\ds + ds -> + (\cse -> + (\cse -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + cse) + (delay + (delay + ((\l -> + (\l -> + (\ds + cparams + ds -> + constr 0 + [ (force + caseData_go + (unMapData + cparams)) ]) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + (\d -> + d) + (force + headList + l)) + (force + headList + l) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + unBData + (force + headList + (force + tailList + l)))) + (force + tailList + l)) + (force + (force + sndPair) + cse)))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 2 + cse) + (delay + (delay + ((\l -> + (\ds + ds -> + constr 1 + [ ]) + (unMapData + (force + headList + l)) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + unBData + (force + headList + (force + tailList + l)))) + (force + (force + sndPair) + cse)))) + (delay + (delay + error)))))))))) + (force + (force + fstPair) + cse)) + (unConstrData + (force + headList + (force + tailList + l)))) + (unIData + (force + headList + l)) + (force + headList + l)) + (force + tailList + l)) + (force + (force + sndPair) + tup)))) + (delay + (delay + (constr 1 + [ ])))))) + (unConstrData + (force + headList + (force + tailList + l)))) + (unIData + (force + headList + l))) (force - tailList (force - (force - sndPair) - cse))))) + sndPair) + tup)))) (delay (delay - error))))) + (constr 1 + [ ])))))) (unConstrData (force headList (force tailList - (force - tailList - (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - ((\go - eta -> - go - eta) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay - (constr 0 - [ ])) - , (\x - xs -> - delay + l)))) + (force + headList + l) + (force + headList + l)) + (force + tailList + l)) (force - (case - (case - x - [ (\ds - actualValueData -> - validateParamValue - ((\k -> - fix1 - (\go - ds -> - force - (case - ds - [ (delay - error) - , (\ds - xs' -> - delay - (case - ds - [ (\k' - i -> - force - (case - (equalsInteger - k - k') - [ (delay - i) - , (delay - (go - xs')) ])) ])) ]))) - (unIData - ds) - cfg) - actualValueData) ]) - [ (delay - (go - xs)) - , (delay - (constr 1 - [ ])) ]))) ]))))) - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 13 - 20) - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , cse ]) ])) - (constr 3 - [ (constr 1 - [ cse + (force + sndPair) + tup)))) + (delay + (delay + (case + error + [ error ])))))) + (unConstrData + ds)) + [ (\cparams -> + delay + (force + (case + (fun + cparams) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go + eta -> + go + eta) + (fix1 + (\go + ds -> + force + (case + ds + [ (delay + (constr 0 + [ ])) + , (\x + xs -> + delay + (force + (case + (case + x + [ (\ds + actualValueData -> + validateParamValue + ((\k -> + fix1 + (\go + ds -> + force + (case + ds + [ (delay + error) + , (\ds + xs' -> + delay + (case + ds + [ (\k' + i -> + force + (case + (equalsInteger + k + k') + [ (delay + i) + , (delay + (go + xs')) ])) ])) ]))) + (unIData + ds) + cfg) + actualValueData) ]) + [ (delay + (go + xs)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 , (constr 1 - [ (constr 0 + [ (constr 1 [ (constr 0 - [ ]) + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse ]) ]) , (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse ]) ]) , (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse ]) ]) + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 1000) + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse + , cse ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , cse ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 13 + 20) + , (constr 0 + [ ]) ]) ]) ]) + , cse ]) ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , cse ]) ]) + , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , cse ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (unsafeRatio + 1000 + 1) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse @@ -830,153 +916,200 @@ program [ ]) , (constr 1 [ cse - , cse ]) ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 + (constr 3 + [ (constr 1 + [ cse + , (constr 1 [ (constr 0 - [ (constr 1 + [ (constr 0 [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (cse - 10) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse + , cse ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) + , cse ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) , (constr 1 [ cse - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse + 10) + , cse ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 - [ 0 + [ cse , (constr 1 - [ 1000000 + [ cse , (constr 0 [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 2 + [ (constr 0 [ ]) , cse ]) , (constr 0 [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 2 [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 [ cse , (constr 0 [ ]) ])) - (cse - 2)) - (cse - 1)) - (cse - 5)) - (cse - 100)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (cse 4)) - (cse 10)) - (constr 0 - [ (constr 1 []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 1)) - (unsafeRatio 1)) - (unsafeRatio 51)) - (unsafeRatio 0)) + (constr 1 + [ (cse + 4) + , (constr 0 + [ ]) ])) + (constr 1 + [ (cse + 1) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 1)) + (cse 100)) + (cse 2)) + (cse 5)) + (unsafeRatio 9 10)) + (unsafeRatio 3)) + (unsafeRatio 1)) + (constr 1 [0, (constr 0 [])])) (unsafeRatio 4)) - (unsafeRatio 9)) - (unsafeRatio 3)) - (constr 1 [0, (constr 0 [])])) - (fix1 - (\caseData_go arg -> - delay - (\xs -> - force - (force (force chooseList) - xs - (delay (constr 0 [])) - (delay - ((\x xs -> - constr 1 - [ (constr 0 - [ (force - (force - fstPair) - x) - , (force - (force - sndPair) - x) ]) - , (force - (caseData_go - (delay - (\x -> - x))) - xs) ]) - (force headList xs) - (force tailList - xs)))))) - (delay (\x -> x)))) + (unsafeRatio 51)) + (unsafeRatio 0)) + (fix1 + (\caseData_go arg -> + delay + (\xs -> + force + (force (force chooseList) + xs + (delay (constr 0 [])) + (delay + ((\x xs -> + constr 1 + [ (constr 0 + [ (force + (force + fstPair) + x) + , (force + (force + sndPair) + x) ]) + , (force + (caseData_go + (delay + (\x -> + x))) + xs) ]) + (force headList xs) + (force tailList + xs)))))) + (delay (\x -> x)))) + (\`$dUnsafeFromData` d -> + (\tup -> + (\index -> + (\args -> + force + (force + (force ifThenElse + (equalsInteger 1 index) + (delay + (delay (constr 1 []))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (delay + (constr 0 + [ (`$dUnsafeFromData` + (force + headList + args)) ]))) + (delay + (delay + error)))))))))) + (force (force sndPair) tup)) + (force (force fstPair) tup)) + (unConstrData d))) (cse (\arg_0 arg_1 -> arg_1))) (cse (\arg_0 arg_1 -> arg_0))) (force diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/PropTests.hs b/cardano-constitution/test/Cardano/Constitution/Validator/PropTests.hs index 060b707426b..d627c5ff400 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/PropTests.hs +++ b/cardano-constitution/test/Cardano/Constitution/Validator/PropTests.hs @@ -49,7 +49,7 @@ hsAgreesWithTx :: (ConstitutionValidator, CompiledCode ConstitutionValidator) hsAgreesWithTx (vHs, vCode) ctx = ioProperty $ do resHs <- tryApplyOnData vHs ctx let vPs = _progTerm $ getPlcNoAnn $ vCode - `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + `unsafeApplyCode` liftCode110 (unsafeFromBuiltinData $ toBuiltinData ctx) resPs = runCekRes vPs pure $ case (resHs, resPs) of diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs b/cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs index b8d3530d13a..63cfc701115 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs +++ b/cardano-constitution/test/Cardano/Constitution/Validator/TestsCommon.hs @@ -28,7 +28,7 @@ applyOnData :: (ToData ctx) => ConstitutionValidator -> ctx -> BuiltinUnit -applyOnData v ctx = v (Tx.toBuiltinData ctx) +applyOnData v ctx = v (unsafeFromBuiltinData . Tx.toBuiltinData $ ctx) -- | Here we try to catch the calls to `Tx.error`. tryApplyOnData :: (ToData ctx) diff --git a/cardano-constitution/test/Helpers/CekTests.hs b/cardano-constitution/test/Helpers/CekTests.hs index fe262f35da4..7afc42f16d3 100644 --- a/cardano-constitution/test/Helpers/CekTests.hs +++ b/cardano-constitution/test/Helpers/CekTests.hs @@ -23,8 +23,11 @@ hsAgreesWithTxBool :: (ConstitutionValidator, CompiledCode ConstitutionValidator -> V3.FakeProposedContext -> IO Bool hsAgreesWithTxBool (vHs, vCode) ctx = do resHs <- tryApplyOnData vHs ctx - let vPs = _progTerm $ getPlcNoAnn $ vCode - `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + let vPs = + _progTerm + $ getPlcNoAnn + $ vCode + `unsafeApplyCode` liftCode110 (unsafeFromBuiltinData $ toBuiltinData ctx) resPs = runCekRes vPs pure $ case (resHs, resPs) of @@ -36,8 +39,11 @@ hsValidatorsAgreesAndErr :: (ConstitutionValidator, CompiledCode ConstitutionVal -> V3.FakeProposedContext -> Property hsValidatorsAgreesAndErr (vHs, vCode) ctx = ioProperty $ do resHs <- tryApplyOnData vHs ctx - let vPs = _progTerm $ getPlcNoAnn $ vCode - `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + let vPs = + _progTerm + $ getPlcNoAnn + $ vCode + `unsafeApplyCode` liftCode110 (unsafeFromBuiltinData $ toBuiltinData ctx) resPs = runCekRes vPs pure $ case (resHs, resPs) of @@ -48,8 +54,11 @@ hsValidatorsAgreesAndPass :: (ConstitutionValidator, CompiledCode ConstitutionVa -> V3.FakeProposedContext -> Property hsValidatorsAgreesAndPass (vHs, vCode) ctx = ioProperty $ do resHs <- tryApplyOnData vHs ctx - let vPs = _progTerm $ getPlcNoAnn $ vCode - `unsafeApplyCode` liftCode110 (toBuiltinData ctx) + let vPs = + _progTerm + $ getPlcNoAnn + $ vCode + `unsafeApplyCode` liftCode110 (unsafeFromBuiltinData $ toBuiltinData ctx) resPs = runCekRes vPs pure $ case (resHs, resPs) of diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs b/plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs index ccba45f4205..edfb925ef0b 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs @@ -100,6 +100,9 @@ module PlutusLedgerApi.Data.V3 ( -- * Context types Contexts.ScriptContext, pattern Contexts.ScriptContext, + Contexts.scriptContextTxInfo, + Contexts.scriptContextRedeemer, + Contexts.scriptContextScriptInfo, Contexts.ScriptPurpose, pattern Contexts.Minting, pattern Contexts.Spending, diff --git a/plutus-tx/src/PlutusTx/Data/AssocMap.hs b/plutus-tx/src/PlutusTx/Data/AssocMap.hs index b3675ce3078..d90edf29eb0 100644 --- a/plutus-tx/src/PlutusTx/Data/AssocMap.hs +++ b/plutus-tx/src/PlutusTx/Data/AssocMap.hs @@ -21,6 +21,7 @@ module PlutusTx.Data.AssocMap ( unsafeFromBuiltinList, noDuplicateKeys, all, + allKeyVal, any, union, unionWith, @@ -252,6 +253,26 @@ all p (Map m) = go m ) {-# INLINEABLE all #-} +--- | Check if all keys and values in the `Map` satisfy the predicate. +allKeyVal + :: forall k a + . ( P.UnsafeFromData a + , P.UnsafeFromData k + ) + => (k -> a -> Bool) -> Map k a -> Bool +allKeyVal p (Map m) = go m + where + go :: BI.BuiltinList (BI.BuiltinPair BuiltinData BuiltinData) -> Bool + go = + P.caseList' + True + ( \hd -> + let a = P.unsafeFromBuiltinData (BI.snd hd) + k = P.unsafeFromBuiltinData (BI.fst hd) + in if p k a then go else \_ -> False + ) +{-# INLINEABLE allKeyVal #-} + -- | Check if any value in the `Map` satisfies the predicate. any :: forall k a. (P.UnsafeFromData a) => (a -> Bool) -> Map k a -> Bool any p (Map m) = go m