diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden index 8fc9aefd291..5689ac1b3f4 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/sorted.uplc.golden @@ -850,22 +850,22 @@ 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 - , cse ]) ])) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse @@ -916,8 +916,7 @@ program [ (constr 1 [ ]) , (constr 1 - [ (cse - 10) + [ cse , cse ]) ])) (constr 1 [ (constr 0 @@ -936,14 +935,14 @@ program , (constr 0 [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) + [ cse , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 2 + [ ]) + , cse ]) , (constr 0 [ ]) ])) (constr 1 @@ -961,39 +960,39 @@ program , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (cse + 1) , (constr 0 [ ]) ])) (cse - 5)) + 10)) (cse - 4)) + 10)) (cse 1)) - (cse - 100)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (cse - 2)) + 100)) (constr 0 [ (constr 1 [ ]) - , cse ])) - (constr 0 - [ (constr 1 - []) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 10)) - (cse 1)) - (unsafeRatio 3)) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 4)) + (cse 5)) + (cse 2)) + (unsafeRatio 9)) (unsafeRatio 1)) - (unsafeRatio 4)) - (unsafeRatio 9)) - (unsafeRatio 0)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 51)) + (unsafeRatio 0)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 3)) + (unsafeRatio 51)) + (unsafeRatio 4)) (fix1 (\caseData_go arg -> delay diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden index 906017bc4a4..1197a66e6a1 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.uplc.golden @@ -909,18 +909,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 @@ -936,7 +925,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 @@ -957,7 +957,8 @@ program , (constr 1 [ cse , (constr 1 - [ cse + [ (cse + 10) , (constr 0 [ ]) ]) ]) ]) , (constr 0 @@ -967,16 +968,16 @@ program [ ]) , (constr 1 [ cse - , cse ]) ])) + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 1 [ (constr 0 [ (constr 0 @@ -1015,8 +1016,7 @@ program , (constr 0 [ ]) ])) (constr 1 - [ (cse - 4) + [ cse , (constr 0 [ ]) ])) (constr 1 @@ -1024,19 +1024,19 @@ program , (constr 0 [ ]) ])) (cse - 10)) - (cse - 2)) + 2)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (cse - 5)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) + 100)) + (cse + 1)) (cse - 1)) - (cse 10)) - (cse 1)) + 10)) + (cse 4)) + (cse 5)) (constr 0 [ (constr 1 []) @@ -1044,14 +1044,14 @@ program [ 1 , (constr 0 [ ]) ]) ])) - (cse 100)) - (unsafeRatio 9)) - (unsafeRatio 1)) - (unsafeRatio 4)) - (unsafeRatio 3)) + (cse 1)) + (unsafeRatio 1)) + (unsafeRatio 0)) + (unsafeRatio 51)) + (unsafeRatio 9)) (constr 1 [0, (constr 0 [])])) - (unsafeRatio 51)) - (unsafeRatio 0)) + (unsafeRatio 3)) + (unsafeRatio 4)) (fix1 (\caseData_go arg -> delay 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..8615bfd56e7 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 +2147 \ 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..dbeb86b8ed1 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 604996171, exBudgetMemory = ExMemory 2993818} \ No newline at end of file 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..310fc063069 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 91797157, exBudgetMemory = ExMemory 415305} \ 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..56e4e20727a 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden @@ -40,765 +40,771 @@ program (\cse -> (\cse -> (\cse -> - (\fun - ds -> - force - (case - ((\cse -> - (\x -> - force - (force + (\cse -> + (\fun + ds -> + force + (case + ((\cse -> + (\x -> + force (force - ifThenElse - (equalsInteger - 0 - x) - (delay + (force + ifThenElse + (equalsInteger + 0 + x) (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) - (force - headList + (delay + (constr 0 + [ ((\d -> + force + caseData_go + (unMapData + d)) (force - tailList + headList (force + tailList (force - sndPair) - cse)))) ]))) - (delay + (force + sndPair) + cse)))) ]))) (delay - (force + (delay (force (force - ifThenElse - (equalsInteger - 2 - x) - (delay + (force + ifThenElse + (equalsInteger + 2 + x) (delay - (constr 1 - [ ]))) - (delay + (delay + (constr 1 + [ ]))) (delay - error)))))))))) - (force + (delay + error)))))))))) (force - fstPair) - cse)) - (unConstrData - (force - headList + (force + fstPair) + cse)) + (unConstrData (force - tailList + headList (force tailList (force + tailList (force - sndPair) - (unConstrData - ((\cse -> - force - (force + (force + sndPair) + (unConstrData + ((\cse -> + force (force - ifThenElse - (equalsInteger - 5 - (force + (force + ifThenElse + (equalsInteger + 5 (force - fstPair) - cse)) - (delay + (force + fstPair) + cse)) (delay - (force - headList + (delay (force - tailList + headList (force + tailList (force - sndPair) - cse))))) - (delay + (force + sndPair) + cse))))) (delay - error))))) - (unConstrData - (force - headList + (delay + error))))) + (unConstrData (force - tailList + headList (force tailList (force + tailList (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 - [ ]) ]) ]) ]) ]) - , (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 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) + (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 + [ ]) ]) ]) ]) ]) + , (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 - , cse ]) ])) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 + , cse ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 1 [ ]) , (constr 1 [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , (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 + [ cse + , (constr 1 + [ cse + , (constr 0 + [ ]) ]) ]) ]) , (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 [ ]) @@ -808,17 +814,15 @@ program [ cse , (constr 0 [ ]) ]) ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) + [ cse , (constr 0 [ ]) ])) (constr 0 @@ -838,53 +842,52 @@ program , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (cse + 4) , (constr 0 [ ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) + [ cse , (constr 0 [ ]) ])) - (constr 1 - [ (cse - 4) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (cse - 5)) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 1)) - (cse 2)) - (cse 10)) - (cse 100)) + (cse + 2)) + (cse + 10)) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) + (cse + 100)) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 10)) + (cse 1)) + (cse 5)) (cse 1)) - (unsafeRatio 51)) - (unsafeRatio 3)) - (unsafeRatio 0)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 9)) - (unsafeRatio 4)) - (unsafeRatio 1)) + (unsafeRatio 1)) + (unsafeRatio 4)) + (unsafeRatio 51)) + (unsafeRatio 0)) + (unsafeRatio 3)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 9)) (fix1 (\caseData_go arg -> delay 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..7637952e0c2 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 +2136 \ 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..6687ad8aa09 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 963850341, exBudgetMemory = ExMemory 4888488} \ No newline at end of file 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..a4f7f566a0d 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 89455267, exBudgetMemory = ExMemory 403203} \ 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..c9cf05a5514 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden @@ -40,787 +40,771 @@ program (\cse -> (\cse -> (\cse -> - (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\cse -> - (\x -> - force + (\cfg -> + (\fun + ds -> + force + (case + ((\cse -> + (\x -> + force + (force (force - (force - ifThenElse - (equalsInteger - 0 - x) + ifThenElse + (equalsInteger + 0 + x) + (delay (delay - (delay - (constr 0 - [ ((\d -> - force - caseData_go - (unMapData - d)) + (constr 0 + [ ((\d -> + force + caseData_go + (unMapData + d)) + (force + headList (force - headList + tailList (force - tailList (force - (force - sndPair) - cse)))) ]))) + sndPair) + cse)))) ]))) + (delay (delay - (delay + (force (force (force - (force - ifThenElse - (equalsInteger - 2 - x) + ifThenElse + (equalsInteger + 2 + x) + (delay (delay - (delay - (constr 1 - [ ]))) + (constr 1 + [ ]))) + (delay (delay - (delay - error)))))))))) + error)))))))))) + (force (force - (force - fstPair) - cse)) - (unConstrData + fstPair) + cse)) + (unConstrData + (force + headList (force - headList + tailList (force tailList (force - tailList (force - (force - sndPair) - (unConstrData - ((\cse -> - force + sndPair) + (unConstrData + ((\cse -> + force + (force (force - (force - ifThenElse - (equalsInteger - 5 + ifThenElse + (equalsInteger + 5 + (force (force - (force - fstPair) - cse)) + fstPair) + cse)) + (delay (delay - (delay + (force + headList (force - headList + tailList (force - tailList (force - (force - sndPair) - cse))))) + sndPair) + cse))))) + (delay (delay - (delay - error))))) - (unConstrData + error))))) + (unConstrData + (force + headList (force - headList + tailList (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 - (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 + (force + (case (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 ]) ])) + 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 - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 3 [ (constr 1 [ cse @@ -833,120 +817,134 @@ program , cse ]) ]) , (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 + [ (cse + 5) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (cse - 10) - , (constr 0 - [ ]) ]) ]) ]) + [ (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 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 0 [ (constr 1 [ ]) , (constr 1 [ cse , (constr 1 - [ cse + [ (cse + 100) , (constr 0 [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ cse + [ (constr 0 + [ (constr 2 + [ ]) + , 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 , (constr 0 [ ]) ])) - (cse - 2)) - (cse - 1)) + (constr 1 + [ cse + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , cse ])) (cse - 5)) + 2)) (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)) - (unsafeRatio 4)) - (unsafeRatio 9)) - (unsafeRatio 3)) - (constr 1 [0, (constr 0 [])])) + 1)) + (cse 1)) + (constr 0 + [ (constr 1 + []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse 4)) + (cse 10)) + (cse 10)) + (unsafeRatio 3)) + (unsafeRatio 4)) + (unsafeRatio 51)) + (unsafeRatio 0)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio 1)) + (unsafeRatio 9)) (fix1 (\caseData_go arg -> delay diff --git a/plutus-core/changelog.d/20250207_120412_Yuriy.Lazaryev_cip_0138_builtin_array.md b/plutus-core/changelog.d/20250207_120412_Yuriy.Lazaryev_cip_0138_builtin_array.md new file mode 100644 index 00000000000..0c77dd21400 --- /dev/null +++ b/plutus-core/changelog.d/20250207_120412_Yuriy.Lazaryev_cip_0138_builtin_array.md @@ -0,0 +1,7 @@ +### Added + +- A new type `BuiltinArray`. +- Three functions for working with `BuiltinArray` values: + - `listToArray` (converts a list to a `BuiltinArray`) + - `indexArray` (returns an element of a `BuiltinArray` by index) + - `lengthArray` (returns the length of a `BuiltinArray`) diff --git a/plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs b/plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs index a11d0e097de..d3bb2bfc302 100644 --- a/plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs +++ b/plutus-core/cost-model/create-cost-model/BuiltinMemoryModels.hs @@ -110,6 +110,9 @@ builtinMemoryModels = BuiltinCostModelBase , paramHeadList = Id $ ModelOneArgumentConstantCost 32 , paramTailList = Id $ ModelOneArgumentConstantCost 32 , paramNullList = Id $ ModelOneArgumentConstantCost 32 + , paramLengthArray = Id $ ModelOneArgumentConstantCost 99 + , paramListToArray = Id $ ModelOneArgumentConstantCost 99 + , paramIndexArray = Id $ ModelTwoArgumentsConstantCost 99 , paramChooseData = Id $ ModelSixArgumentsConstantCost 32 , paramConstrData = Id $ ModelTwoArgumentsConstantCost 32 , paramMapData = Id $ ModelOneArgumentConstantCost 32 diff --git a/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs b/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs index 74ed6ad379b..1eedb4f9b0b 100644 --- a/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs +++ b/plutus-core/cost-model/create-cost-model/CreateBuiltinCostModel.hs @@ -76,6 +76,9 @@ builtinCostModelNames = BuiltinCostModelBase , paramTailList = "tailListModel" , paramNullList = "nullListModel" , paramDropList = "dropListModel" + , paramLengthArray = "lengthArrayModel" + , paramListToArray = "listToArrayModel" + , paramIndexArray = "indexArrayModel" , paramChooseData = "chooseDataModel" , paramConstrData = "constrDataModel" , paramMapData = "mapDataModel" @@ -210,6 +213,10 @@ createBuiltinCostModel bmfile rfile = do paramHeadList <- getParams readCF1 paramHeadList paramTailList <- getParams readCF1 paramTailList paramNullList <- getParams readCF1 paramNullList + -- Arrays + paramLengthArray <- getParams readCF1 paramLengthArray + paramListToArray <- getParams readCF1 paramListToArray + paramIndexArray <- getParams readCF2 paramIndexArray -- Data paramChooseData <- getParams readCF6 paramChooseData paramConstrData <- getParams readCF2 paramConstrData diff --git a/plutus-core/cost-model/data/builtinCostModelA.json b/plutus-core/cost-model/data/builtinCostModelA.json index 5532721d07a..2fd1155c01e 100644 --- a/plutus-core/cost-model/data/builtinCostModelA.json +++ b/plutus-core/cost-model/data/builtinCostModelA.json @@ -698,6 +698,36 @@ "type": "constant_cost" } }, + "lengthArray" : { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, + "listToArray": { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, + "indexArray": { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, "quotientInteger": { "cpu": { "arguments": { diff --git a/plutus-core/cost-model/data/builtinCostModelB.json b/plutus-core/cost-model/data/builtinCostModelB.json index c6420770bc5..1f36d13cf1c 100644 --- a/plutus-core/cost-model/data/builtinCostModelB.json +++ b/plutus-core/cost-model/data/builtinCostModelB.json @@ -698,6 +698,36 @@ "type": "constant_cost" } }, + "lengthArray" : { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, + "listToArray": { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, + "indexArray": { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, "quotientInteger": { "cpu": { "arguments": { diff --git a/plutus-core/cost-model/data/builtinCostModelC.json b/plutus-core/cost-model/data/builtinCostModelC.json index 11967195559..a540020a711 100644 --- a/plutus-core/cost-model/data/builtinCostModelC.json +++ b/plutus-core/cost-model/data/builtinCostModelC.json @@ -707,6 +707,36 @@ "type": "constant_cost" } }, + "lengthArray" : { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, + "listToArray": { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, + "indexArray": { + "cpu": { + "arguments": 99999999999999, + "type": "constant_cost" + }, + "memory": { + "arguments": 99999999999999, + "type": "constant_cost" + } + }, "quotientInteger": { "cpu": { "arguments": { diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 5cb12ebbffe..91fe737aae0 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -225,6 +225,7 @@ library other-modules: Data.Aeson.Flatten Data.Functor.Foldable.Monadic + Data.Vector.Orphans PlutusCore.Builtin.HasConstant PlutusCore.Builtin.KnownKind PlutusCore.Builtin.KnownType @@ -342,7 +343,7 @@ library , time , transformers , unordered-containers - , vector + , vector ^>=0.13.2 , witherable if impl(ghc <9.0) @@ -377,7 +378,7 @@ test-suite plutus-core-test default-language: Haskell2010 build-depends: , aeson - , base >=4.9 && <5 + , base >=4.9 && <5 , bytestring , containers , data-default-class @@ -401,6 +402,7 @@ test-suite plutus-core-test , text , th-lift-instances , th-utilities + , vector ^>=0.13.2 test-suite untyped-plutus-core-test import: lang @@ -817,6 +819,7 @@ library plutus-core-testlib , tasty-hedgehog , tasty-hunit , text + , vector -- This wraps up the use of the certifier library -- so we can present a consistent inteface whether we diff --git a/plutus-core/plutus-core/src/Data/Vector/Orphans.hs b/plutus-core/plutus-core/src/Data/Vector/Orphans.hs new file mode 100644 index 00000000000..acf187d5afb --- /dev/null +++ b/plutus-core/plutus-core/src/Data/Vector/Orphans.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Orphans () where + +import Data.Hashable (Hashable (hashWithSalt)) +import Data.Vector.Strict qualified as Strict +import Flat (Flat (..)) +import Flat.Instances.Vector () + +instance (Hashable a) => Hashable (Strict.Vector a) where + hashWithSalt = Strict.foldl' hashWithSalt + +instance (Flat a) => Flat (Strict.Vector a) where + size = size . Strict.toLazy -- Strict to Lazy is O(1) + encode = encode . Strict.toLazy + decode = Strict.fromLazy <$> decode -- Strict from Lazy is O(1) diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs index 213c60b1683..8146a233ee7 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Result.hs @@ -188,10 +188,12 @@ _UnliftingErrorVia :: Pretty err => err -> Prism' err UnliftingError _UnliftingErrorVia err = iso (MkUnliftingError . display) (const err) {-# INLINE _UnliftingErrorVia #-} +-- | See Note [Structural vs operational errors within builtins] _StructuralUnliftingError :: AsBuiltinError err => Prism' err UnliftingError _StructuralUnliftingError = _BuiltinUnliftingEvaluationError . _StructuralEvaluationError {-# INLINE _StructuralUnliftingError #-} +-- | See Note [Structural vs operational errors within builtins] _OperationalUnliftingError :: AsBuiltinError err => Prism' err UnliftingError _OperationalUnliftingError = _BuiltinUnliftingEvaluationError . _OperationalEvaluationError {-# INLINE _OperationalUnliftingError #-} diff --git a/plutus-core/plutus-core/src/PlutusCore/Crypto/BLS12_381/Pairing.hs b/plutus-core/plutus-core/src/PlutusCore/Crypto/BLS12_381/Pairing.hs index 8e902a7cedc..e9e54aa6389 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Crypto/BLS12_381/Pairing.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Crypto/BLS12_381/Pairing.hs @@ -51,7 +51,7 @@ instance NFData MlResult where rnf _ = () instance Hashable MlResult where - hashWithSalt salt = const salt + hashWithSalt salt _MlResult = salt millerLoop :: G1.Element -> G2.Element -> MlResult millerLoop = coerce BlstBindings.millerLoop diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs index 1bdb44ffd4b..55644d83d9b 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs @@ -45,6 +45,8 @@ import Data.ByteString.Lazy qualified as BSL import Data.Ix (Ix) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8', encodeUtf8) +import Data.Vector.Strict (Vector) +import Data.Vector.Strict qualified as Vector import Flat hiding (from, to) import Flat.Decoder (Get, dBEBits8) import Flat.Encoder as Flat (Encoding, NumBits, eBits) @@ -181,6 +183,10 @@ data DefaultFun | CaseList | CaseData | DropList + -- Arrays + | LengthArray + | ListToArray + | IndexArray deriving stock (Show, Eq, Ord, Enum, Bounded, Generic, Ix) deriving anyclass (NFData, Hashable, PrettyBy PrettyConfigPlc) @@ -1233,7 +1239,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where {-# INLINE costingFun #-} consByteStringMeaning_V1 = let consByteStringDenotation :: Integer -> BS.ByteString -> BS.ByteString - consByteStringDenotation n xs = BS.cons (fromIntegral n) xs + consByteStringDenotation n = BS.cons (fromIntegral n) -- Earlier instructions say never to use `fromIntegral` in the definition of a -- builtin; however in this case it reduces its argument modulo 256 to get a -- `Word8`, which is exactly what we want. @@ -1447,7 +1453,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where -- Pairs toBuiltinMeaning _semvar FstPair = let fstPairDenotation :: SomeConstant uni (a, b) -> BuiltinResult (Opaque val a) - fstPairDenotation (SomeConstant (Some (ValueOf uniPairAB xy))) = do + fstPairDenotation (SomeConstant (Some (ValueOf uniPairAB xy))) = case uniPairAB of DefaultUniPair uniA _ -> pure . fromValueOf uniA $ fst xy _ -> @@ -1460,7 +1466,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where toBuiltinMeaning _semvar SndPair = let sndPairDenotation :: SomeConstant uni (a, b) -> BuiltinResult (Opaque val b) - sndPairDenotation (SomeConstant (Some (ValueOf uniPairAB xy))) = do + sndPairDenotation (SomeConstant (Some (ValueOf uniPairAB xy))) = case uniPairAB of DefaultUniPair _ uniB -> pure . fromValueOf uniB $ snd xy _ -> @@ -1474,7 +1480,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where -- Lists toBuiltinMeaning _semvar ChooseList = let chooseListDenotation :: SomeConstant uni [a] -> b -> b -> BuiltinResult b - chooseListDenotation (SomeConstant (Some (ValueOf uniListA xs))) a b = do + chooseListDenotation (SomeConstant (Some (ValueOf uniListA xs))) a b = case uniListA of DefaultUniList _ -> pure $ case xs of [] -> a @@ -1487,12 +1493,31 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where chooseListDenotation (runCostingFunThreeArguments . paramChooseList) + toBuiltinMeaning _ver CaseList = + let caseListDenotation + :: Opaque val (LastArg a b) + -> Opaque val (a -> [a] -> b) + -> SomeConstant uni [a] + -> BuiltinResult (Opaque (HeadSpine val) b) + caseListDenotation z f (SomeConstant (Some (ValueOf uniListA xs0))) = + case uniListA of + DefaultUniList uniA -> pure $ case xs0 of + [] -> headSpine z [] + x : xs -> headSpine f [fromValueOf uniA x, fromValueOf uniListA xs] + _ -> + -- See Note [Structural vs operational errors within builtins]. + throwing _StructuralUnliftingError "Expected a list but got something else" + {-# INLINE caseListDenotation #-} + in makeBuiltinMeaning + caseListDenotation + (runCostingFunThreeArguments . unimplementedCostingFun) + toBuiltinMeaning _semvar MkCons = let mkConsDenotation :: SomeConstant uni a -> SomeConstant uni [a] -> BuiltinResult (Opaque val [a]) mkConsDenotation (SomeConstant (Some (ValueOf uniA x))) - (SomeConstant (Some (ValueOf uniListA xs))) = do + (SomeConstant (Some (ValueOf uniListA xs))) = -- See Note [Structural vs operational errors within builtins]. case uniListA of DefaultUniList uniA' -> case uniA `geq` uniA' of @@ -1507,8 +1532,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where toBuiltinMeaning _semvar HeadList = let headListDenotation :: SomeConstant uni [a] -> BuiltinResult (Opaque val a) - headListDenotation (SomeConstant (Some (ValueOf uniListA xs))) = do - -- See Note [Structural vs operational errors within builtins]. + headListDenotation (SomeConstant (Some (ValueOf uniListA xs))) = case uniListA of DefaultUniList uniA -> case xs of [] -> fail "Expected a non-empty list but got an empty one" @@ -1521,10 +1545,10 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where toBuiltinMeaning _semvar TailList = let tailListDenotation :: SomeConstant uni [a] -> BuiltinResult (Opaque val [a]) - tailListDenotation (SomeConstant (Some (ValueOf uniListA xs))) = do - -- See Note [Structural vs operational errors within builtins]. + tailListDenotation (SomeConstant (Some (ValueOf uniListA xs))) = case uniListA of - DefaultUniList _ -> case xs of + DefaultUniList _argUni -> + case xs of [] -> fail "Expected a non-empty list but got an empty one" _ : xs' -> pure $ fromValueOf uniListA xs' _ -> throwing _StructuralUnliftingError "Expected a list but got something else" @@ -1535,12 +1559,10 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where toBuiltinMeaning _semvar NullList = let nullListDenotation :: SomeConstant uni [a] -> BuiltinResult Bool - nullListDenotation (SomeConstant (Some (ValueOf uniListA xs))) = do + nullListDenotation (SomeConstant (Some (ValueOf uniListA xs))) = case uniListA of - DefaultUniList _ -> pure $ null xs - _ -> - -- See Note [Structural vs operational errors within builtins]. - throwing _StructuralUnliftingError "Expected a list but got something else" + DefaultUniList _uniA -> pure $ null xs + _ -> throwing _StructuralUnliftingError "Expected a list but got something else" {-# INLINE nullListDenotation #-} in makeBuiltinMeaning nullListDenotation @@ -1948,8 +1970,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where -> ListCostedByLength Integer -> Bool -> BuiltinResult BS.ByteString - writeBitsDenotation s (ListCostedByLength ixs) bit = - Bitwise.writeBits s ixs bit + writeBitsDenotation s (ListCostedByLength ixs) = Bitwise.writeBits s ixs {-# INLINE writeBitsDenotation #-} in makeBuiltinMeaning writeBitsDenotation @@ -1957,7 +1978,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where toBuiltinMeaning _semvar ReplicateByte = let replicateByteDenotation :: NumBytesCostedAsNumWords -> Word8 -> BuiltinResult BS.ByteString - replicateByteDenotation (NumBytesCostedAsNumWords n) w = Bitwise.replicateByte n w + replicateByteDenotation (NumBytesCostedAsNumWords n) = Bitwise.replicateByte n {-# INLINE replicateByteDenotation #-} in makeBuiltinMeaning replicateByteDenotation @@ -2013,25 +2034,6 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where expModIntegerDenotation (runCostingFunThreeArguments . paramExpModInteger) - toBuiltinMeaning _ver CaseList = - let caseListDenotation - :: Opaque val (LastArg a b) - -> Opaque val (a -> [a] -> b) - -> SomeConstant uni [a] - -> BuiltinResult (Opaque (HeadSpine val) b) - caseListDenotation z f (SomeConstant (Some (ValueOf uniListA xs0))) = do - case uniListA of - DefaultUniList uniA -> pure $ case xs0 of - [] -> headSpine z [] - x : xs -> headSpine f [fromValueOf uniA x, fromValueOf uniListA xs] - _ -> - -- See Note [Structural vs operational errors within builtins]. - throwing _StructuralUnliftingError "Expected a list but got something else" - {-# INLINE caseListDenotation #-} - in makeBuiltinMeaning - caseListDenotation - (runCostingFunThreeArguments . unimplementedCostingFun) - toBuiltinMeaning _ver CaseData = let caseDataDenotation :: Opaque val (Integer -> [Data] -> b) @@ -2076,6 +2078,40 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where dropListDenotation (runCostingFunTwoArguments . paramDropList) + toBuiltinMeaning _semvar LengthArray = + let lengthArrayDenotation :: SomeConstant uni (Vector a) -> BuiltinResult Int + lengthArrayDenotation (SomeConstant (Some (ValueOf uni vec))) = + case uni of + DefaultUniArray _uniA -> pure $ Vector.length vec + _ -> throwing _StructuralUnliftingError "Expected an array but got something else" + {-# INLINE lengthArrayDenotation #-} + in makeBuiltinMeaning lengthArrayDenotation (runCostingFunOneArgument . unimplementedCostingFun) + + toBuiltinMeaning _semvar ListToArray = + let listToArrayDenotation :: SomeConstant uni [a] -> BuiltinResult (Opaque val (Vector a)) + listToArrayDenotation (SomeConstant (Some (ValueOf uniListA xs))) = + case uniListA of + DefaultUniList uniA -> pure $ fromValueOf (DefaultUniArray uniA) $ Vector.fromList xs + _ -> throwing _StructuralUnliftingError "Expected an array but got something else" + {-# INLINE listToArrayDenotation #-} + in makeBuiltinMeaning listToArrayDenotation (runCostingFunOneArgument . unimplementedCostingFun) + + toBuiltinMeaning _semvar IndexArray = + let indexArrayDenotation :: SomeConstant uni (Vector a) -> Int -> BuiltinResult (Opaque val a) + indexArrayDenotation (SomeConstant (Some (ValueOf uni vec))) n = + case uni of + DefaultUniArray arg -> do + case vec Vector.!? n of + Nothing -> fail "Array index out of bounds" + Just el -> pure $ fromValueOf arg el + _ -> + -- See Note [Structural vs operational errors within builtins]. + -- The arguments are going to be printed in the "cause" part of the error + -- message, so we don't need to repeat them here. + throwing _StructuralUnliftingError "Expected an array but got something else" + {-# INLINE indexArrayDenotation #-} + in makeBuiltinMeaning indexArrayDenotation (runCostingFunTwoArguments . unimplementedCostingFun) + -- See Note [Inlining meanings of builtins]. {-# INLINE toBuiltinMeaning #-} @@ -2223,6 +2259,10 @@ instance Flat DefaultFun where DropList -> 90 + LengthArray -> 91 + ListToArray -> 92 + IndexArray -> 93 + decode = go =<< decodeBuiltin where go 0 = pure AddInteger go 1 = pure SubtractInteger @@ -2315,6 +2355,9 @@ instance Flat DefaultFun where go 88 = pure CaseList go 89 = pure CaseData go 90 = pure DropList + go 91 = pure LengthArray + go 92 = pure ListToArray + go 93 = pure IndexArray go t = fail $ "Failed to decode builtin tag, got: " ++ show t size _ n = n + builtinTagWidth diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index 282017c1893..8623ed6617f 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -1,4 +1,3 @@ --- editorconfig-checker-disable-file {-# OPTIONS -fno-warn-missing-pattern-synonym-signatures #-} -- on 9.2.4 this is the flag that suppresses the above warning {-# OPTIONS -Wno-missing-signatures #-} @@ -21,7 +20,6 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -36,32 +34,35 @@ module PlutusCore.Default.Universe ( DefaultUni (..) , pattern DefaultUniList + , pattern DefaultUniArray , pattern DefaultUniPair , noMoreTypeFunctions , module Export -- Re-exporting universes infrastructure for convenience. ) where +import PlutusCore.Builtin import PlutusPrelude -import PlutusCore.Builtin import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing -import PlutusCore.Data -import PlutusCore.Evaluation.Machine.ExMemoryUsage (IntegerCostedLiterally (..), +import PlutusCore.Data (Data) +import PlutusCore.Evaluation.Machine.ExMemoryUsage (ArrayCostedByLength (..), + IntegerCostedLiterally (..), ListCostedByLength (..), NumBytesCostedAsNumWords (..)) -import PlutusCore.Pretty.Extra +import PlutusCore.Pretty.Extra (juxtRenderContext) import Data.ByteString (ByteString) -import Data.Int -import Data.Proxy +import Data.Int (Int16, Int32, Int64, Int8) +import Data.Proxy (Proxy (Proxy)) import Data.Text (Text) import Data.Text qualified as Text import Data.Typeable (typeRep) -import Data.Word +import Data.Vector.Strict (Vector) +import Data.Word (Word16, Word32, Word64) import GHC.Exts (inline, oneShot) -import Text.PrettyBy.Fixity +import Text.PrettyBy.Fixity (RenderContext, inContextM, juxtPrettyM) import Universe as Export {- Note [PLC types and universes] @@ -106,6 +107,7 @@ data DefaultUni a where DefaultUniString :: DefaultUni (Esc Text) DefaultUniUnit :: DefaultUni (Esc ()) DefaultUniBool :: DefaultUni (Esc Bool) + DefaultUniProtoArray :: DefaultUni (Esc Vector) DefaultUniProtoList :: DefaultUni (Esc []) DefaultUniProtoPair :: DefaultUni (Esc (,)) DefaultUniApply :: !(DefaultUni (Esc f)) -> !(DefaultUni (Esc a)) -> DefaultUni (Esc (f a)) @@ -118,6 +120,8 @@ data DefaultUni a where -- so we just leave GHC with its craziness. pattern DefaultUniList uniA = DefaultUniProtoList `DefaultUniApply` uniA +pattern DefaultUniArray uniA = + DefaultUniProtoArray `DefaultUniApply` uniA pattern DefaultUniPair uniA uniB = DefaultUniProtoPair `DefaultUniApply` uniA `DefaultUniApply` uniB @@ -152,6 +156,9 @@ instance GEq DefaultUni where geqStep DefaultUniProtoList a2 = do DefaultUniProtoList <- Just a2 Just Refl + geqStep DefaultUniProtoArray a2 = do + DefaultUniProtoArray <- Just a2 + Just Refl geqStep DefaultUniProtoPair a2 = do DefaultUniProtoPair <- Just a2 Just Refl @@ -189,6 +196,7 @@ instance ToKind DefaultUni where toSingKind DefaultUniUnit = knownKind toSingKind DefaultUniBool = knownKind toSingKind DefaultUniProtoList = knownKind + toSingKind DefaultUniProtoArray = knownKind toSingKind DefaultUniProtoPair = knownKind toSingKind (DefaultUniApply uniF _) = case toSingKind uniF of _ `SingKindArrow` cod -> cod toSingKind DefaultUniData = knownKind @@ -213,6 +221,7 @@ instance PrettyBy RenderContext (DefaultUni a) where DefaultUniUnit -> "unit" DefaultUniBool -> "bool" DefaultUniProtoList -> "list" + DefaultUniProtoArray -> "array" DefaultUniProtoPair -> "pair" DefaultUniApply uniF uniA -> uniF `juxtPrettyM` uniA DefaultUniData -> "data" @@ -253,6 +262,8 @@ instance DefaultUni `Contains` Bool where knownUni = DefaultUniBool instance DefaultUni `Contains` [] where knownUni = DefaultUniProtoList +instance DefaultUni `Contains` Vector where + knownUni = DefaultUniProtoArray instance DefaultUni `Contains` (,) where knownUni = DefaultUniProtoPair instance DefaultUni `Contains` Data where @@ -276,6 +287,8 @@ instance KnownBuiltinTypeAst tyname DefaultUni Bool => KnownTypeAst tyname DefaultUni Bool instance KnownBuiltinTypeAst tyname DefaultUni [a] => KnownTypeAst tyname DefaultUni [a] +instance KnownBuiltinTypeAst tyname DefaultUni (Vector a) => + KnownTypeAst tyname DefaultUni (Vector a) instance KnownBuiltinTypeAst tyname DefaultUni (a, b) => KnownTypeAst tyname DefaultUni (a, b) instance KnownBuiltinTypeAst tyname DefaultUni Data => @@ -301,6 +314,8 @@ instance KnownBuiltinTypeIn DefaultUni term Data => ReadKnownIn DefaultUni term Data instance KnownBuiltinTypeIn DefaultUni term [a] => ReadKnownIn DefaultUni term [a] +instance KnownBuiltinTypeIn DefaultUni term (Vector a) => + ReadKnownIn DefaultUni term (Vector a) instance KnownBuiltinTypeIn DefaultUni term (a, b) => ReadKnownIn DefaultUni term (a, b) instance KnownBuiltinTypeIn DefaultUni term BLS12_381.G1.Element => @@ -324,6 +339,8 @@ instance KnownBuiltinTypeIn DefaultUni term Data => MakeKnownIn DefaultUni term Data instance KnownBuiltinTypeIn DefaultUni term [a] => MakeKnownIn DefaultUni term [a] +instance KnownBuiltinTypeIn DefaultUni term (Vector a) => + MakeKnownIn DefaultUni term (Vector a) instance KnownBuiltinTypeIn DefaultUni term (a, b) => MakeKnownIn DefaultUni term (a, b) instance KnownBuiltinTypeIn DefaultUni term BLS12_381.G1.Element => @@ -489,6 +506,13 @@ deriving newtype instance KnownBuiltinTypeIn DefaultUni term [a] => deriving newtype instance KnownBuiltinTypeIn DefaultUni term [a] => ReadKnownIn DefaultUni term (ListCostedByLength a) +deriving newtype instance KnownTypeAst tyname DefaultUni a => + KnownTypeAst tyname DefaultUni (ArrayCostedByLength a) +deriving newtype instance KnownBuiltinTypeIn DefaultUni term (Vector a) => + MakeKnownIn DefaultUni term (ArrayCostedByLength a) +deriving newtype instance KnownBuiltinTypeIn DefaultUni term (Vector a) => + ReadKnownIn DefaultUni term (ArrayCostedByLength a) + deriving via AsInteger Natural instance KnownTypeAst tyname DefaultUni Natural deriving via AsInteger Natural instance KnownBuiltinTypeIn DefaultUni term Integer => @@ -525,6 +549,7 @@ instance Closed DefaultUni where , constr `Permits` () , constr `Permits` Bool , constr `Permits` [] + , constr `Permits` Vector , constr `Permits` (,) , constr `Permits` Data , constr `Permits` BLS12_381.G1.Element @@ -546,6 +571,7 @@ instance Closed DefaultUni where encodeUni DefaultUniBLS12_381_G1_Element = [9] encodeUni DefaultUniBLS12_381_G2_Element = [10] encodeUni DefaultUniBLS12_381_MlResult = [11] + encodeUni DefaultUniProtoArray = [12] -- See Note [Decoding universes]. -- See Note [Stable encoding of tags]. @@ -566,6 +592,7 @@ instance Closed DefaultUni where 9 -> k DefaultUniBLS12_381_G1_Element 10 -> k DefaultUniBLS12_381_G2_Element 11 -> k DefaultUniBLS12_381_MlResult + 12 -> k DefaultUniProtoArray _ -> empty bring @@ -578,6 +605,8 @@ instance Closed DefaultUni where bring _ DefaultUniBool r = r bring p (DefaultUniProtoList `DefaultUniApply` uniA) r = bring p uniA r + bring p (DefaultUniProtoArray `DefaultUniApply` uniA) r = + bring p uniA r bring p (DefaultUniProtoPair `DefaultUniApply` uniA `DefaultUniApply` uniB) r = bring p uniA $ bring p uniB r bring _ (f `DefaultUniApply` _ `DefaultUniApply` _ `DefaultUniApply` _) _ = diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs index 569df4772e5..e9e7af5500c 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/BuiltinCostModel.hs @@ -127,6 +127,10 @@ data BuiltinCostModelBase f = , paramHeadList :: f ModelOneArgument , paramTailList :: f ModelOneArgument , paramNullList :: f ModelOneArgument + -- Arrays + , paramLengthArray :: f ModelOneArgument + , paramListToArray :: f ModelOneArgument + , paramIndexArray :: f ModelTwoArguments -- Data , paramChooseData :: f ModelSixArguments , paramConstrData :: f ModelTwoArguments diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs index 105048d1d01..70c220938a5 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs @@ -288,6 +288,10 @@ unitCostBuiltinCostModel = BuiltinCostModelBase , paramHeadList = unitCostOneArgument , paramTailList = unitCostOneArgument , paramNullList = unitCostOneArgument + -- Arrays + , paramLengthArray = unitCostOneArgument + , paramListToArray = unitCostOneArgument + , paramIndexArray = unitCostTwoArguments -- Data , paramChooseData = unitCostSixArguments , paramConstrData = unitCostTwoArguments diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs index 87bd1f79843..3ace134b858 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs @@ -13,6 +13,7 @@ module PlutusCore.Evaluation.Machine.ExMemoryUsage , NumBytesCostedAsNumWords(..) , IntegerCostedLiterally(..) , ListCostedByLength(..) + , ArrayCostedByLength(..) ) where import PlutusCore.Crypto.BLS12_381.G1 as BLS12_381.G1 @@ -27,6 +28,8 @@ import Data.Functor import Data.Proxy import Data.SatInt import Data.Text qualified as T +import Data.Vector.Strict (Vector) +import Data.Vector.Strict qualified as Vector import Data.Word import GHC.Exts (Int (I#)) import GHC.Integer @@ -218,6 +221,15 @@ instance ExMemoryUsage (ListCostedByLength a) where -- realistic input should be that large; however if you're going to use this then be -- sure to convince yourself that it's safe. +newtype ArrayCostedByLength a = ArrayCostedByLength { unArrayCostedByLength :: Vector a } +instance ExMemoryUsage (ArrayCostedByLength a) where + memoryUsage (ArrayCostedByLength l) = singletonRose . fromIntegral $ Vector.length l + {-# INLINE memoryUsage #-} + -- Note that this uses `fromIntegral`, which will narrow large values to + -- maxBound::SatInt = 2^63-1. This shouldn't be a problem for costing because no + -- realistic input should be that large; however if you're going to use this then be + -- sure to convince yourself that it's safe. + -- | Calculate a 'CostingInteger' for the given 'Integer'. memoryUsageInteger :: Integer -> CostingInteger -- integerLog2# is unspecified for 0 (but in practice returns -1) @@ -293,6 +305,7 @@ addConstantRose (CostRose cost1 forest1) (CostRose cost2 forest2) = {-# INLINE addConstantRose #-} instance ExMemoryUsage a => ExMemoryUsage [a] where + -- sizeof([a]) = (1 + 3N) words + N * sizeof(v) memoryUsage = CostRose nilCost . map (addConstantRose consRose . memoryUsage) where -- As per https://wiki.haskell.org/GHC/Memory_Footprint nilCost = 1 @@ -301,6 +314,15 @@ instance ExMemoryUsage a => ExMemoryUsage [a] where {-# INLINE consRose #-} {-# INLINE memoryUsage #-} +instance ExMemoryUsage a => ExMemoryUsage (Vector a) where + -- sizeof(Vector v) = (7 + N) words + N * sizeof(v) + memoryUsage v = CostRose arrayCost [ memoryUsage a | a <- Vector.toList v ] + where + arrayCost :: SatInt + arrayCost = 7 + fromIntegral (Vector.length v) + {-# INLINE arrayCost #-} + {-# INLINE memoryUsage #-} + {- Another naive traversal for size. This accounts for the number of nodes in a Data object, and also the sizes of the contents of the nodes. This is not ideal, but it seems to be the best we can do. At present this only comes diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs b/plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs index 419008947ef..d8467d0baf2 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs @@ -3,7 +3,7 @@ module PlutusCore.Parser.Builtin where -import PlutusPrelude (Word8, reoption) +import PlutusPrelude (Word8, reoption, void) import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 @@ -20,6 +20,8 @@ import Data.ByteString (ByteString, pack) import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Text.Internal.Read (hexDigitToInt) +import Data.Vector.Strict (Vector) +import Data.Vector.Strict qualified as Vector import Text.Megaparsec (customFailure, getSourcePos, takeWhileP) import Text.Megaparsec.Char (char, hexDigitChar, string) import Text.Megaparsec.Char.Lexer qualified as Lex @@ -65,7 +67,7 @@ conText = lexeme . fmap T.pack $ char '\"' *> manyTill Lex.charLiteral (char '\" -- | Parser for unit. conUnit :: Parser () -conUnit = () <$ (symbol "(" *> symbol ")") +conUnit = void (symbol "(" *> symbol ")") -- | Parser for bool. conBool :: Parser Bool @@ -78,7 +80,11 @@ conBool = -- | Parser for lists. conList :: DefaultUni (Esc a) -> Parser [a] conList uniA = trailingWhitespace . inBrackets $ - constantOf ExpectParensNo uniA `sepBy` symbol "," + constantOf ExpectParensNo uniA `sepBy` symbol "," + +-- | Parser for arrays. +conArray :: DefaultUni (Esc a) -> Parser (Vector a) +conArray uniA = Vector.fromList <$> conList uniA -- | Parser for pairs. conPair :: DefaultUni (Esc a) -> DefaultUni (Esc b) -> Parser (a, b) @@ -123,13 +129,15 @@ conBLS12_381_G2_Element = do -- | Parser for constants of the given type. constantOf :: ExpectParens -> DefaultUni (Esc a) -> Parser a -constantOf expectParens uni = case uni of +constantOf expectParens uni = + case uni of DefaultUniInteger -> conInteger DefaultUniByteString -> conBS DefaultUniString -> conText DefaultUniUnit -> conUnit DefaultUniBool -> conBool DefaultUniProtoList `DefaultUniApply` uniA -> conList uniA + DefaultUniProtoArray `DefaultUniApply` uniA -> conArray uniA DefaultUniProtoPair `DefaultUniApply` uniA `DefaultUniApply` uniB -> conPair uniA uniB f `DefaultUniApply` _ `DefaultUniApply` _ `DefaultUniApply` _ -> noMoreTypeFunctions f DefaultUniData -> conData expectParens diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs b/plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs index c9a8c287475..68525be6dcb 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Parser/Type.hs @@ -22,6 +22,7 @@ import PlutusCore.Parser.ParserCommon import Control.Monad import Data.ByteString (ByteString) import Data.Text (Text) +import Data.Vector.Strict qualified as Strict import Text.Megaparsec hiding (ParseError, State, many, parse, some) -- | A PLC @Type@ to be parsed. ATM the parser only works @@ -138,6 +139,7 @@ defaultUni = choice $ map try , someType @_ @() <$ symbol "unit" , someType @_ @Bool <$ symbol "bool" , someType @_ @[] <$ symbol "list" + , someType @_ @Strict.Vector <$ symbol "array" , someType @_ @(,) <$ symbol "pair" , someType @_ @Data <$ symbol "data" , someType @_ @BLS12_381.G1.Element <$ symbol "bls12_381_G1_element" diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty/Extra.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty/Extra.hs index f0798ded51d..cb502923aa9 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty/Extra.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty/Extra.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -22,6 +21,7 @@ import Data.Map qualified as Map import Data.Profunctor import Data.Set (Set) import Data.Set qualified as Set +import Data.Vector.Strict (Vector) import Text.PrettyBy.Fixity import Text.PrettyBy.Internal @@ -62,3 +62,8 @@ instance PrettyDefaultBy config [a] => DefaultPrettyBy config (Set a) where defaultPrettyBy config = prettyBy config . Set.toList deriving via PrettyCommon (Set a) instance PrettyDefaultBy config (Set a) => PrettyBy config (Set a) + +instance PrettyDefaultBy config [a] => DefaultPrettyBy config (Vector a) where + defaultPrettyBy config = prettyBy config . toList +deriving via PrettyCommon (Vector a) + instance PrettyDefaultBy config (Vector a) => PrettyBy config (Vector a) diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty/PrettyConst.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty/PrettyConst.hs index 18270ac2fc2..4b737f59c22 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty/PrettyConst.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty/PrettyConst.hs @@ -19,11 +19,11 @@ import PlutusCore.Pretty.Readable import Control.Lens hiding (List) import Data.ByteString qualified as BS import Data.Coerce -import Data.Foldable (fold) import Data.List.NonEmpty import Data.Proxy import Data.Text qualified as T import Data.Typeable +import Data.Vector.Strict (Vector) import Data.Word (Word8) import Numeric (showHex) import Prettyprinter @@ -122,6 +122,8 @@ instance PrettyConst a => PrettyBy ConstConfig (NoParens a) where instance PrettyConst a => NonDefaultPrettyBy ConstConfig [a] where nonDefaultPrettyBy config = defaultPrettyBy @_ @[NoParens a] config . coerce +instance PrettyConst a => NonDefaultPrettyBy ConstConfig (Vector a) where + nonDefaultPrettyBy config = defaultPrettyBy @_ @(Vector (NoParens a)) config . coerce instance (PrettyConst a, PrettyConst b) => NonDefaultPrettyBy ConstConfig (a, b) where nonDefaultPrettyBy config = defaultPrettyBy @_ @(NoParens a, NoParens b) config . coerce @@ -134,7 +136,7 @@ asBytes x = Text 2 $ T.pack $ addLeadingZero $ showHex x mempty | otherwise = id toBytes :: BS.ByteString -> Doc ann -toBytes b = fold (asBytes <$> BS.unpack b) +toBytes = foldMap asBytes . BS.unpack instance PrettyBy ConstConfig Data where prettyBy = inContextM $ \d0 -> iterAppDocM $ \_ prettyArg -> case d0 of diff --git a/plutus-core/plutus-core/test/CostModelSafety/Spec.hs b/plutus-core/plutus-core/test/CostModelSafety/Spec.hs index d42f2b8482d..229b4ede8f6 100644 --- a/plutus-core/plutus-core/test/CostModelSafety/Spec.hs +++ b/plutus-core/plutus-core/test/CostModelSafety/Spec.hs @@ -48,6 +48,8 @@ import Data.Functor.Identity (Identity (..)) import Data.Kind qualified as GHC (Type) import Data.List.Extra (enumerate) import Data.Text (Text) +import Data.Vector.Strict (Vector) +import Data.Vector.Strict qualified as Vector import Data.Word (Word8) import GHC.Natural import Test.Tasty (TestTree, testGroup) @@ -137,6 +139,10 @@ smallConstant tr , Just HRefl <- eqTypeRep trList' (typeRep @ListCostedByLength) = case smallConstant trElem of SomeConst c -> SomeConst ([] `asTypeOf` [c]) + | trArray `App` trElem <- tr + , Just HRefl <- eqTypeRep trArray (typeRep @Vector) = + case smallConstant trElem of + SomeConst c -> SomeConst (Vector.fromList ([] `asTypeOf` [c])) | trSomeConstant `App` _ `App` trEl <- tr , Just HRefl <- eqTypeRep trSomeConstant (typeRep @SomeConstant) = smallConstant trEl diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/IndexArray.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/IndexArray.plc.golden new file mode 100644 index 00000000000..1f965336cac --- /dev/null +++ b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/IndexArray.plc.golden @@ -0,0 +1 @@ +all a. array a -> integer -> a \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/LengthArray.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/LengthArray.plc.golden new file mode 100644 index 00000000000..b23049d3e57 --- /dev/null +++ b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/LengthArray.plc.golden @@ -0,0 +1 @@ +all a. array a -> integer \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/ListToArray.plc.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/ListToArray.plc.golden new file mode 100644 index 00000000000..c0ad279630b --- /dev/null +++ b/plutus-core/plutus-core/test/TypeSynthesis/Golden/DefaultFun/ListToArray.plc.golden @@ -0,0 +1 @@ +all a. list a -> array a \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/IndexArray.sig.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/IndexArray.sig.golden new file mode 100644 index 00000000000..34e0aff0e34 --- /dev/null +++ b/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/IndexArray.sig.golden @@ -0,0 +1 @@ +forall a. SomeConstant DefaultUni (Vector (TyVarRep * ('TyNameRep * "a" 0))) -> Int -> BuiltinResult (Opaque Val (TyVarRep * ('TyNameRep * "a" 0))) \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/LengthArray.sig.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/LengthArray.sig.golden new file mode 100644 index 00000000000..20832479b51 --- /dev/null +++ b/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/LengthArray.sig.golden @@ -0,0 +1 @@ +forall a. SomeConstant DefaultUni (Vector (TyVarRep * ('TyNameRep * "a" 0))) -> BuiltinResult Int \ No newline at end of file diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/ListToArray.sig.golden b/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/ListToArray.sig.golden new file mode 100644 index 00000000000..da88809127e --- /dev/null +++ b/plutus-core/plutus-core/test/TypeSynthesis/Golden/Signatures/DefaultFun/ListToArray.sig.golden @@ -0,0 +1 @@ +forall a. SomeConstant DefaultUni [TyVarRep * ('TyNameRep * "a" 0)] -> BuiltinResult (Opaque Val (Vector (TyVarRep * ('TyNameRep * "a" 0)))) \ No newline at end of file diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs index 865468db7d1..235ccd35756 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Definitions.hs @@ -167,7 +167,7 @@ wrapWithDefs :: wrapWithDefs x tds body = let toValue k = fst <$> Map.lookup k tds wrapDefScc acc scc = - let bs = catMaybes $ toValue <$> Graph.vertexList scc + let bs = mapMaybe toValue (Graph.vertexList scc) in mkLet x (if Graph.isAcyclic scc then NonRec else Rec) bs acc in -- process from the inside out Foldable.foldl' wrapDefScc body (defSccs tds) diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/CommuteFnWithConst.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/CommuteFnWithConst.hs index 40e1f8b1b2c..60918f38b32 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/CommuteFnWithConst.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/RewriteRules/CommuteFnWithConst.hs @@ -114,6 +114,9 @@ isCommutative = \case HeadList -> False TailList -> False NullList -> False + LengthArray -> False + ListToArray -> False + IndexArray -> False ChooseData -> False CaseData -> False ConstrData -> False diff --git a/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs index b8872485029..bba80f3e703 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs @@ -89,8 +89,8 @@ isScramblable (PLC.Some (PLC.ValueOf uni0 x0)) = go uni0 x0 where go PLC.DefaultUniString text = T.all (\c -> not (separator c) && c /= '`') text go PLC.DefaultUniUnit _ = True go PLC.DefaultUniBool _ = True - go (PLC.DefaultUniProtoList `PLC.DefaultUniApply` uniA) xs = - all (go uniA) xs + go (PLC.DefaultUniProtoList `PLC.DefaultUniApply` uniA) xs = all (go uniA) xs + go (PLC.DefaultUniProtoArray `PLC.DefaultUniApply` uniA) xs = all (go uniA) xs go (PLC.DefaultUniProtoPair `PLC.DefaultUniApply` uniA `PLC.DefaultUniApply` uniB) (x, y) = go uniA x && go uniB y go (f `PLC.DefaultUniApply` _ `PLC.DefaultUniApply` _ `PLC.DefaultUniApply` _) _ = diff --git a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Builtin.hs b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Builtin.hs index 1a2cd3c2143..461487eceb8 100644 --- a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Builtin.hs +++ b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Builtin.hs @@ -1,6 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeApplications #-} @@ -27,6 +26,8 @@ import Data.ByteString qualified as BS import Data.Kind qualified as GHC import Data.Text (Text) import Data.Type.Equality +import Data.Vector.Strict (Vector) +import Data.Vector.Strict qualified as Vector import Data.Word (Word8) import GHC.Natural import Hedgehog hiding (Opaque, Var, eval) @@ -119,6 +120,10 @@ genConstant tr , Just HRefl <- eqTypeRep trList' (typeRep @ListCostedByLength) = case genConstant trElem of SomeGen genElem -> SomeGen $ Gen.list (Range.linear 0 10) genElem + | trArray `App` trElem <- tr + , Just HRefl <- eqTypeRep trArray (typeRep @Vector) = + case genConstant trElem of + SomeGen genElem -> SomeGen $ fmap Vector.fromList $ Gen.list (Range.linear 0 10) genElem | trSomeConstant `App` _ `App` trEl <- tr , Just HRefl <- eqTypeRep trSomeConstant (typeRep @SomeConstant) = genConstant trEl diff --git a/plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs b/plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs index 42f390876b9..91968d09e34 100644 --- a/plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs +++ b/plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs @@ -29,8 +29,10 @@ import Data.Proxy import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text +import Data.Vector.Strict qualified as Strict import Test.QuickCheck import Test.QuickCheck.Instances.ByteString () +import Test.QuickCheck.Instances.Vector () import Universe -- | Same as 'Arbitrary' but specifically for Plutus built-in types, so that we are not tied to @@ -294,6 +296,10 @@ instance ArbitraryBuiltin a => ArbitraryBuiltin [a] where scale (`div` len) . coerce $ arbitrary @(AsArbitraryBuiltin a) shrinkBuiltin = coerce $ shrink @[AsArbitraryBuiltin a] +instance ArbitraryBuiltin a => ArbitraryBuiltin (Strict.Vector a) where + arbitraryBuiltin = Strict.fromList <$> arbitraryBuiltin + shrinkBuiltin = map Strict.fromList . shrinkBuiltin . Strict.toList + instance (ArbitraryBuiltin a, ArbitraryBuiltin b) => ArbitraryBuiltin (a, b) where arbitraryBuiltin = do (,) @@ -412,8 +418,11 @@ instance KnownKind k => Arbitrary (MaybeSomeTypeOf k) where , JustSomeType DefaultUniBLS12_381_MlResult ] SingType `SingKindArrow` SingType -> - [genDefaultUniApply | size > 10] ++ - [pure $ JustSomeType DefaultUniProtoList] + [ genDefaultUniApply | size > 10 ] + ++ map pure + [ JustSomeType DefaultUniProtoList + , JustSomeType DefaultUniProtoArray + ] SingType `SingKindArrow` SingType `SingKindArrow` SingType -> -- No 'genDefaultUniApply', because we don't have any built-in type constructors -- taking three or more arguments. diff --git a/plutus-core/testlib/PlutusCore/Test.hs b/plutus-core/testlib/PlutusCore/Test.hs index 6d68525dd65..7545c6073cc 100644 --- a/plutus-core/testlib/PlutusCore/Test.hs +++ b/plutus-core/testlib/PlutusCore/Test.hs @@ -153,8 +153,8 @@ isSerialisable (Some (ValueOf uni0 x0)) = go uni0 x0 where go TPLC.DefaultUniString _ = True go TPLC.DefaultUniUnit _ = True go TPLC.DefaultUniBool _ = True - go (TPLC.DefaultUniProtoList `TPLC.DefaultUniApply` uniA) xs = - all (go uniA) xs + go (TPLC.DefaultUniProtoList `TPLC.DefaultUniApply` uniA) xs = all (go uniA) xs + go (TPLC.DefaultUniProtoArray `TPLC.DefaultUniApply` uniA) xs = all (go uniA) xs go (TPLC.DefaultUniProtoPair `TPLC.DefaultUniApply` uniA `TPLC.DefaultUniApply` uniB) (x, y) = go uniA x && go uniB y go (f `TPLC.DefaultUniApply` _ `TPLC.DefaultUniApply` _ `TPLC.DefaultUniApply` _) _ = diff --git a/plutus-core/testlib/PlutusIR/Generators/QuickCheck/ShrinkTerms.hs b/plutus-core/testlib/PlutusIR/Generators/QuickCheck/ShrinkTerms.hs index 7039702c7a8..77eb9e1f2ed 100644 --- a/plutus-core/testlib/PlutusIR/Generators/QuickCheck/ShrinkTerms.hs +++ b/plutus-core/testlib/PlutusIR/Generators/QuickCheck/ShrinkTerms.hs @@ -36,6 +36,7 @@ import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Set.Lens (setOf) +import Data.Vector.Strict qualified as Vector import GHC.Stack import Test.QuickCheck (shrink, shrinkList) @@ -119,6 +120,7 @@ minimalBuiltin (SomeTypeIn uni) = case toSingKind uni of go DefaultUniByteString = "" go DefaultUniData = I 0 go (DefaultUniProtoList `DefaultUniApply` _) = [] + go (DefaultUniProtoArray `DefaultUniApply` _) = Vector.empty go (DefaultUniProtoPair `DefaultUniApply` a `DefaultUniApply` b) = (go a, go b) go (f `DefaultUniApply` _ `DefaultUniApply` _ `DefaultUniApply` _) = noMoreTypeFunctions f go DefaultUniBLS12_381_G1_Element = BLS12_381.G1.offchain_zero diff --git a/plutus-core/testlib/Test/Tasty/Extras.hs b/plutus-core/testlib/Test/Tasty/Extras.hs index 86e183241ee..98d71ca10e3 100644 --- a/plutus-core/testlib/Test/Tasty/Extras.hs +++ b/plutus-core/testlib/Test/Tasty/Extras.hs @@ -1,9 +1,9 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeSynonymInstances #-} module Test.Tasty.Extras ( Layer (..) @@ -24,6 +24,7 @@ module Test.Tasty.Extras , goldenVsDoc , goldenVsDocM , nestedGoldenVsText + , nestedGoldenVsTextPredM , nestedGoldenVsTextM , nestedGoldenVsDoc , nestedGoldenVsDocM @@ -33,16 +34,18 @@ module Test.Tasty.Extras import PlutusPrelude hiding (toList) import Control.Monad.Free.Church (F (runF), MonadFree, liftF) -import Control.Monad.Reader +import Control.Monad.Reader (MonadReader (ask, local), ReaderT (..), asks, mapReaderT) import Data.ByteString.Lazy qualified as BSL import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) -import Data.Version -import GHC.Exts +import Data.Text.IO qualified as TIO +import Data.Version (showVersion) +import GHC.Exts (IsList (Item, fromList, toList)) import System.FilePath (joinPath, ()) -import System.Info -import Test.Tasty -import Test.Tasty.Golden +import System.Info (compilerVersion) +import Test.Tasty (TestName, TestTree, testGroup) +import Test.Tasty.Golden (createDirectoriesAndWriteFile, goldenVsStringDiff) +import Test.Tasty.Golden.Advanced (goldenTest) -- | We use the GHC version number to create directories with names like `9.2` -- and `9.6` containing golden files whose contents depend on the GHC version. @@ -206,6 +209,28 @@ goldenVsDocM name ref val = goldenVsTextM name ref $ render <$> val nestedGoldenVsText :: TestName -> FilePath -> Text -> TestNested nestedGoldenVsText name ext = nestedGoldenVsTextM name ext . pure +{-| Compare the contents of a file under a name prefix against a 'Text' +using a predicate. +-} +nestedGoldenVsTextPredM + :: TestName + -- ^ The name of the test + -> FilePath + -- ^ The file extension + -> IO Text + -- ^ The text-producing action to execute + -> (Text -> Text -> Bool) + -- ^ How to compare golden file contents with the produced text + -> TestNested +nestedGoldenVsTextPredM name ext action predicate = do + filePath <- asks $ foldr () (name ++ ext ++ ".golden") + embed $ goldenTest name (TIO.readFile filePath) action + do \golden actual -> pure + if predicate golden actual + then Nothing + else Just "Predicate failed on golden file" + do createDirectoriesAndWriteFile filePath . BSL.fromStrict . encodeUtf8 + -- | Check the contents of a file under a name prefix against a 'Text'. nestedGoldenVsTextM :: TestName -> FilePath -> IO Text -> TestNested nestedGoldenVsTextM name ext text = do @@ -219,3 +244,4 @@ nestedGoldenVsDoc name ext = nestedGoldenVsDocM name ext . pure -- | Check the contents of a file under a name prefix against a 'Text'. nestedGoldenVsDocM :: TestName -> FilePath -> IO (Doc ann) -> TestNested nestedGoldenVsDocM name ext val = nestedGoldenVsTextM name ext $ render <$> val + diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs index f4cdf837503..c07ac4d5c57 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Simplify.hs @@ -27,6 +27,7 @@ import UntypedPlutusCore.Transform.Simplifier import Control.Monad import Data.List as List (foldl') import Data.Typeable +import Data.Vector.Orphans () simplifyProgram :: forall name uni fun m a. diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs index 21e8940d792..300e383896b 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs @@ -1,6 +1,7 @@ -- editorconfig-checker-disable-file -- | Tests for all kinds of built-in functions. +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -53,24 +54,26 @@ import PlutusCore.StdLib.Data.Unit import PlutusCore.Test import UntypedPlutusCore.Evaluation.Machine.Cek -import Control.Exception +import Control.Exception (evaluate, try) import Data.Bifunctor (bimap) import Data.ByteString (ByteString, pack) import Data.ByteString.Base16 qualified as Base16 import Data.DList qualified as DList import Data.List (find) -import Data.Proxy +import Data.Proxy (Proxy (..)) import Data.String (IsString (fromString)) import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text -import Hedgehog hiding (Opaque, Size, Var) +import Data.Vector.Strict (Vector) +import Data.Vector.Strict qualified as Vector +import Hedgehog (forAll, property, withTests, (===)) import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Prettyprinter (vsep) -import Test.Tasty -import Test.Tasty.Hedgehog -import Test.Tasty.HUnit +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (testPropertyNamed) +import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@=?), (@?=)) import Test.Tasty.QuickCheck qualified as QC type DefaultFunExt = Either DefaultFun ExtensionFun @@ -100,7 +103,7 @@ test_IntegerDistribution = \(AsArbitraryBuiltin (i :: Integer)) -> let magnitudes = magnitudesPositive nextInterestingBound highInterestingBound (low, high) = - maybe (error $ "Panic: unknown integer") (bimap (* signum i) (* signum i)) $ + maybe (error "Panic: unknown integer") (bimap (* signum i) (* signum i)) $ find ((>= abs i) . snd) magnitudes bounds = map snd magnitudes isInteresting = i `elem` concat @@ -367,6 +370,30 @@ test_IdBuiltinList = typecheckEvaluateCekNoEmit def defaultBuiltinCostModelExt term @?= Right (EvaluationSuccess xsTerm) +test_BuiltinArray :: TestTree +test_BuiltinArray = + testGroup "BuiltinArray" [ + testCase "listToArray" do + let listOfInts = mkConstant @[Integer] @DefaultUni () [1..10] + let arrayOfInts = mkConstant @(Vector Integer) @DefaultUni () (Vector.fromList [1..10]) + let term = apply () (tyInst () (builtin () ListToArray) integer) listOfInts + typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting term @?= + Right (EvaluationSuccess arrayOfInts) + , testCase "lengthArray" do + let arrayOfInts = mkConstant @(Vector Integer) @DefaultUni () (Vector.fromList [1..10]) + let expectedLength = mkConstant @Integer @DefaultUni () 10 + term = apply () (tyInst () (builtin () LengthArray) integer) arrayOfInts + typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting term @?= + Right (EvaluationSuccess expectedLength) + , testCase "indexArray" do + let arrayOfInts = mkConstant @(Vector Integer) @DefaultUni () (Vector.fromList [1..10]) + let index = mkConstant @Integer @DefaultUni () 5 + expectedValue = mkConstant @Integer @DefaultUni () 6 + term = mkIterAppNoAnn (tyInst () (builtin () IndexArray) integer) [arrayOfInts, index] + typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting term @?= + Right (EvaluationSuccess expectedValue) + ] + test_BuiltinPair :: TestTree test_BuiltinPair = testCase "BuiltinPair" $ do @@ -1194,6 +1221,7 @@ test_definition = , test_ExpensivePlus , test_BuiltinList , test_IdBuiltinList + , test_BuiltinArray , test_BuiltinPair , test_SwapEls , test_IdBuiltinData diff --git a/plutus-ledger-api/CostModel/Data/Params/CostModelParams/costModelParamNames.txt.golden b/plutus-ledger-api/CostModel/Data/Params/CostModelParams/costModelParamNames.txt.golden new file mode 100644 index 00000000000..a84e243661f --- /dev/null +++ b/plutus-ledger-api/CostModel/Data/Params/CostModelParams/costModelParamNames.txt.golden @@ -0,0 +1,303 @@ +addInteger-cpu-arguments-intercept +addInteger-cpu-arguments-slope +addInteger-memory-arguments-intercept +addInteger-memory-arguments-slope +appendByteString-cpu-arguments-intercept +appendByteString-cpu-arguments-slope +appendByteString-memory-arguments-intercept +appendByteString-memory-arguments-slope +appendString-cpu-arguments-intercept +appendString-cpu-arguments-slope +appendString-memory-arguments-intercept +appendString-memory-arguments-slope +bData-cpu-arguments +bData-memory-arguments +blake2b_256-cpu-arguments-intercept +blake2b_256-cpu-arguments-slope +blake2b_256-memory-arguments +cekApplyCost-exBudgetCPU +cekApplyCost-exBudgetMemory +cekBuiltinCost-exBudgetCPU +cekBuiltinCost-exBudgetMemory +cekConstCost-exBudgetCPU +cekConstCost-exBudgetMemory +cekDelayCost-exBudgetCPU +cekDelayCost-exBudgetMemory +cekForceCost-exBudgetCPU +cekForceCost-exBudgetMemory +cekLamCost-exBudgetCPU +cekLamCost-exBudgetMemory +cekStartupCost-exBudgetCPU +cekStartupCost-exBudgetMemory +cekVarCost-exBudgetCPU +cekVarCost-exBudgetMemory +chooseData-cpu-arguments +chooseData-memory-arguments +chooseList-cpu-arguments +chooseList-memory-arguments +chooseUnit-cpu-arguments +chooseUnit-memory-arguments +consByteString-cpu-arguments-intercept +consByteString-cpu-arguments-slope +consByteString-memory-arguments-intercept +consByteString-memory-arguments-slope +constrData-cpu-arguments +constrData-memory-arguments +decodeUtf8-cpu-arguments-intercept +decodeUtf8-cpu-arguments-slope +decodeUtf8-memory-arguments-intercept +decodeUtf8-memory-arguments-slope +divideInteger-cpu-arguments-constant +divideInteger-cpu-arguments-model-arguments-c00 +divideInteger-cpu-arguments-model-arguments-c01 +divideInteger-cpu-arguments-model-arguments-c02 +divideInteger-cpu-arguments-model-arguments-c10 +divideInteger-cpu-arguments-model-arguments-c11 +divideInteger-cpu-arguments-model-arguments-c20 +divideInteger-cpu-arguments-model-arguments-minimum +divideInteger-memory-arguments-intercept +divideInteger-memory-arguments-minimum +divideInteger-memory-arguments-slope +encodeUtf8-cpu-arguments-intercept +encodeUtf8-cpu-arguments-slope +encodeUtf8-memory-arguments-intercept +encodeUtf8-memory-arguments-slope +equalsByteString-cpu-arguments-constant +equalsByteString-cpu-arguments-intercept +equalsByteString-cpu-arguments-slope +equalsByteString-memory-arguments +equalsData-cpu-arguments-intercept +equalsData-cpu-arguments-slope +equalsData-memory-arguments +equalsInteger-cpu-arguments-intercept +equalsInteger-cpu-arguments-slope +equalsInteger-memory-arguments +equalsString-cpu-arguments-constant +equalsString-cpu-arguments-intercept +equalsString-cpu-arguments-slope +equalsString-memory-arguments +fstPair-cpu-arguments +fstPair-memory-arguments +headList-cpu-arguments +headList-memory-arguments +iData-cpu-arguments +iData-memory-arguments +ifThenElse-cpu-arguments +ifThenElse-memory-arguments +indexByteString-cpu-arguments +indexByteString-memory-arguments +lengthOfByteString-cpu-arguments +lengthOfByteString-memory-arguments +lessThanByteString-cpu-arguments-intercept +lessThanByteString-cpu-arguments-slope +lessThanByteString-memory-arguments +lessThanEqualsByteString-cpu-arguments-intercept +lessThanEqualsByteString-cpu-arguments-slope +lessThanEqualsByteString-memory-arguments +lessThanEqualsInteger-cpu-arguments-intercept +lessThanEqualsInteger-cpu-arguments-slope +lessThanEqualsInteger-memory-arguments +lessThanInteger-cpu-arguments-intercept +lessThanInteger-cpu-arguments-slope +lessThanInteger-memory-arguments +listData-cpu-arguments +listData-memory-arguments +mapData-cpu-arguments +mapData-memory-arguments +mkCons-cpu-arguments +mkCons-memory-arguments +mkNilData-cpu-arguments +mkNilData-memory-arguments +mkNilPairData-cpu-arguments +mkNilPairData-memory-arguments +mkPairData-cpu-arguments +mkPairData-memory-arguments +modInteger-cpu-arguments-constant +modInteger-cpu-arguments-model-arguments-c00 +modInteger-cpu-arguments-model-arguments-c01 +modInteger-cpu-arguments-model-arguments-c02 +modInteger-cpu-arguments-model-arguments-c10 +modInteger-cpu-arguments-model-arguments-c11 +modInteger-cpu-arguments-model-arguments-c20 +modInteger-cpu-arguments-model-arguments-minimum +modInteger-memory-arguments-intercept +modInteger-memory-arguments-slope +multiplyInteger-cpu-arguments-intercept +multiplyInteger-cpu-arguments-slope +multiplyInteger-memory-arguments-intercept +multiplyInteger-memory-arguments-slope +nullList-cpu-arguments +nullList-memory-arguments +quotientInteger-cpu-arguments-constant +quotientInteger-cpu-arguments-model-arguments-c00 +quotientInteger-cpu-arguments-model-arguments-c01 +quotientInteger-cpu-arguments-model-arguments-c02 +quotientInteger-cpu-arguments-model-arguments-c10 +quotientInteger-cpu-arguments-model-arguments-c11 +quotientInteger-cpu-arguments-model-arguments-c20 +quotientInteger-cpu-arguments-model-arguments-minimum +quotientInteger-memory-arguments-intercept +quotientInteger-memory-arguments-minimum +quotientInteger-memory-arguments-slope +remainderInteger-cpu-arguments-constant +remainderInteger-cpu-arguments-model-arguments-c00 +remainderInteger-cpu-arguments-model-arguments-c01 +remainderInteger-cpu-arguments-model-arguments-c02 +remainderInteger-cpu-arguments-model-arguments-c10 +remainderInteger-cpu-arguments-model-arguments-c11 +remainderInteger-cpu-arguments-model-arguments-c20 +remainderInteger-cpu-arguments-model-arguments-minimum +remainderInteger-memory-arguments-intercept +remainderInteger-memory-arguments-slope +serialiseData-cpu-arguments-intercept +serialiseData-cpu-arguments-slope +serialiseData-memory-arguments-intercept +serialiseData-memory-arguments-slope +sha2_256-cpu-arguments-intercept +sha2_256-cpu-arguments-slope +sha2_256-memory-arguments +sha3_256-cpu-arguments-intercept +sha3_256-cpu-arguments-slope +sha3_256-memory-arguments +sliceByteString-cpu-arguments-intercept +sliceByteString-cpu-arguments-slope +sliceByteString-memory-arguments-intercept +sliceByteString-memory-arguments-slope +sndPair-cpu-arguments +sndPair-memory-arguments +subtractInteger-cpu-arguments-intercept +subtractInteger-cpu-arguments-slope +subtractInteger-memory-arguments-intercept +subtractInteger-memory-arguments-slope +tailList-cpu-arguments +tailList-memory-arguments +trace-cpu-arguments +trace-memory-arguments +unBData-cpu-arguments +unBData-memory-arguments +unConstrData-cpu-arguments +unConstrData-memory-arguments +unIData-cpu-arguments +unIData-memory-arguments +unListData-cpu-arguments +unListData-memory-arguments +unMapData-cpu-arguments +unMapData-memory-arguments +verifyEcdsaSecp256k1Signature-cpu-arguments +verifyEcdsaSecp256k1Signature-memory-arguments +verifyEd25519Signature-cpu-arguments-intercept +verifyEd25519Signature-cpu-arguments-slope +verifyEd25519Signature-memory-arguments +verifySchnorrSecp256k1Signature-cpu-arguments-intercept +verifySchnorrSecp256k1Signature-cpu-arguments-slope +verifySchnorrSecp256k1Signature-memory-arguments +cekConstrCost-exBudgetCPU +cekConstrCost-exBudgetMemory +cekCaseCost-exBudgetCPU +cekCaseCost-exBudgetMemory +bls12_381_G1_add-cpu-arguments +bls12_381_G1_add-memory-arguments +bls12_381_G1_compress-cpu-arguments +bls12_381_G1_compress-memory-arguments +bls12_381_G1_equal-cpu-arguments +bls12_381_G1_equal-memory-arguments +bls12_381_G1_hashToGroup-cpu-arguments-intercept +bls12_381_G1_hashToGroup-cpu-arguments-slope +bls12_381_G1_hashToGroup-memory-arguments +bls12_381_G1_neg-cpu-arguments +bls12_381_G1_neg-memory-arguments +bls12_381_G1_scalarMul-cpu-arguments-intercept +bls12_381_G1_scalarMul-cpu-arguments-slope +bls12_381_G1_scalarMul-memory-arguments +bls12_381_G1_uncompress-cpu-arguments +bls12_381_G1_uncompress-memory-arguments +bls12_381_G2_add-cpu-arguments +bls12_381_G2_add-memory-arguments +bls12_381_G2_compress-cpu-arguments +bls12_381_G2_compress-memory-arguments +bls12_381_G2_equal-cpu-arguments +bls12_381_G2_equal-memory-arguments +bls12_381_G2_hashToGroup-cpu-arguments-intercept +bls12_381_G2_hashToGroup-cpu-arguments-slope +bls12_381_G2_hashToGroup-memory-arguments +bls12_381_G2_neg-cpu-arguments +bls12_381_G2_neg-memory-arguments +bls12_381_G2_scalarMul-cpu-arguments-intercept +bls12_381_G2_scalarMul-cpu-arguments-slope +bls12_381_G2_scalarMul-memory-arguments +bls12_381_G2_uncompress-cpu-arguments +bls12_381_G2_uncompress-memory-arguments +bls12_381_finalVerify-cpu-arguments +bls12_381_finalVerify-memory-arguments +bls12_381_millerLoop-cpu-arguments +bls12_381_millerLoop-memory-arguments +bls12_381_mulMlResult-cpu-arguments +bls12_381_mulMlResult-memory-arguments +keccak_256-cpu-arguments-intercept +keccak_256-cpu-arguments-slope +keccak_256-memory-arguments +blake2b_224-cpu-arguments-intercept +blake2b_224-cpu-arguments-slope +blake2b_224-memory-arguments +integerToByteString-cpu-arguments-c0 +integerToByteString-cpu-arguments-c1 +integerToByteString-cpu-arguments-c2 +integerToByteString-memory-arguments-intercept +integerToByteString-memory-arguments-slope +byteStringToInteger-cpu-arguments-c0 +byteStringToInteger-cpu-arguments-c1 +byteStringToInteger-cpu-arguments-c2 +byteStringToInteger-memory-arguments-intercept +byteStringToInteger-memory-arguments-slope +andByteString-cpu-arguments-intercept +andByteString-cpu-arguments-slope1 +andByteString-cpu-arguments-slope2 +andByteString-memory-arguments-intercept +andByteString-memory-arguments-slope +orByteString-cpu-arguments-intercept +orByteString-cpu-arguments-slope1 +orByteString-cpu-arguments-slope2 +orByteString-memory-arguments-intercept +orByteString-memory-arguments-slope +xorByteString-cpu-arguments-intercept +xorByteString-cpu-arguments-slope1 +xorByteString-cpu-arguments-slope2 +xorByteString-memory-arguments-intercept +xorByteString-memory-arguments-slope +complementByteString-cpu-arguments-intercept +complementByteString-cpu-arguments-slope +complementByteString-memory-arguments-intercept +complementByteString-memory-arguments-slope +readBit-cpu-arguments +readBit-memory-arguments +writeBits-cpu-arguments-intercept +writeBits-cpu-arguments-slope +writeBits-memory-arguments-intercept +writeBits-memory-arguments-slope +replicateByte-cpu-arguments-intercept +replicateByte-cpu-arguments-slope +replicateByte-memory-arguments-intercept +replicateByte-memory-arguments-slope +shiftByteString-cpu-arguments-intercept +shiftByteString-cpu-arguments-slope +shiftByteString-memory-arguments-intercept +shiftByteString-memory-arguments-slope +rotateByteString-cpu-arguments-intercept +rotateByteString-cpu-arguments-slope +rotateByteString-memory-arguments-intercept +rotateByteString-memory-arguments-slope +countSetBits-cpu-arguments-intercept +countSetBits-cpu-arguments-slope +countSetBits-memory-arguments +findFirstSetBit-cpu-arguments-intercept +findFirstSetBit-cpu-arguments-slope +findFirstSetBit-memory-arguments +ripemd_160-cpu-arguments-intercept +ripemd_160-cpu-arguments-slope +ripemd_160-memory-arguments +lengthArray-cpu-arguments +lengthArray-memory-arguments +listToArray-cpu-arguments +listToArray-memory-arguments +indexArray-cpu-arguments +indexArray-memory-arguments diff --git a/plutus-ledger-api/CostModel/Params/CostModelParams/costModelParamNames.txt.golden b/plutus-ledger-api/CostModel/Params/CostModelParams/costModelParamNames.txt.golden new file mode 100644 index 00000000000..af03f20c567 --- /dev/null +++ b/plutus-ledger-api/CostModel/Params/CostModelParams/costModelParamNames.txt.golden @@ -0,0 +1,297 @@ +addInteger-cpu-arguments-intercept +addInteger-cpu-arguments-slope +addInteger-memory-arguments-intercept +addInteger-memory-arguments-slope +appendByteString-cpu-arguments-intercept +appendByteString-cpu-arguments-slope +appendByteString-memory-arguments-intercept +appendByteString-memory-arguments-slope +appendString-cpu-arguments-intercept +appendString-cpu-arguments-slope +appendString-memory-arguments-intercept +appendString-memory-arguments-slope +bData-cpu-arguments +bData-memory-arguments +blake2b_256-cpu-arguments-intercept +blake2b_256-cpu-arguments-slope +blake2b_256-memory-arguments +cekApplyCost-exBudgetCPU +cekApplyCost-exBudgetMemory +cekBuiltinCost-exBudgetCPU +cekBuiltinCost-exBudgetMemory +cekConstCost-exBudgetCPU +cekConstCost-exBudgetMemory +cekDelayCost-exBudgetCPU +cekDelayCost-exBudgetMemory +cekForceCost-exBudgetCPU +cekForceCost-exBudgetMemory +cekLamCost-exBudgetCPU +cekLamCost-exBudgetMemory +cekStartupCost-exBudgetCPU +cekStartupCost-exBudgetMemory +cekVarCost-exBudgetCPU +cekVarCost-exBudgetMemory +chooseData-cpu-arguments +chooseData-memory-arguments +chooseList-cpu-arguments +chooseList-memory-arguments +chooseUnit-cpu-arguments +chooseUnit-memory-arguments +consByteString-cpu-arguments-intercept +consByteString-cpu-arguments-slope +consByteString-memory-arguments-intercept +consByteString-memory-arguments-slope +constrData-cpu-arguments +constrData-memory-arguments +decodeUtf8-cpu-arguments-intercept +decodeUtf8-cpu-arguments-slope +decodeUtf8-memory-arguments-intercept +decodeUtf8-memory-arguments-slope +divideInteger-cpu-arguments-constant +divideInteger-cpu-arguments-model-arguments-c00 +divideInteger-cpu-arguments-model-arguments-c01 +divideInteger-cpu-arguments-model-arguments-c02 +divideInteger-cpu-arguments-model-arguments-c10 +divideInteger-cpu-arguments-model-arguments-c11 +divideInteger-cpu-arguments-model-arguments-c20 +divideInteger-cpu-arguments-model-arguments-minimum +divideInteger-memory-arguments-intercept +divideInteger-memory-arguments-minimum +divideInteger-memory-arguments-slope +encodeUtf8-cpu-arguments-intercept +encodeUtf8-cpu-arguments-slope +encodeUtf8-memory-arguments-intercept +encodeUtf8-memory-arguments-slope +equalsByteString-cpu-arguments-constant +equalsByteString-cpu-arguments-intercept +equalsByteString-cpu-arguments-slope +equalsByteString-memory-arguments +equalsData-cpu-arguments-intercept +equalsData-cpu-arguments-slope +equalsData-memory-arguments +equalsInteger-cpu-arguments-intercept +equalsInteger-cpu-arguments-slope +equalsInteger-memory-arguments +equalsString-cpu-arguments-constant +equalsString-cpu-arguments-intercept +equalsString-cpu-arguments-slope +equalsString-memory-arguments +fstPair-cpu-arguments +fstPair-memory-arguments +headList-cpu-arguments +headList-memory-arguments +iData-cpu-arguments +iData-memory-arguments +ifThenElse-cpu-arguments +ifThenElse-memory-arguments +indexByteString-cpu-arguments +indexByteString-memory-arguments +lengthOfByteString-cpu-arguments +lengthOfByteString-memory-arguments +lessThanByteString-cpu-arguments-intercept +lessThanByteString-cpu-arguments-slope +lessThanByteString-memory-arguments +lessThanEqualsByteString-cpu-arguments-intercept +lessThanEqualsByteString-cpu-arguments-slope +lessThanEqualsByteString-memory-arguments +lessThanEqualsInteger-cpu-arguments-intercept +lessThanEqualsInteger-cpu-arguments-slope +lessThanEqualsInteger-memory-arguments +lessThanInteger-cpu-arguments-intercept +lessThanInteger-cpu-arguments-slope +lessThanInteger-memory-arguments +listData-cpu-arguments +listData-memory-arguments +mapData-cpu-arguments +mapData-memory-arguments +mkCons-cpu-arguments +mkCons-memory-arguments +mkNilData-cpu-arguments +mkNilData-memory-arguments +mkNilPairData-cpu-arguments +mkNilPairData-memory-arguments +mkPairData-cpu-arguments +mkPairData-memory-arguments +modInteger-cpu-arguments-constant +modInteger-cpu-arguments-model-arguments-c00 +modInteger-cpu-arguments-model-arguments-c01 +modInteger-cpu-arguments-model-arguments-c02 +modInteger-cpu-arguments-model-arguments-c10 +modInteger-cpu-arguments-model-arguments-c11 +modInteger-cpu-arguments-model-arguments-c20 +modInteger-cpu-arguments-model-arguments-minimum +modInteger-memory-arguments-intercept +modInteger-memory-arguments-slope +multiplyInteger-cpu-arguments-intercept +multiplyInteger-cpu-arguments-slope +multiplyInteger-memory-arguments-intercept +multiplyInteger-memory-arguments-slope +nullList-cpu-arguments +nullList-memory-arguments +quotientInteger-cpu-arguments-constant +quotientInteger-cpu-arguments-model-arguments-c00 +quotientInteger-cpu-arguments-model-arguments-c01 +quotientInteger-cpu-arguments-model-arguments-c02 +quotientInteger-cpu-arguments-model-arguments-c10 +quotientInteger-cpu-arguments-model-arguments-c11 +quotientInteger-cpu-arguments-model-arguments-c20 +quotientInteger-cpu-arguments-model-arguments-minimum +quotientInteger-memory-arguments-intercept +quotientInteger-memory-arguments-minimum +quotientInteger-memory-arguments-slope +remainderInteger-cpu-arguments-constant +remainderInteger-cpu-arguments-model-arguments-c00 +remainderInteger-cpu-arguments-model-arguments-c01 +remainderInteger-cpu-arguments-model-arguments-c02 +remainderInteger-cpu-arguments-model-arguments-c10 +remainderInteger-cpu-arguments-model-arguments-c11 +remainderInteger-cpu-arguments-model-arguments-c20 +remainderInteger-cpu-arguments-model-arguments-minimum +remainderInteger-memory-arguments-intercept +remainderInteger-memory-arguments-slope +serialiseData-cpu-arguments-intercept +serialiseData-cpu-arguments-slope +serialiseData-memory-arguments-intercept +serialiseData-memory-arguments-slope +sha2_256-cpu-arguments-intercept +sha2_256-cpu-arguments-slope +sha2_256-memory-arguments +sha3_256-cpu-arguments-intercept +sha3_256-cpu-arguments-slope +sha3_256-memory-arguments +sliceByteString-cpu-arguments-intercept +sliceByteString-cpu-arguments-slope +sliceByteString-memory-arguments-intercept +sliceByteString-memory-arguments-slope +sndPair-cpu-arguments +sndPair-memory-arguments +subtractInteger-cpu-arguments-intercept +subtractInteger-cpu-arguments-slope +subtractInteger-memory-arguments-intercept +subtractInteger-memory-arguments-slope +tailList-cpu-arguments +tailList-memory-arguments +trace-cpu-arguments +trace-memory-arguments +unBData-cpu-arguments +unBData-memory-arguments +unConstrData-cpu-arguments +unConstrData-memory-arguments +unIData-cpu-arguments +unIData-memory-arguments +unListData-cpu-arguments +unListData-memory-arguments +unMapData-cpu-arguments +unMapData-memory-arguments +verifyEcdsaSecp256k1Signature-cpu-arguments +verifyEcdsaSecp256k1Signature-memory-arguments +verifyEd25519Signature-cpu-arguments-intercept +verifyEd25519Signature-cpu-arguments-slope +verifyEd25519Signature-memory-arguments +verifySchnorrSecp256k1Signature-cpu-arguments-intercept +verifySchnorrSecp256k1Signature-cpu-arguments-slope +verifySchnorrSecp256k1Signature-memory-arguments +cekConstrCost-exBudgetCPU +cekConstrCost-exBudgetMemory +cekCaseCost-exBudgetCPU +cekCaseCost-exBudgetMemory +bls12_381_G1_add-cpu-arguments +bls12_381_G1_add-memory-arguments +bls12_381_G1_compress-cpu-arguments +bls12_381_G1_compress-memory-arguments +bls12_381_G1_equal-cpu-arguments +bls12_381_G1_equal-memory-arguments +bls12_381_G1_hashToGroup-cpu-arguments-intercept +bls12_381_G1_hashToGroup-cpu-arguments-slope +bls12_381_G1_hashToGroup-memory-arguments +bls12_381_G1_neg-cpu-arguments +bls12_381_G1_neg-memory-arguments +bls12_381_G1_scalarMul-cpu-arguments-intercept +bls12_381_G1_scalarMul-cpu-arguments-slope +bls12_381_G1_scalarMul-memory-arguments +bls12_381_G1_uncompress-cpu-arguments +bls12_381_G1_uncompress-memory-arguments +bls12_381_G2_add-cpu-arguments +bls12_381_G2_add-memory-arguments +bls12_381_G2_compress-cpu-arguments +bls12_381_G2_compress-memory-arguments +bls12_381_G2_equal-cpu-arguments +bls12_381_G2_equal-memory-arguments +bls12_381_G2_hashToGroup-cpu-arguments-intercept +bls12_381_G2_hashToGroup-cpu-arguments-slope +bls12_381_G2_hashToGroup-memory-arguments +bls12_381_G2_neg-cpu-arguments +bls12_381_G2_neg-memory-arguments +bls12_381_G2_scalarMul-cpu-arguments-intercept +bls12_381_G2_scalarMul-cpu-arguments-slope +bls12_381_G2_scalarMul-memory-arguments +bls12_381_G2_uncompress-cpu-arguments +bls12_381_G2_uncompress-memory-arguments +bls12_381_finalVerify-cpu-arguments +bls12_381_finalVerify-memory-arguments +bls12_381_millerLoop-cpu-arguments +bls12_381_millerLoop-memory-arguments +bls12_381_mulMlResult-cpu-arguments +bls12_381_mulMlResult-memory-arguments +keccak_256-cpu-arguments-intercept +keccak_256-cpu-arguments-slope +keccak_256-memory-arguments +blake2b_224-cpu-arguments-intercept +blake2b_224-cpu-arguments-slope +blake2b_224-memory-arguments +integerToByteString-cpu-arguments-c0 +integerToByteString-cpu-arguments-c1 +integerToByteString-cpu-arguments-c2 +integerToByteString-memory-arguments-intercept +integerToByteString-memory-arguments-slope +byteStringToInteger-cpu-arguments-c0 +byteStringToInteger-cpu-arguments-c1 +byteStringToInteger-cpu-arguments-c2 +byteStringToInteger-memory-arguments-intercept +byteStringToInteger-memory-arguments-slope +andByteString-cpu-arguments-intercept +andByteString-cpu-arguments-slope1 +andByteString-cpu-arguments-slope2 +andByteString-memory-arguments-intercept +andByteString-memory-arguments-slope +orByteString-cpu-arguments-intercept +orByteString-cpu-arguments-slope1 +orByteString-cpu-arguments-slope2 +orByteString-memory-arguments-intercept +orByteString-memory-arguments-slope +xorByteString-cpu-arguments-intercept +xorByteString-cpu-arguments-slope1 +xorByteString-cpu-arguments-slope2 +xorByteString-memory-arguments-intercept +xorByteString-memory-arguments-slope +complementByteString-cpu-arguments-intercept +complementByteString-cpu-arguments-slope +complementByteString-memory-arguments-intercept +complementByteString-memory-arguments-slope +readBit-cpu-arguments +readBit-memory-arguments +writeBits-cpu-arguments-intercept +writeBits-cpu-arguments-slope +writeBits-memory-arguments-intercept +writeBits-memory-arguments-slope +replicateByte-cpu-arguments-intercept +replicateByte-cpu-arguments-slope +replicateByte-memory-arguments-intercept +replicateByte-memory-arguments-slope +shiftByteString-cpu-arguments-intercept +shiftByteString-cpu-arguments-slope +shiftByteString-memory-arguments-intercept +shiftByteString-memory-arguments-slope +rotateByteString-cpu-arguments-intercept +rotateByteString-cpu-arguments-slope +rotateByteString-memory-arguments-intercept +rotateByteString-memory-arguments-slope +countSetBits-cpu-arguments-intercept +countSetBits-cpu-arguments-slope +countSetBits-memory-arguments +findFirstSetBit-cpu-arguments-intercept +findFirstSetBit-cpu-arguments-slope +findFirstSetBit-memory-arguments +ripemd_160-cpu-arguments-intercept +ripemd_160-cpu-arguments-slope +ripemd_160-memory-arguments diff --git a/plutus-ledger-api/plutus-ledger-api.cabal b/plutus-ledger-api/plutus-ledger-api.cabal index 2f2d9f33c58..525d97eafa7 100644 --- a/plutus-ledger-api/plutus-ledger-api.cabal +++ b/plutus-ledger-api/plutus-ledger-api.cabal @@ -200,6 +200,7 @@ test-suite plutus-ledger-api-test , tasty-hedgehog , tasty-hunit , tasty-quickcheck + , text -- A suite for tests that use the Plutus Tx plugin. We don't merge those into -- @plutus-ledger-api-test@, because @plutus-ledger-api@ has to be buildable for older versions of diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs index 7bc05d3fc91..84b25e9b5ad 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs @@ -101,6 +101,9 @@ builtinsIntroducedIn = Map.fromList [ ChooseData, ConstrData, MapData, ListData, IData, BData, UnConstrData, UnMapData, UnListData, UnIData, UnBData, EqualsData, MkPairData, MkNilData, MkNilPairData ]), + ((PlutusV1, futurePV), Set.fromList [ + ListToArray, IndexArray, LengthArray + ]), ((PlutusV2, vasilPV), Set.fromList [ SerialiseData ]), @@ -110,6 +113,9 @@ builtinsIntroducedIn = Map.fromList [ ((PlutusV2, plominPV), Set.fromList [ IntegerToByteString, ByteStringToInteger ]), + ((PlutusV2, futurePV), Set.fromList [ + ListToArray, IndexArray, LengthArray + ]), ((PlutusV3, changPV), Set.fromList [ Bls12_381_G1_add, Bls12_381_G1_neg, Bls12_381_G1_scalarMul, Bls12_381_G1_equal, Bls12_381_G1_hashToGroup, @@ -128,8 +134,8 @@ builtinsIntroducedIn = Map.fromList [ ]), ((PlutusV3, futurePV), Set.fromList [ ExpModInteger, - CaseList, CaseData, - DropList + CaseList, CaseData, DropList, + ListToArray, IndexArray, LengthArray ]) ] diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/ParamName.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/ParamName.hs index c4007c855f5..b5ecd9f50ac 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/ParamName.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/ParamName.hs @@ -181,6 +181,12 @@ data ParamName = | VerifyEd25519Signature'cpu'arguments'intercept | VerifyEd25519Signature'cpu'arguments'slope | VerifyEd25519Signature'memory'arguments + | LengthArray'cpu'arguments + | LengthArray'memory'arguments + | ListToArray'cpu'arguments + | ListToArray'memory'arguments + | IndexArray'cpu'arguments + | IndexArray'memory'arguments deriving stock (Eq, Ord, Enum, Ix, Bounded, Generic) deriving IsParamName via (GenericParamName ParamName) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V2/ParamName.hs b/plutus-ledger-api/src/PlutusLedgerApi/V2/ParamName.hs index 1f6ef6f5610..34a639d79bd 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V2/ParamName.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V2/ParamName.hs @@ -200,5 +200,11 @@ data ParamName = | ByteStringToInteger'cpu'arguments'c2 | ByteStringToInteger'memory'arguments'intercept | ByteStringToInteger'memory'arguments'slope + | LengthArray'cpu'arguments + | LengthArray'memory'arguments + | ListToArray'cpu'arguments + | ListToArray'memory'arguments + | IndexArray'cpu'arguments + | IndexArray'memory'arguments deriving stock (Eq, Ord, Enum, Ix, Bounded, Generic) deriving IsParamName via (GenericParamName ParamName) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3/ParamName.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3/ParamName.hs index 40022b17a08..c585ecc4c05 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3/ParamName.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3/ParamName.hs @@ -313,7 +313,12 @@ data ParamName = | Ripemd_160'cpu'arguments'intercept | Ripemd_160'cpu'arguments'slope | Ripemd_160'memory'arguments - + | LengthArray'cpu'arguments + | LengthArray'memory'arguments + | ListToArray'cpu'arguments + | ListToArray'memory'arguments + | IndexArray'cpu'arguments + | IndexArray'memory'arguments -- not enabled yet: -- ExpModInteger'cpu'arguments -- ExpModInteger'memory'arguments diff --git a/plutus-ledger-api/test/Spec.hs b/plutus-ledger-api/test/Spec.hs index 3255e2a12dc..b0ca1635941 100644 --- a/plutus-ledger-api/test/Spec.hs +++ b/plutus-ledger-api/test/Spec.hs @@ -1,4 +1,5 @@ --- editorconfig-checker-disable-file +{-# LANGUAGE BlockArguments #-} + module Main where import PlutusLedgerApi.Common.Versions @@ -22,6 +23,7 @@ import Spec.V1.Value qualified as Value import Spec.Versions qualified import Test.Tasty +import Test.Tasty.Extras import Test.Tasty.HUnit import Test.Tasty.QuickCheck @@ -33,31 +35,48 @@ main = defaultMain tests v1_evalCtxForTesting :: V1.EvaluationContext v1_evalCtxForTesting = - fst $ unsafeFromRight $ runWriterT $ V1.mkEvaluationContext (fmap snd V1.costModelParamsForTesting) + fst . unsafeFromRight . runWriterT . V1.mkEvaluationContext $ + fmap snd V1.costModelParamsForTesting {-| Constructing a V3 context with the first 223 parameters. -As a result, the cost model parameters for `integerToByteString` and `byteStringToInteger` -should be set to large numbers, preventing them from being used. +As a result, the cost model parameters for `integerToByteString` +and `byteStringToInteger` should be set to large numbers, preventing +them from being used. -} v3_evalCtxTooFewParams :: V3.EvaluationContext v3_evalCtxTooFewParams = - fst $ - unsafeFromRight $ - runWriterT $ - V3.mkEvaluationContext (take 223 $ fmap snd V3.costModelParamsForTesting) + fst . unsafeFromRight . runWriterT $ + V3.mkEvaluationContext . take 223 $ + fmap snd V3.costModelParamsForTesting alwaysTrue :: TestTree alwaysTrue = testCase "always true script returns true" $ - let script = either (error . show) id $ V1.deserialiseScript alonzoPV (alwaysSucceedingNAryFunction 2) - (_, res) = V1.evaluateScriptCounting alonzoPV V1.Quiet v1_evalCtxForTesting script [I 1, I 2] + let script = + either (error . show) id $ + V1.deserialiseScript alonzoPV (alwaysSucceedingNAryFunction 2) + (_, res) = + V1.evaluateScriptCounting + alonzoPV + V1.Quiet + v1_evalCtxForTesting + script + [I 1, I 2] in assertBool "succeeds" (isRight res) alwaysFalse :: TestTree alwaysFalse = testCase "always false script returns false" $ - let script = either (error . show) id $ V1.deserialiseScript alonzoPV (alwaysFailingNAryFunction 2) - (_, res) = V1.evaluateScriptCounting alonzoPV V1.Quiet v1_evalCtxForTesting script [I 1, I 2] + let script = + either (error . show) id $ + V1.deserialiseScript alonzoPV (alwaysFailingNAryFunction 2) + (_, res) = + V1.evaluateScriptCounting + alonzoPV + V1.Quiet + v1_evalCtxForTesting + script + [I 1, I 2] in assertBool "fails" (isLeft res) unavailableBuiltins :: TestTree @@ -75,27 +94,50 @@ availableBuiltins = integerToByteStringExceedsBudget :: TestTree integerToByteStringExceedsBudget = testCase "integerToByteString should exceed budget" $ - let script = either (error . show) id $ V3.deserialiseScript changPV integerToByteStringFunction - (_, res) = V3.evaluateScriptCounting changPV V3.Quiet v3_evalCtxTooFewParams script (I 1) + let script = + either (error . show) id $ + V3.deserialiseScript changPV integerToByteStringFunction + (_, res) = + V3.evaluateScriptCounting + changPV + V3.Quiet + v3_evalCtxTooFewParams + script + (I 1) in case res of Left _ -> assertFailure "fails" - Right (ExBudget cpu _mem) -> assertBool "did not exceed budget" (cpu >= fromIntegral (maxBound :: Int64)) + Right (ExBudget cpu _mem) -> + assertBool + "did not exceed budget" + (cpu >= fromIntegral (maxBound :: Int64)) saltedFunction :: TestTree saltedFunction = let evaluate ss ss' args = let s = either (error . show) id $ V1.deserialiseScript alonzoPV ss s' = either (error . show) id $ V1.deserialiseScript alonzoPV ss' - in ( V1.evaluateScriptCounting alonzoPV V1.Quiet v1_evalCtxForTesting s args - , V1.evaluateScriptCounting alonzoPV V1.Quiet v1_evalCtxForTesting s' args + in ( V1.evaluateScriptCounting + alonzoPV + V1.Quiet + v1_evalCtxForTesting + s + args + , V1.evaluateScriptCounting + alonzoPV + V1.Quiet + v1_evalCtxForTesting + s' + args ) in testGroup "salted function" - [ testProperty "saturated" $ \(n :: Word8) salt fWhich -> + [ testProperty "saturated" \(n :: Word8) salt fWhich -> let f = - (if fWhich then alwaysSucceedingNAryFunction else alwaysFailingNAryFunction) $ - fromInteger $ - toInteger n + ( if fWhich + then alwaysSucceedingNAryFunction + else alwaysFailingNAryFunction + ) + (fromInteger (toInteger n)) f' = saltFunction salt f args = replicate (fromEnum n) $ I 1 ((_, res), (_, res')) = evaluate f f' args @@ -105,29 +147,39 @@ saltedFunction = === void res' .&&. fWhich === isRight res - , testProperty "unsaturated" $ \(n :: Word8) (n' :: Word8) salt fWhich -> + , testProperty "unsaturated" \(n :: Word8) (n' :: Word8) salt fWhich -> let f = - (if fWhich then alwaysSucceedingNAryFunction else alwaysFailingNAryFunction) $ - fromInteger (toInteger n) + fromInteger (toInteger n') + 1 + ( if fWhich + then alwaysSucceedingNAryFunction + else alwaysFailingNAryFunction + ) + (fromInteger (toInteger n) + fromInteger (toInteger n') + 1) f' = saltFunction salt f args = replicate (fromEnum n) $ I 1 ((_, res), (_, res')) = evaluate f f' args in cover 25 (isRight res) "success" $ void res === void res' - , testProperty "oversaturated" $ \(n :: Word8) (n' :: Word8) salt fWhich -> - let f = - (if fWhich then alwaysSucceedingNAryFunction else alwaysFailingNAryFunction) $ - fromInteger (toInteger n) - f' = saltFunction salt f - args = replicate (fromEnum n + fromEnum n' + 1) $ I 1 - ((_, res), (_, res')) = evaluate f f' args - in cover 25 (isLeft res) "fail" $ - void res === void res' - , testProperty "salt" $ \(n :: Word8) salt salt' fWhich -> + , testProperty + "oversaturated" + \(n :: Word8) (n' :: Word8) salt fWhich -> + let f = + ( if fWhich + then alwaysSucceedingNAryFunction + else alwaysFailingNAryFunction + ) + (fromInteger (toInteger n)) + f' = saltFunction salt f + args = replicate (fromEnum n + fromEnum n' + 1) $ I 1 + ((_, res), (_, res')) = evaluate f f' args + in cover 25 (isLeft res) "fail" $ + void res === void res' + , testProperty "salt" \(n :: Word8) salt salt' fWhich -> let f = - (if fWhich then alwaysSucceedingNAryFunction else alwaysFailingNAryFunction) $ - fromInteger $ - toInteger n + ( if fWhich + then alwaysSucceedingNAryFunction + else alwaysFailingNAryFunction + ) + (fromInteger (toInteger n)) f' = saltFunction salt f f'' = saltFunction salt' f in salt /= salt' ==> f' /= f'' @@ -158,7 +210,7 @@ tests = "Original" [ Spec.Eval.tests , Spec.Versions.tests - , Spec.CostModelParams.tests + , runTestNested ["CostModel", "Params"] [Spec.CostModelParams.tests] , Spec.ContextDecoding.tests , Value.test_Value ] @@ -166,7 +218,9 @@ tests = "Data" [ Spec.Data.Eval.tests , Spec.Data.Versions.tests - , Spec.Data.CostModelParams.tests + , runTestNested + ["CostModel", "Data", "Params"] + [Spec.Data.CostModelParams.tests] , Data.Value.test_Value ] ] diff --git a/plutus-ledger-api/test/Spec/CostModelParams.hs b/plutus-ledger-api/test/Spec/CostModelParams.hs index c5e45208009..18793527d3d 100644 --- a/plutus-ledger-api/test/Spec/CostModelParams.hs +++ b/plutus-ledger-api/test/Spec/CostModelParams.hs @@ -1,78 +1,112 @@ --- editorconfig-checker-disable-file +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} -module Spec.CostModelParams where - --- import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCostModelParamsForTesting) -import PlutusLedgerApi.Common +module Spec.CostModelParams where +import PlutusLedgerApi.Common (CostModelApplyWarn (CMTooManyParamsWarn, cmActual, cmExpected), + IsParamName (readParamName, showParamName)) import PlutusLedgerApi.Test.V3.EvaluationContext qualified as V3 -import PlutusLedgerApi.V1 as V1 -import PlutusLedgerApi.V2 as V2 -import PlutusLedgerApi.V3 as V3 +import PlutusLedgerApi.V1 qualified as V1 +import PlutusLedgerApi.V2 qualified as V2 +import PlutusLedgerApi.V3 qualified as V3 -import Control.Monad.Except -import Control.Monad.Writer.Strict -import Data.Either -import Data.Foldable -import Data.List.Extra -import Data.Set as Set -import Test.Tasty -import Test.Tasty.HUnit +import Control.Monad.Except (runExcept) +import Control.Monad.Writer.Strict (WriterT (runWriterT)) +import Data.Either (isRight) +import Data.Foldable (for_) +import Data.List.Extra (enumerate) +import Data.Set (isProperSubsetOf, isSubsetOf) +import Data.Set qualified as Set +import Data.Text qualified as Text +import Test.Tasty.Extras (TestNested, embed, nestedGoldenVsTextPredM, testNestedNamed) +import Test.Tasty.HUnit (assertBool, testCase, (@=?)) -tests :: TestTree +tests :: TestNested tests = - testGroup + testNestedNamed + "CostModelParams" "costModelParams" - [ testCase "length" $ do - 166 @=? length v1_ParamNames - 185 @=? length v2_ParamNames - 297 @=? length v3_ParamNames - , testCase "tripping paramname" $ do - for_ v1_ParamNames $ \ p -> - assertBool "tripping v1 cm params failed" $ Just p == readParamName (showParamName p) - for_ v2_ParamNames $ \ p -> - assertBool "tripping v2 cm params failed" $ Just p == readParamName (showParamName p) - for_ v3_ParamNames $ \ p -> - assertBool "tripping v3 cm params failed" $ Just p == readParamName (showParamName p) --- *** FIXME !!! *** : The introduction of the new bitwise builtins has messed --- this up because defaultCostModelParamsForTesting is the cost model parameters --- for model C, which now includes the new bitwise builtins. --- , testCase "default values costmodelparamsfortesting" $ do --- defaultCostModelParamsForTesting @=? Just (toCostModelParams V3.costModelParamsForTesting) - , testCase "context length" $ do - let costValuesForTesting = fmap snd V3.costModelParamsForTesting - -- the `costModelParamsForTesting` reflects only the latest version (V3), so this should succeed because the lengths match - assertBool "wrong number of arguments in V3.mkEvaluationContext" $ isRight $ runExcept $ runWriterT $ V3.mkEvaluationContext costValuesForTesting - -- this one should succeed because we allow adding new builtins to an existing version, by appending new cost model parameters, for more info: - -- See Note [Cost model parameters from the ledger's point of view] - assertBool "larger number of params did not warn" $ hasWarnMoreParams (length v3_ParamNames) (1 + length v3_ParamNames) $ - runExcept $ runWriterT $ V3.mkEvaluationContext $ costValuesForTesting ++ [1] -- dummy param value appended - , testCase "cost model parameters" $ do - -- v1 is missing some cost model parameters because new builtins are added in v2 - assertBool "v1 params is not a proper subset of v2 params" $ v1_ParamNames `paramProperSubset` v2_ParamNames - -- v1/v2 and v3 cost models are not comparable because we added new builtins in v3 but also - -- removed some superseded cost model parameters. - assertBool "v1 params and v3 params are comparable" $ - not (v1_ParamNames `paramSubset` v3_ParamNames) - && not (v3_ParamNames `paramSubset` v1_ParamNames) - assertBool "v2 params and v3 params are comparable" $ - not (v2_ParamNames `paramSubset` v3_ParamNames) - && not (v3_ParamNames `paramSubset` v2_ParamNames) + [ embed $ testCase "length" do + 172 @=? length v1_ParamNames + 191 @=? length v2_ParamNames + 303 @=? length v3_ParamNames + , embed $ testCase "tripping paramname" do + for_ v1_ParamNames \p -> + assertBool "tripping v1 cm params failed" $ + Just p == readParamName (showParamName p) + for_ v2_ParamNames \p -> + assertBool "tripping v2 cm params failed" $ + Just p == readParamName (showParamName p) + for_ v3_ParamNames \p -> + assertBool "tripping v3 cm params failed" $ + Just p == readParamName (showParamName p) + , -- \*** FIXME !!! *** : The introduction of the new bitwise builtins has + -- messed this up because defaultCostModelParamsForTesting is the cost + -- model parameters for model C, + -- which now includes the new bitwise builtins. + -- , testCase "default values costmodelparamsfortesting" do + -- defaultCostModelParamsForTesting + -- @=? Just (toCostModelParams V3.costModelParamsForTesting) + embed $ testCase "context length" do + let costValuesForTesting = fmap snd V3.costModelParamsForTesting + -- the `costModelParamsForTesting` reflects only the latest + -- version (V3), so this should succeed because the lengths match + assertBool "wrong number of arguments in V3.mkEvaluationContext" $ + isRight $ + runExcept $ + runWriterT $ + V3.mkEvaluationContext costValuesForTesting + -- this one should succeed because we allow adding new builtins to an + -- existing version, by appending new cost model parameters, + -- for more info: + -- See Note [Cost model parameters from the ledger's point of view] + assertBool "larger number of params did not warn" + $ hasWarnMoreParams + (length v3_ParamNames) + (1 + length v3_ParamNames) + $ runExcept + $ runWriterT + $ V3.mkEvaluationContext + $ costValuesForTesting ++ [1] -- dummy param value appended + , embed $ testCase "cost model parameters" do + -- v1 is missing some cost model parameters + -- because new builtins are added in v2 + assertBool "v1 params is not a proper subset of v2 params" $ + v1_ParamNames `paramProperSubset` v2_ParamNames + -- v1/v2 and v3 cost models are not comparable because we added + -- new builtins in v3 but also removed some superseded cost model + -- parameters. + assertBool "v1 params and v3 params are comparable" $ + not (v1_ParamNames `paramSubset` v3_ParamNames) + && not (v3_ParamNames `paramSubset` v1_ParamNames) + assertBool "v2 params and v3 params are comparable" $ + not (v2_ParamNames `paramSubset` v3_ParamNames) + && not (v3_ParamNames `paramSubset` v2_ParamNames) + , -- Fail if new cost model parameters names aren't appended to the end + nestedGoldenVsTextPredM + "costModelParamNames" + ".txt" + do pure (Text.unlines (map showParamName v3_ParamNames)) + Text.isPrefixOf ] - where - hasWarnMoreParams :: Int -> Int -> Either a (b, [CostModelApplyWarn]) -> Bool - hasWarnMoreParams testExpected testActual (Right (_,[CMTooManyParamsWarn{..}])) - | testExpected==cmExpected && testActual==cmActual = True - hasWarnMoreParams _ _ _ = False + where + hasWarnMoreParams :: Int -> Int -> Either a (b, [CostModelApplyWarn]) -> Bool + hasWarnMoreParams + testExpected + testActual + (Right (_, [CMTooManyParamsWarn{..}])) + | testExpected == cmExpected && testActual == cmActual = True + hasWarnMoreParams _ _ _ = False - paramProperSubset pA pB = - Set.fromList (showParamName <$> pA) `Set.isProperSubsetOf` Set.fromList (showParamName <$> pB) + paramProperSubset pA pB = + Set.fromList (showParamName <$> pA) + `isProperSubsetOf` Set.fromList (showParamName <$> pB) - paramSubset pA pB = - Set.fromList (showParamName <$> pA) `Set.isSubsetOf` Set.fromList (showParamName <$> pB) + paramSubset pA pB = + Set.fromList (showParamName <$> pA) + `isSubsetOf` Set.fromList (showParamName <$> pB) - v1_ParamNames = enumerate @V1.ParamName - v2_ParamNames = enumerate @V2.ParamName - v3_ParamNames = enumerate @V3.ParamName + v1_ParamNames = enumerate @V1.ParamName + v2_ParamNames = enumerate @V2.ParamName + v3_ParamNames = enumerate @V3.ParamName diff --git a/plutus-ledger-api/test/Spec/Data/CostModelParams.hs b/plutus-ledger-api/test/Spec/Data/CostModelParams.hs index 9a7eab8323a..3692cc9f7b5 100644 --- a/plutus-ledger-api/test/Spec/Data/CostModelParams.hs +++ b/plutus-ledger-api/test/Spec/Data/CostModelParams.hs @@ -1,76 +1,112 @@ --- editorconfig-checker-disable-file +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} -module Spec.Data.CostModelParams where -import PlutusLedgerApi.Common +module Spec.Data.CostModelParams where -import PlutusLedgerApi.Data.V1 as V1 -import PlutusLedgerApi.Data.V2 as V2 -import PlutusLedgerApi.Data.V3 as V3 +import PlutusLedgerApi.Common (CostModelApplyWarn (CMTooManyParamsWarn, cmActual, cmExpected), + IsParamName (readParamName, showParamName)) +import PlutusLedgerApi.Data.V1 qualified as V1 +import PlutusLedgerApi.Data.V2 qualified as V2 +import PlutusLedgerApi.Data.V3 qualified as V3 import PlutusLedgerApi.Test.V3.Data.EvaluationContext qualified as V3 -import Control.Monad.Except -import Control.Monad.Writer.Strict -import Data.Either -import Data.Foldable -import Data.List.Extra -import Data.Set as Set -import Test.Tasty -import Test.Tasty.HUnit +import Control.Monad.Except (runExcept) +import Control.Monad.Writer.Strict (WriterT (runWriterT)) +import Data.Either (isRight) +import Data.Foldable (for_) +import Data.List.Extra (enumerate) +import Data.Set (isProperSubsetOf, isSubsetOf) +import Data.Set qualified as Set +import Data.Text qualified as Text +import Test.Tasty.Extras (TestNested, embed, nestedGoldenVsTextPredM, testNestedNamed) +import Test.Tasty.HUnit (assertBool, testCase, (@=?)) -tests :: TestTree +tests :: TestNested tests = - testGroup + testNestedNamed + "CostModelParams" "costModelParams" - [ testCase "length" $ do - 166 @=? length v1_ParamNames - 185 @=? length v2_ParamNames - 297 @=? length v3_ParamNames - , testCase "tripping paramname" $ do - for_ v1_ParamNames $ \ p -> - assertBool "tripping v1 cm params failed" $ Just p == readParamName (showParamName p) - for_ v2_ParamNames $ \ p -> - assertBool "tripping v2 cm params failed" $ Just p == readParamName (showParamName p) - for_ v3_ParamNames $ \ p -> - assertBool "tripping v3 cm params failed" $ Just p == readParamName (showParamName p) --- *** FIXME !!! *** : The introduction of the new bitwise builtins has messed --- this up because defaultCostModelParamsForTesting is the cost model parameters --- for model C, which now includes the new bitwise builtins. --- , testCase "default values costmodelparamsfortesting" $ do --- defaultCostModelParamsForTesting @=? Just (toCostModelParams V3.costModelParamsForTesting) - , testCase "context length" $ do - let costValuesForTesting = fmap snd V3.costModelParamsForTesting - -- the `costModelParamsForTesting` reflects only the latest version (V3), so this should succeed because the lengths match - assertBool "wrong number of arguments in V3.mkEvaluationContext" $ isRight $ runExcept $ runWriterT $ V3.mkEvaluationContext costValuesForTesting - -- this one should succeed because we allow adding new builtins to an existing version, by appending new cost model parameters, for more info: - -- See Note [Cost model parameters from the ledger's point of view] - assertBool "larger number of params did not warn" $ hasWarnMoreParams (length v3_ParamNames) (1 + length v3_ParamNames) $ - runExcept $ runWriterT $ V3.mkEvaluationContext $ costValuesForTesting ++ [1] -- dummy param value appended - , testCase "cost model parameters" $ do - -- v1 is missing some cost model parameters because new builtins are added in v2 - assertBool "v1 params is not a proper subset of v2 params" $ v1_ParamNames `paramProperSubset` v2_ParamNames - -- v1/v2 and v3 cost models are not comparable because we added new builtins in v3 but also - -- removed some superseded cost model parameters. - assertBool "v1 params and v3 params are comparable" $ - not (v1_ParamNames `paramSubset` v3_ParamNames) - && not (v3_ParamNames `paramSubset` v1_ParamNames) - assertBool "v2 params and v3 params are comparable" $ - not (v2_ParamNames `paramSubset` v3_ParamNames) - && not (v3_ParamNames `paramSubset` v2_ParamNames) + [ embed $ testCase "length" do + 172 @=? length v1_ParamNames + 191 @=? length v2_ParamNames + 303 @=? length v3_ParamNames + , embed $ testCase "tripping paramname" do + for_ v1_ParamNames \p -> + assertBool "tripping v1 cm params failed" $ + Just p == readParamName (showParamName p) + for_ v2_ParamNames \p -> + assertBool "tripping v2 cm params failed" $ + Just p == readParamName (showParamName p) + for_ v3_ParamNames \p -> + assertBool "tripping v3 cm params failed" $ + Just p == readParamName (showParamName p) + , -- \*** FIXME !!! *** : The introduction of the new bitwise builtins has + -- messed this up because defaultCostModelParamsForTesting is the cost + -- model parameters for model C, + -- which now includes the new bitwise builtins. + -- , testCase "default values costmodelparamsfortesting" do + -- defaultCostModelParamsForTesting + -- @=? Just (toCostModelParams V3.costModelParamsForTesting) + embed $ testCase "context length" do + let costValuesForTesting = fmap snd V3.costModelParamsForTesting + -- the `costModelParamsForTesting` reflects only the latest + -- version (V3), so this should succeed because the lengths match + assertBool "wrong number of arguments in V3.mkEvaluationContext" $ + isRight $ + runExcept $ + runWriterT $ + V3.mkEvaluationContext costValuesForTesting + -- this one should succeed because we allow adding new builtins to an + -- existing version, by appending new cost model parameters, + -- for more info: + -- See Note [Cost model parameters from the ledger's point of view] + assertBool "larger number of params did not warn" + $ hasWarnMoreParams + (length v3_ParamNames) + (1 + length v3_ParamNames) + $ runExcept + $ runWriterT + $ V3.mkEvaluationContext + $ costValuesForTesting ++ [1] -- dummy param value appended + , embed $ testCase "cost model parameters" do + -- v1 is missing some cost model parameters + -- because new builtins are added in v2 + assertBool "v1 params is not a proper subset of v2 params" $ + v1_ParamNames `paramProperSubset` v2_ParamNames + -- v1/v2 and v3 cost models are not comparable because we added + -- new builtins in v3 but also removed some superseded cost model + -- parameters. + assertBool "v1 params and v3 params are comparable" $ + not (v1_ParamNames `paramSubset` v3_ParamNames) + && not (v3_ParamNames `paramSubset` v1_ParamNames) + assertBool "v2 params and v3 params are comparable" $ + not (v2_ParamNames `paramSubset` v3_ParamNames) + && not (v3_ParamNames `paramSubset` v2_ParamNames) + , -- Fail if new cost model parameters names aren't appended to the end + nestedGoldenVsTextPredM + "costModelParamNames" + ".txt" + do pure (Text.unlines (map showParamName v3_ParamNames)) + Text.isPrefixOf ] - where - hasWarnMoreParams :: Int -> Int -> Either a (b, [CostModelApplyWarn]) -> Bool - hasWarnMoreParams testExpected testActual (Right (_,[CMTooManyParamsWarn{..}])) - | testExpected==cmExpected && testActual==cmActual = True - hasWarnMoreParams _ _ _ = False + where + hasWarnMoreParams :: Int -> Int -> Either a (b, [CostModelApplyWarn]) -> Bool + hasWarnMoreParams + testExpected + testActual + (Right (_, [CMTooManyParamsWarn{..}])) + | testExpected == cmExpected && testActual == cmActual = True + hasWarnMoreParams _ _ _ = False - paramProperSubset pA pB = - Set.fromList (showParamName <$> pA) `Set.isProperSubsetOf` Set.fromList (showParamName <$> pB) + paramProperSubset pA pB = + Set.fromList (showParamName <$> pA) + `isProperSubsetOf` Set.fromList (showParamName <$> pB) - paramSubset pA pB = - Set.fromList (showParamName <$> pA) `Set.isSubsetOf` Set.fromList (showParamName <$> pB) + paramSubset pA pB = + Set.fromList (showParamName <$> pA) + `isSubsetOf` Set.fromList (showParamName <$> pB) - v1_ParamNames = enumerate @V1.ParamName - v2_ParamNames = enumerate @V2.ParamName - v3_ParamNames = enumerate @V3.ParamName + v1_ParamNames = enumerate @V1.ParamName + v2_ParamNames = enumerate @V2.ParamName + v3_ParamNames = enumerate @V3.ParamName diff --git a/plutus-ledger-api/testlib/PlutusLedgerApi/Test/Common/EvaluationContext.hs b/plutus-ledger-api/testlib/PlutusLedgerApi/Test/Common/EvaluationContext.hs index 73c4ee9d948..10eeb3c1ec1 100644 --- a/plutus-ledger-api/testlib/PlutusLedgerApi/Test/Common/EvaluationContext.hs +++ b/plutus-ledger-api/testlib/PlutusLedgerApi/Test/Common/EvaluationContext.hs @@ -1,6 +1,5 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} module PlutusLedgerApi.Test.Common.EvaluationContext ( MCostModel , MCekMachineCosts diff --git a/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V3/Data/EvaluationContext.hs b/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V3/Data/EvaluationContext.hs index 5f8ee352a11..b3d091aed51 100644 --- a/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V3/Data/EvaluationContext.hs +++ b/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V3/Data/EvaluationContext.hs @@ -18,10 +18,11 @@ import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts import Data.Int (Int64) import Data.Map qualified as Map import Data.Maybe +import GHC.Stack (HasCallStack) -- | Example values of costs for @PlutusV3@, in expected ledger order. -- Suitable to be used in testing. -costModelParamsForTesting :: [(V3.ParamName, Int64)] +costModelParamsForTesting :: HasCallStack => [(V3.ParamName, Int64)] costModelParamsForTesting = Map.toList $ fromJust $ Common.extractCostModelParamsLedgerOrder mCostModel @@ -29,7 +30,7 @@ costModelParamsForTesting = Map.toList $ fromJust $ mCostModel :: MCostModel mCostModel = -- nothing to clear because v4 does not exist (yet). - (toMCostModel defaultCekCostModelForTesting) & builtinCostModel %~ clearBuiltinCostModel' + toMCostModel defaultCekCostModelForTesting & builtinCostModel %~ clearBuiltinCostModel' {- | Assign to `mempty` those CEK constructs that @PlutusV3@ introduces (indirectly by introducing a ledger language version with those CEK constructs). @@ -84,6 +85,9 @@ clearBuiltinCostModel r = r , paramFindFirstSetBit = mempty , paramRipemd_160 = mempty , paramExpModInteger = mempty + , paramLengthArray = mempty + , paramListToArray = mempty + , paramIndexArray = mempty } diff --git a/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V3/EvaluationContext.hs b/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V3/EvaluationContext.hs index 379e80734cb..b5367ec6545 100644 --- a/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V3/EvaluationContext.hs +++ b/plutus-ledger-api/testlib/PlutusLedgerApi/Test/V3/EvaluationContext.hs @@ -19,10 +19,11 @@ import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts import Data.Int (Int64) import Data.Map qualified as Map import Data.Maybe +import GHC.Stack (HasCallStack) -- | Example values of costs for @PlutusV3@, in expected ledger order. -- Suitable to be used in testing. -costModelParamsForTesting :: [(V3.ParamName, Int64)] +costModelParamsForTesting :: HasCallStack => [(V3.ParamName, Int64)] costModelParamsForTesting = Map.toList $ fromJust $ Common.extractCostModelParamsLedgerOrder mCostModel @@ -30,7 +31,7 @@ costModelParamsForTesting = Map.toList $ fromJust $ mCostModel :: MCostModel mCostModel = -- nothing to clear because v4 does not exist (yet). - (toMCostModel defaultCekCostModelForTesting) & builtinCostModel %~ clearBuiltinCostModel' + toMCostModel defaultCekCostModelForTesting & builtinCostModel %~ clearBuiltinCostModel' {- | Assign to `mempty` those CEK constructs that @PlutusV3@ introduces (indirectly by introducing a ledger language version with those CEK constructs). @@ -86,6 +87,9 @@ clearBuiltinCostModel r = r , paramRipemd_160 = mempty , paramExpModInteger = mempty , paramDropList = mempty + , paramLengthArray = mempty + , paramListToArray = mempty + , paramIndexArray = mempty } diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index 2a9484c5249..351293b2347 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -115,6 +115,7 @@ test-suite plutus-tx-plugin-tests hs-source-dirs: test main-is: Spec.hs other-modules: + Array.Spec AsData.Budget.Spec AsData.Budget.Types AssocMap.Spec diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs index 0ff251b87aa..3d8532c48de 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Builtins.hs @@ -240,6 +240,11 @@ builtinNames = [ , 'Builtins.mkCons , 'Builtins.drop + , ''Builtins.BuiltinArray + , 'Builtins.lengthOfArray + , 'Builtins.listToArray + , 'Builtins.indexArray + , ''Builtins.BuiltinData , 'Builtins.chooseData , 'Builtins.caseData' @@ -462,6 +467,11 @@ defineBuiltinTerms = do PLC.MkCons -> defineBuiltinInl 'Builtins.mkCons PLC.DropList -> defineBuiltinInl 'Builtins.drop + -- Arrays + PLC.LengthArray -> defineBuiltinInl 'Builtins.lengthOfArray + PLC.ListToArray -> defineBuiltinInl 'Builtins.listToArray + PLC.IndexArray -> defineBuiltinInl 'Builtins.indexArray + -- Data PLC.ChooseData -> defineBuiltinInl 'Builtins.chooseData PLC.EqualsData -> defineBuiltinInl 'Builtins.equalsData @@ -599,9 +609,7 @@ defineBuiltinTerms = do PLC.ExpModInteger -> defineBuiltinInl 'Builtins.expModInteger -defineBuiltinTypes - :: CompilingDefault uni fun m ann - => m () +defineBuiltinTypes :: CompilingDefault uni fun m ann => m () defineBuiltinTypes = do defineBuiltinType ''Builtins.BuiltinByteString . ($> annMayInline) $ PLC.toTypeAst $ Proxy @BS.ByteString defineBuiltinType ''Integer . ($> annMayInline) $ PLC.toTypeAst $ Proxy @Integer @@ -611,6 +619,7 @@ defineBuiltinTypes = do defineBuiltinType ''Builtins.BuiltinData . ($> annMayInline) $ PLC.toTypeAst $ Proxy @PLC.Data defineBuiltinType ''Builtins.BuiltinPair . ($> annMayInline) $ PLC.TyBuiltin () (PLC.SomeTypeIn PLC.DefaultUniProtoPair) defineBuiltinType ''Builtins.BuiltinList . ($> annMayInline) $ PLC.TyBuiltin () (PLC.SomeTypeIn PLC.DefaultUniProtoList) + defineBuiltinType ''Builtins.BuiltinArray . ($> annMayInline) $ PLC.TyBuiltin () (PLC.SomeTypeIn PLC.DefaultUniProtoArray) defineBuiltinType ''Builtins.BuiltinBLS12_381_G1_Element . ($> annMayInline) $ PLC.toTypeAst $ Proxy @BLS12_381.G1.Element defineBuiltinType ''Builtins.BuiltinBLS12_381_G2_Element . ($> annMayInline) $ PLC.toTypeAst $ Proxy @BLS12_381.G2.Element defineBuiltinType ''Builtins.BuiltinBLS12_381_MlResult . ($> annMayInline) $ PLC.toTypeAst $ Proxy @BLS12_381.Pairing.MlResult diff --git a/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.eval.golden b/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.eval.golden new file mode 100644 index 00000000000..361ee8e0beb --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.eval.golden @@ -0,0 +1 @@ +I 3 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.pir.golden b/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.pir.golden new file mode 100644 index 00000000000..738862c5941 --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.pir.golden @@ -0,0 +1,26 @@ +(let + !indexArray : all a. array a -> integer -> a = indexArray + in + indexArray {data}) + (let + !unitval : unit = () + in + let + !mkNilData : unit -> list data = mkNilData + in + let + !mkI : integer -> data = iData + in + let + !mkCons : all a. a -> list a -> list a = mkCons + in + let + !listToArray : all a. list a -> array a = listToArray + in + listToArray + {data} + (mkCons + {data} + (mkI 1) + (mkCons {data} (mkI 2) (mkCons {data} (mkI 3) (mkNilData unitval))))) + 2 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.uplc.golden b/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.uplc.golden new file mode 100644 index 00000000000..b6021691ff4 --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledIndexArray.uplc.golden @@ -0,0 +1,21 @@ +(program + 1.1.0 + ((\indexArray -> force indexArray) + indexArray + ((\unitval -> + (\mkNilData -> + (\mkI -> + (\mkCons -> + (\listToArray -> + force listToArray + (force mkCons + (mkI 1) + (force mkCons + (mkI 2) + (force mkCons (mkI 3) (mkNilData unitval))))) + listToArray) + mkCons) + iData) + mkNilData) + ()) + 2)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.eval.golden b/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.eval.golden new file mode 100644 index 00000000000..e440e5c8425 --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.eval.golden @@ -0,0 +1 @@ +3 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.pir.golden b/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.pir.golden new file mode 100644 index 00000000000..cb0e5ea358d --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.pir.golden @@ -0,0 +1,25 @@ +(let + !lengthOfArray : all a. array a -> integer = lengthArray + in + lengthOfArray {data}) + (let + !unitval : unit = () + in + let + !mkNilData : unit -> list data = mkNilData + in + let + !mkI : integer -> data = iData + in + let + !mkCons : all a. a -> list a -> list a = mkCons + in + let + !listToArray : all a. list a -> array a = listToArray + in + listToArray + {data} + (mkCons + {data} + (mkI 1) + (mkCons {data} (mkI 2) (mkCons {data} (mkI 3) (mkNilData unitval))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.uplc.golden b/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.uplc.golden new file mode 100644 index 00000000000..9a4f561d689 --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledLengthArray.uplc.golden @@ -0,0 +1,20 @@ +(program + 1.1.0 + ((\lengthOfArray -> force lengthOfArray) + lengthArray + ((\unitval -> + (\mkNilData -> + (\mkI -> + (\mkCons -> + (\listToArray -> + force listToArray + (force mkCons + (mkI 1) + (force mkCons + (mkI 2) + (force mkCons (mkI 3) (mkNilData unitval))))) + listToArray) + mkCons) + iData) + mkNilData) + ()))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/9.6/compiledListToArray.eval.golden b/plutus-tx-plugin/test/Array/9.6/compiledListToArray.eval.golden new file mode 100644 index 00000000000..e3446f4a641 --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledListToArray.eval.golden @@ -0,0 +1 @@ +[I 1, I 2, I 3] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/9.6/compiledListToArray.pir.golden b/plutus-tx-plugin/test/Array/9.6/compiledListToArray.pir.golden new file mode 100644 index 00000000000..1f7b9ae870e --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledListToArray.pir.golden @@ -0,0 +1,21 @@ +let + !unitval : unit = () +in +let + !mkNilData : unit -> list data = mkNilData +in +let + !mkI : integer -> data = iData +in +let + !mkCons : all a. a -> list a -> list a = mkCons +in +let + !listToArray : all a. list a -> array a = listToArray +in +listToArray + {data} + (mkCons + {data} + (mkI 1) + (mkCons {data} (mkI 2) (mkCons {data} (mkI 3) (mkNilData unitval)))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/9.6/compiledListToArray.uplc.golden b/plutus-tx-plugin/test/Array/9.6/compiledListToArray.uplc.golden new file mode 100644 index 00000000000..0af538d9db3 --- /dev/null +++ b/plutus-tx-plugin/test/Array/9.6/compiledListToArray.uplc.golden @@ -0,0 +1,18 @@ +(program + 1.1.0 + ((\unitval -> + (\mkNilData -> + (\mkI -> + (\mkCons -> + (\listToArray -> + force listToArray + (force mkCons + (mkI 1) + (force mkCons + (mkI 2) + (force mkCons (mkI 3) (mkNilData unitval))))) + listToArray) + mkCons) + iData) + mkNilData) + ())) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Array/Spec.hs b/plutus-tx-plugin/test/Array/Spec.hs new file mode 100644 index 00000000000..8acfc5108cf --- /dev/null +++ b/plutus-tx-plugin/test/Array/Spec.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-simplifier-iterations-pir=0 #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-simplifier-iterations-uplc=0 #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-cse-iterations=0 #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-optimize #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-simplifier-beta #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-simplifier-evaluate-builtins #-} + +module Array.Spec where + +import PlutusCore.Test (goldenUEval) +import PlutusTx +import PlutusTx.Builtins.Internal +import PlutusTx.Test (goldenPirReadable, goldenUPlcReadable) +import Test.Tasty.Extras + +smokeTests :: TestNested +smokeTests = + testNested + "Array" + [ testNestedGhc + [ goldenPirReadable "compiledListToArray" compiledListToArray + , goldenUPlcReadable "compiledListToArray" compiledListToArray + , goldenUEval "compiledListToArray" [compiledListToArray] + , goldenPirReadable "compiledLengthArray" compiledLengthArray + , goldenUPlcReadable "compiledLengthArray" compiledLengthArray + , goldenUEval "compiledLengthArray" [compiledLengthArray] + , goldenPirReadable "compiledIndexArray" compiledIndexArray + , goldenUPlcReadable "compiledIndexArray" compiledIndexArray + , goldenUEval "compiledIndexArray" [compiledIndexArray] + ] + ] + +compiledListToArray :: CompiledCode (BuiltinArray BuiltinData) +compiledListToArray = + $$( compile + [|| + listToArray + ( mkCons + (mkI 1) + ( mkCons + (mkI 2) + ( mkCons + (mkI 3) + (mkNilData unitval) + ) + ) + ) + ||] + ) + +compiledLengthArray :: CompiledCode BuiltinInteger +compiledLengthArray = + $$(compile [||lengthOfArray||]) `unsafeApplyCode` compiledListToArray + +compiledIndexArray :: CompiledCode BuiltinData +compiledIndexArray = + $$(compile [||indexArray||]) + `unsafeApplyCode` compiledListToArray + `unsafeApplyCode` liftCodeDef 2 diff --git a/plutus-tx-plugin/test/Spec.hs b/plutus-tx-plugin/test/Spec.hs index f9b3a5acf10..5a69c0c6f74 100644 --- a/plutus-tx-plugin/test/Spec.hs +++ b/plutus-tx-plugin/test/Spec.hs @@ -1,5 +1,6 @@ module Main (main) where +import Array.Spec qualified as Array import AsData.Budget.Spec qualified as AsData.Budget import AssocMap.Spec qualified as AssocMap import Blueprint.Tests qualified @@ -49,4 +50,5 @@ tests = , embed Unicode.tests , embed AssocMap.propertyTests , embed List.propertyTests + , Array.smokeTests ] diff --git a/plutus-tx/plutus-tx.cabal b/plutus-tx/plutus-tx.cabal index 601935fa426..9a647be091a 100644 --- a/plutus-tx/plutus-tx.cabal +++ b/plutus-tx/plutus-tx.cabal @@ -141,6 +141,7 @@ library , text , th-abstraction , th-compat + , vector ^>=0.13.2 default-extensions: Strict diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs index 92a95e4da3a..3d916e0b107 100644 --- a/plutus-tx/src/PlutusTx/Builtins.hs +++ b/plutus-tx/src/PlutusTx/Builtins.hs @@ -87,6 +87,12 @@ module PlutusTx.Builtins ( , BI.drop , uncons , unsafeUncons + -- * Arrays + , BI.BuiltinArray + , BI.listToArray + , sopListToArray + , BI.lengthOfArray + , BI.indexArray -- * Tracing , trace -- * BLS12_381 @@ -455,6 +461,10 @@ pairToPair :: BI.BuiltinPair a b -> (a, b) pairToPair tup = (BI.fst tup, BI.snd tup) {-# INLINE pairToPair #-} +sopListToArray :: (HasToOpaque a arep, MkNil arep) => [a] -> BI.BuiltinArray arep +sopListToArray l = BI.listToArray (toOpaque l) +{-# INLINABLE sopListToArray #-} + -- | Given five values for the five different constructors of 'BuiltinData', selects -- one depending on which corresponds to the actual constructor of the given value. chooseData :: forall a . BuiltinData -> a -> a -> a -> a -> a -> a diff --git a/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs b/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs index 30cd0dc7beb..ab2b22097c8 100644 --- a/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs +++ b/plutus-tx/src/PlutusTx/Builtins/HasBuiltin.hs @@ -18,6 +18,7 @@ import PlutusTx.Builtins.Internal import Data.ByteString (ByteString) import Data.Kind qualified as GHC import Data.Text (Text) +import Data.Vector.Strict qualified as Strict {- Note [useToOpaque and useFromOpaque] It used to be possible to use 'toBuiltin'/'fromBuiltin' within a smart contract, but this is no @@ -91,6 +92,13 @@ instance HasFromBuiltin a => HasFromBuiltin (BuiltinList a) where type FromBuiltin (BuiltinList a) = [FromBuiltin a] fromBuiltin (BuiltinList xs) = map fromBuiltin xs +instance HasToBuiltin a => HasToBuiltin (Strict.Vector a) where + type ToBuiltin (Strict.Vector a) = BuiltinArray (ToBuiltin a) + toBuiltin = useToOpaque (BuiltinArray . fmap toBuiltin) +instance HasFromBuiltin a => HasFromBuiltin (BuiltinArray a) where + type FromBuiltin (BuiltinArray a) = Strict.Vector (FromBuiltin a) + fromBuiltin (BuiltinArray xs) = fmap fromBuiltin xs + instance (HasToBuiltin a, HasToBuiltin b) => HasToBuiltin (a, b) where type ToBuiltin (a, b) = BuiltinPair (ToBuiltin a) (ToBuiltin b) toBuiltin (x, y) = BuiltinPair (toBuiltin x, toBuiltin y) diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index 628033ac82c..963652932f4 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -32,6 +32,8 @@ import Data.Kind (Type) import Data.List qualified as Haskell import Data.Text as Text (Text, empty) import Data.Text.Encoding as Text (decodeUtf8, encodeUtf8) +import Data.Vector.Strict (Vector) +import Data.Vector.Strict qualified as Vector import GHC.Generics (Generic) import PlutusCore.Bitwise qualified as Bitwise import PlutusCore.Builtin (BuiltinResult (..)) @@ -557,6 +559,30 @@ serialiseData :: BuiltinData -> BuiltinByteString serialiseData (BuiltinData b) = BuiltinByteString $ BSL.toStrict $ serialise b {-# OPAQUE serialiseData #-} +{- +ARRAY +-} + +data BuiltinArray a = BuiltinArray ~(Vector a) deriving stock (Data) + +instance Haskell.Show a => Haskell.Show (BuiltinArray a) where + show (BuiltinArray v) = show v +instance Haskell.Eq a => Haskell.Eq (BuiltinArray a) where + (==) (BuiltinArray v1) (BuiltinArray v2) = (==) v1 v2 +instance Haskell.Ord a => Haskell.Ord (BuiltinArray a) where + compare (BuiltinArray v1) (BuiltinArray v2) = compare v1 v2 + +lengthOfArray :: BuiltinArray a -> BuiltinInteger +lengthOfArray (BuiltinArray v) = toInteger (Vector.length v) +{-# OPAQUE lengthOfArray #-} + +listToArray :: BuiltinList a -> BuiltinArray a +listToArray (BuiltinList l) = BuiltinArray (Vector.fromList l) +{-# OPAQUE listToArray #-} + +indexArray :: BuiltinArray a -> BuiltinInteger -> a +indexArray (BuiltinArray v) i = v Vector.! fromInteger i +{-# OPAQUE indexArray #-} {- BLS12_381 diff --git a/plutus-tx/src/PlutusTx/Lift/Class.hs b/plutus-tx/src/PlutusTx/Lift/Class.hs index 7df54048efc..89f9e9d2053 100644 --- a/plutus-tx/src/PlutusTx/Lift/Class.hs +++ b/plutus-tx/src/PlutusTx/Lift/Class.hs @@ -40,6 +40,7 @@ import Data.ByteString qualified as BS import Data.Kind qualified as GHC import Data.Proxy import Data.Text qualified as T +import Data.Vector.Strict qualified as Strict import GHC.TypeLits (ErrorMessage (..), TypeError) -- We do not use qualified import because the whole module contains off-chain code @@ -180,6 +181,16 @@ instance (HasFromBuiltin arep, uni `PLC.HasTermLevel` [FromBuiltin arep]) => Lift uni (BuiltinList arep) where lift = liftBuiltin . fromBuiltin +-- See Note [Lift and Typeable instances for builtins] +instance uni `PLC.HasTypeLevel` Strict.Vector => Typeable uni BuiltinArray where + typeRep _ = typeRepBuiltin (Proxy @Strict.Vector) + +-- See Note [Lift and Typeable instances for builtins] +instance ( HasFromBuiltin arep + , uni `PLC.HasTermLevel` Strict.Vector (FromBuiltin arep) + ) => Lift uni (BuiltinArray arep) where + lift = liftBuiltin . fromBuiltin + instance uni `PLC.HasTypeLevel` (,) => Typeable uni BuiltinPair where typeRep _ = typeRepBuiltin (Proxy @(,))