diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.golden.uplc b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.golden.uplc index f9d07e61d0b..bef92027c38 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.golden.uplc +++ b/cardano-constitution/test/Cardano/Constitution/Validator/Data/GoldenTests/unsorted.golden.uplc @@ -741,68 +741,68 @@ program (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 4 - 5) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse + , cse ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (cse - 4) - , (constr 0 - [ ]) ])) + [ cse + , (constr 1 + [ (unsafeRatio + 9 + 10) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 4 + 5) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse - , cse ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 51 - 100) - , (constr 0 - [ ]) ]) ]) ])) - (cse - 2)) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 9 - 10) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (cse + 4) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 51 + 100) + , (constr 0 + [ ]) ]) ]) ])) + (cse + 2)) ]) (constr 0 [ (constr 1 [ ]) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.golden.uplc b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.golden.uplc index f1618379ff6..f1780595435 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.golden.uplc +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.golden.uplc @@ -714,31 +714,31 @@ program [ ]) , (constr 1 [ cse - , (constr 1 - [ (unsafeRatio - 4 - 5) - , (constr 0 - [ ]) ]) ]) ]) + , cse ]) ]) , (constr 0 [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (cse - 4) - , (constr 0 - [ ]) ])) + (constr 1 + [ (cse + 4) + , (constr 0 + [ ]) ])) + (constr 3 + [ (constr 1 + [ cse + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 4 + 5) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 3 [ (constr 1 [ cse diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.golden.uplc b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.golden.uplc index cc90061cca1..900636e10dd 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.golden.uplc +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.golden.uplc @@ -736,36 +736,36 @@ program (constr 3 [ (constr 1 [ cse - , cse ]) ])) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , cse ]) ]) + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (unsafeRatio - 9 - 10) - , (constr 0 - [ ]) ]) ]) ]) + [ (cse + 4) , (constr 0 [ ]) ])) (constr 3 [ (constr 1 [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) + , cse ]) ])) (constr 1 - [ (cse - 4) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse + , (constr 1 + [ (unsafeRatio + 9 + 10) + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ])) (constr 3 diff --git a/plutus-benchmark/bitwise/test/9.6/Ed25519.golden.uplc b/plutus-benchmark/bitwise/test/9.6/Ed25519.golden.uplc index 78281e16f75..3a4a8e84554 100644 --- a/plutus-benchmark/bitwise/test/9.6/Ed25519.golden.uplc +++ b/plutus-benchmark/bitwise/test/9.6/Ed25519.golden.uplc @@ -966,12 +966,12 @@ (case ds [ (\w - rest -> + cont -> w) ])) (case ds [ (\w - cont -> + rest -> w) ])) ]) (next ipv)) ]) diff --git a/plutus-benchmark/coop/test/9.6/fsMpMinting.golden.pir b/plutus-benchmark/coop/test/9.6/fsMpMinting.golden.pir new file mode 100644 index 00000000000..75795af1301 --- /dev/null +++ b/plutus-benchmark/coop/test/9.6/fsMpMinting.golden.pir @@ -0,0 +1,4890 @@ +(let + data Unit | Unit_match where + Unit : Unit + !fail : unit -> unit + = \(ds : unit) -> + let + !x : Unit = trace {Unit} "incorrect purpose" Unit + in + error {unit} + !`$fToDataInteger_$ctoBuiltinData` : integer -> data + = \(i : integer) -> iData i + data (These :: * -> * -> *) a b | These_match where + That : b -> These a b + These : a -> b -> These a b + This : a -> These a b + !`$fToDataThese_$ctoBuiltinData` : + all a b. (\a -> a -> data) a -> (\a -> a -> data) b -> These a b -> data + = /\a b -> + \(`$dToData` : (\a -> a -> data) a) + (`$dToData` : (\a -> a -> data) b) + (ds : These a b) -> + These_match + {a} + {b} + ds + {data} + (\(arg : b) -> constrData 1 (mkCons {data} (`$dToData` arg) [])) + (\(arg : a) (arg : b) -> + constrData + 2 + (mkCons + {data} + (`$dToData` arg) + (mkCons {data} (`$dToData` arg) []))) + (\(arg : a) -> constrData 0 (mkCons {data} (`$dToData` arg) [])) + ~`$dToData` : These integer integer -> data + = `$fToDataThese_$ctoBuiltinData` + {integer} + {integer} + `$fToDataInteger_$ctoBuiltinData` + `$fToDataInteger_$ctoBuiltinData` + !casePair : all a b r. pair a b -> (a -> b -> r) -> r + = /\a b r -> \(p : pair a b) (f : a -> b -> r) -> case r p [f] + !`$fUnsafeFromDataThese_$cunsafeFromBuiltinData` : + all a b. (\a -> data -> a) a -> (\a -> data -> a) b -> data -> These a b + = /\a b -> + \(`$dUnsafeFromData` : (\a -> data -> a) a) + (`$dUnsafeFromData` : (\a -> data -> a) b) + (d : data) -> + casePair + {integer} + {list data} + {These a b} + (unConstrData d) + (\(index : integer) (args : list data) -> + case + (list data -> These a b) + index + [ (\(ds : list data) -> + This {a} {b} (`$dUnsafeFromData` (headList {data} ds))) + , (\(ds : list data) -> + That {a} {b} (`$dUnsafeFromData` (headList {data} ds))) + , (\(ds : list data) -> + These + {a} + {b} + (`$dUnsafeFromData` (headList {data} ds)) + (`$dUnsafeFromData` + (headList {data} (tailList {data} ds)))) ] + args) + !`$fToDataMap_$ctoBuiltinData` : + all k a. (\k a -> list (pair data data)) k a -> data + = /\k a -> \(ds : (\k a -> list (pair data data)) k a) -> mapData ds + !map : + all k a b. + (\a -> data -> a) a -> + (\a -> a -> data) b -> + (a -> b) -> + (\k a -> list (pair data data)) k a -> + (\k a -> list (pair data data)) k b + = /\k a b -> + \(`$dUnsafeFromData` : (\a -> data -> a) a) + (`$dToData` : (\a -> a -> data) b) + (f : a -> b) -> + letrec + !go : list (pair data data) -> list (pair data data) + = \(xs : list (pair data data)) -> + case + (list (pair data data)) + xs + [ (\(hd : pair data data) (eta : list (pair data data)) -> + mkCons + {pair data data} + (mkPairData + (case data hd [(\(l : data) (r : data) -> l)]) + (`$dToData` + (f + (`$dUnsafeFromData` + (case + data + hd + [(\(l : data) (r : data) -> r)]))))) + (go eta)) + , [] ] + in + go + in + letrec + !safeAppend : + list (pair data data) -> list (pair data data) -> list (pair data data) + = \(xs : list (pair data data)) (xs : list (pair data data)) -> + case + (list (pair data data)) + xs + [ (\(hd : pair data data) (tl : list (pair data data)) -> + let + !v : data = case data hd [(\(l : data) (r : data) -> r)] + !k : data = case data hd [(\(l : data) (r : data) -> l)] + !nilCase : list (pair data data) + = mkCons {pair data data} (mkPairData k v) [] + in + letrec + !go : list (pair data data) -> list (pair data data) + = \(xs : list (pair data data)) -> + case + (list (pair data data)) + xs + [ (\(hd : pair data data) -> + case + (all dead. + list (pair data data) -> + list (pair data data)) + (equalsData + k + (case + data + hd + [(\(l : data) (r : data) -> l)])) + [ (/\dead -> + \(eta : list (pair data data)) -> + mkCons {pair data data} hd (go eta)) + , (/\dead -> + mkCons + {pair data data} + (mkPairData k v)) ] + {all dead. dead}) + , nilCase ] + in + go (safeAppend tl xs)) + , xs ] + in + let + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + !lookup' : data -> list (pair data data) -> Maybe data + = \(k : data) -> + letrec + !go : list (pair data data) -> Maybe data + = \(xs : list (pair data data)) -> + case + (Maybe data) + xs + [ (\(hd : pair data data) -> + case + (all dead. list (pair data data) -> Maybe data) + (equalsData + k + (case data hd [(\(l : data) (r : data) -> l)])) + [ (/\dead -> go) + , (/\dead -> + \(ds : list (pair data data)) -> + Just + {data} + (case + data + hd + [(\(l : data) (r : data) -> r)])) ] + {all dead. dead}) + , (Nothing {data}) ] + in + \(m : list (pair data data)) -> go m + !union : + all k a b. + (\a -> data -> a) a -> + (\a -> data -> a) b -> + (\a -> a -> data) a -> + (\a -> a -> data) b -> + (\k a -> list (pair data data)) k a -> + (\k a -> list (pair data data)) k b -> + (\k a -> list (pair data data)) k (These a b) + = /\k a b -> + \(`$dUnsafeFromData` : (\a -> data -> a) a) + (`$dUnsafeFromData` : (\a -> data -> a) b) + (`$dToData` : (\a -> a -> data) a) + (`$dToData` : (\a -> a -> data) b) + (ds : (\k a -> list (pair data data)) k a) -> + letrec + !goRight : list (pair data data) -> list (pair data data) + = \(xs : list (pair data data)) -> + case + (list (pair data data)) + xs + [ (\(hd : pair data data) (tl : list (pair data data)) -> + let + !v : data + = case data hd [(\(l : data) (r : data) -> r)] + !k : data + = case data hd [(\(l : data) (r : data) -> l)] + in + Maybe_match + {data} + (lookup' k ds) + {all dead. list (pair data data)} + (\(r : data) -> + /\dead -> + mkCons + {pair data data} + (mkPairData + k + (`$fToDataThese_$ctoBuiltinData` + {a} + {b} + `$dToData` + `$dToData` + (These + {a} + {b} + (`$dUnsafeFromData` v) + (`$dUnsafeFromData` r)))) + (goRight tl)) + (/\dead -> + mkCons + {pair data data} + (mkPairData + k + (`$fToDataThese_$ctoBuiltinData` + {a} + {b} + `$dToData` + `$dToData` + (That {a} {b} (`$dUnsafeFromData` v)))) + (goRight tl)) + {all dead. dead}) + , [] ] + in + \(ds : (\k a -> list (pair data data)) k b) -> + letrec + !goLeft : list (pair data data) -> list (pair data data) + = \(xs : list (pair data data)) -> + case + (list (pair data data)) + xs + [ (\(hd : pair data data) + (tl : list (pair data data)) -> + let + !v : data + = case data hd [(\(l : data) (r : data) -> r)] + !k : data + = case data hd [(\(l : data) (r : data) -> l)] + in + Maybe_match + {data} + (lookup' k ds) + {all dead. list (pair data data)} + (\(r : data) -> + /\dead -> + mkCons + {pair data data} + (mkPairData + k + (`$fToDataThese_$ctoBuiltinData` + {a} + {b} + `$dToData` + `$dToData` + (These + {a} + {b} + (`$dUnsafeFromData` v) + (`$dUnsafeFromData` r)))) + (goLeft tl)) + (/\dead -> + mkCons + {pair data data} + (mkPairData + k + (`$fToDataThese_$ctoBuiltinData` + {a} + {b} + `$dToData` + `$dToData` + (This + {a} + {b} + (`$dUnsafeFromData` v)))) + (goLeft tl)) + {all dead. dead}) + , [] ] + in + safeAppend (goLeft ds) (goRight ds) + !`$fAdditiveGroupValue` : + (integer -> integer -> integer) -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) + = \(f : integer -> integer -> integer) + (ls : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer)) + (rs : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer)) -> + map + {bytestring} + {(\k a -> list (pair data data)) bytestring (These integer integer)} + {(\k a -> list (pair data data)) bytestring integer} + (\(eta : data) -> unMapData eta) + (`$fToDataMap_$ctoBuiltinData` {bytestring} {integer}) + (map + {bytestring} + {These integer integer} + {integer} + (`$fUnsafeFromDataThese_$cunsafeFromBuiltinData` + {integer} + {integer} + unIData + unIData) + `$fToDataInteger_$ctoBuiltinData` + (\(k' : These integer integer) -> + These_match + {integer} + {integer} + k' + {integer} + (\(b : integer) -> f 0 b) + (\(a : integer) (b : integer) -> f a b) + (\(a : integer) -> f a 0))) + (map + {bytestring} + {These + ((\k a -> list (pair data data)) bytestring integer) + ((\k a -> list (pair data data)) bytestring integer)} + {(\k a -> list (pair data data)) + bytestring + (These integer integer)} + (`$fUnsafeFromDataThese_$cunsafeFromBuiltinData` + {(\k a -> list (pair data data)) bytestring integer} + {(\k a -> list (pair data data)) bytestring integer} + (\(eta : data) -> unMapData eta) + (\(eta : data) -> unMapData eta)) + (`$fToDataMap_$ctoBuiltinData` + {bytestring} + {These integer integer}) + (\(k : + These + ((\k a -> list (pair data data)) bytestring integer) + ((\k a -> list (pair data data)) bytestring integer)) -> + These_match + {(\k a -> list (pair data data)) bytestring integer} + {(\k a -> list (pair data data)) bytestring integer} + k + {(\k a -> list (pair data data)) + bytestring + (These integer integer)} + (\(b : + (\k a -> list (pair data data)) bytestring integer) -> + map + {bytestring} + {integer} + {These integer integer} + unIData + `$dToData` + (\(ds : integer) -> That {integer} {integer} ds) + b) + (\(a : (\k a -> list (pair data data)) bytestring integer) + (b : + (\k a -> list (pair data data)) bytestring integer) -> + union + {bytestring} + {integer} + {integer} + unIData + unIData + `$fToDataInteger_$ctoBuiltinData` + `$fToDataInteger_$ctoBuiltinData` + a + b) + (\(a : + (\k a -> list (pair data data)) bytestring integer) -> + map + {bytestring} + {integer} + {These integer integer} + unIData + `$dToData` + (\(ds : integer) -> This {integer} {integer} ds) + a)) + (union + {bytestring} + {(\k a -> list (pair data data)) bytestring integer} + {(\k a -> list (pair data data)) bytestring integer} + (\(eta : data) -> unMapData eta) + (\(eta : data) -> unMapData eta) + (`$fToDataMap_$ctoBuiltinData` {bytestring} {integer}) + (`$fToDataMap_$ctoBuiltinData` {bytestring} {integer}) + ls + rs)) + !ifThenElse : all a. bool -> a -> a -> a + = /\a -> \(b : bool) (x : a) (y : a) -> case a b [y, x] + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + letrec + !`$fEnumBool_$cenumFromTo` : integer -> integer -> List integer + = \(x : integer) (lim : integer) -> + case + (all dead. List integer) + (ifThenElse {bool} (lessThanEqualsInteger x lim) False True) + [ (/\dead -> + Cons + {integer} + x + (`$fEnumBool_$cenumFromTo` (addInteger 1 x) lim)) + , (/\dead -> Nil {integer}) ] + {all dead. dead} + in + let + data (Enum :: * -> *) a | Enum_match where + CConsEnum : + (a -> a) -> + (a -> a) -> + (integer -> a) -> + (a -> integer) -> + (a -> a -> List a) -> + (a -> a -> a -> List a) -> + Enum a + !`$fEnumPOSIXTime` : Enum integer + = CConsEnum + {integer} + (\(x : integer) -> addInteger 1 x) + (\(x : integer) -> subtractInteger x 1) + (\(x : integer) -> x) + (\(x : integer) -> x) + `$fEnumBool_$cenumFromTo` + (\(x : integer) (y : integer) (lim : integer) -> + let + !delta : integer = subtractInteger y x + in + letrec + !up_list : integer -> List integer + = \(x : integer) -> + case + (all dead. List integer) + (ifThenElse + {bool} + (lessThanEqualsInteger x lim) + False + True) + [ (/\dead -> + Cons {integer} x (up_list (addInteger x delta))) + , (/\dead -> Nil {integer}) ] + {all dead. dead} + in + letrec + !dn_list : integer -> List integer + = \(x : integer) -> + case + (all dead. List integer) + (lessThanInteger x lim) + [ (/\dead -> + Cons {integer} x (dn_list (addInteger x delta))) + , (/\dead -> Nil {integer}) ] + {all dead. dead} + in + case + (all dead. List integer) + (ifThenElse {bool} (lessThanInteger delta 0) False True) + [(/\dead -> dn_list x), (/\dead -> up_list x)] + {all dead. dead}) + !`$fEqCredential_$c==` : data -> data -> bool + = \(ds : data) (ds : data) -> + let + !fail : unit -> bool + = \(ds : unit) -> + let + !tup : pair integer (list data) = unConstrData ds + in + case + (all dead. bool) + (equalsInteger + 1 + (case + integer + tup + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> False) + , (/\dead -> + let + !tup : pair integer (list data) = unConstrData ds + in + case + (all dead. bool) + (equalsInteger + 1 + (case + integer + tup + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> False) + , (/\dead -> + equalsByteString + (unBData + (headList + {data} + (case + (list data) + tup + [ (\(l : integer) (r : list data) -> + r) ]))) + (unBData + (headList + {data} + (case + (list data) + tup + [ (\(l : integer) (r : list data) -> + r) ])))) ] + {all dead. dead}) ] + {all dead. dead} + !tup : pair integer (list data) = unConstrData ds + in + case + (all dead. bool) + (equalsInteger + 0 + (case integer tup [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> fail ()) + , (/\dead -> + let + !tup : pair integer (list data) = unConstrData ds + in + case + (all dead. bool) + (equalsInteger + 0 + (case + integer + tup + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> fail ()) + , (/\dead -> + equalsByteString + (unBData + (headList + {data} + (case + (list data) + tup + [(\(l : integer) (r : list data) -> r)]))) + (unBData + (headList + {data} + (case + (list data) + tup + [(\(l : integer) (r : list data) -> r)])))) ] + {all dead. dead}) ] + {all dead. dead} + !`$mStakingPtr` : + all r. data -> (integer -> integer -> integer -> r) -> (unit -> r) -> r + = /\r -> + \(scrut : data) + (cont : integer -> integer -> integer -> r) + (fail : unit -> r) -> + let + !tup : pair integer (list data) = unConstrData scrut + in + case + (all dead. r) + (equalsInteger + 1 + (case integer tup [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> fail ()) + , (/\dead -> + let + !l : list data + = case + (list data) + tup + [(\(l : integer) (r : list data) -> r)] + !l : list data = tailList {data} l + in + cont + (unIData (headList {data} l)) + (unIData (headList {data} l)) + (unIData (headList {data} (tailList {data} l)))) ] + {all dead. dead} + data Ordering | Ordering_match where + EQ : Ordering + GT : Ordering + LT : Ordering + data (Ord :: * -> *) a | Ord_match where + CConsOrd : + (\a -> a -> a -> bool) a -> + (a -> a -> Ordering) -> + (a -> a -> bool) -> + (a -> a -> bool) -> + (a -> a -> bool) -> + (a -> a -> bool) -> + (a -> a -> a) -> + (a -> a -> a) -> + Ord a + !`$fOrdPOSIXTime` : Ord integer + = CConsOrd + {integer} + (\(x : integer) (y : integer) -> equalsInteger x y) + (\(eta : integer) (eta : integer) -> + case + (all dead. Ordering) + (equalsInteger eta eta) + [ (/\dead -> + case + (all dead. Ordering) + (lessThanEqualsInteger eta eta) + [(/\dead -> GT), (/\dead -> LT)] + {all dead. dead}) + , (/\dead -> EQ) ] + {all dead. dead}) + (\(x : integer) (y : integer) -> lessThanInteger x y) + (\(x : integer) (y : integer) -> lessThanEqualsInteger x y) + (\(x : integer) (y : integer) -> + ifThenElse {bool} (lessThanEqualsInteger x y) False True) + (\(x : integer) (y : integer) -> + ifThenElse {bool} (lessThanInteger x y) False True) + (\(x : integer) (y : integer) -> + case + (all dead. integer) + (lessThanEqualsInteger x y) + [(/\dead -> x), (/\dead -> y)] + {all dead. dead}) + (\(x : integer) (y : integer) -> + case + (all dead. integer) + (lessThanEqualsInteger x y) + [(/\dead -> y), (/\dead -> x)] + {all dead. dead}) + !`$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` : data -> data + = \(d : data) -> d + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + data CertDatum | CertDatum_match where + CertDatum : + bytestring -> + (\a -> data) integer -> + Tuple2 bytestring bytestring -> + CertDatum + !`$fUnsafeFromDataCertDatum_$cunsafeFromBuiltinData` : data -> CertDatum + = \(d : data) -> + casePair + {integer} + {list data} + {CertDatum} + (unConstrData d) + (\(index : integer) (args : list data) -> + case + (list data -> CertDatum) + index + [ (\(ds : list data) -> + let + !l : list data = tailList {data} ds + in + CertDatum + (unBData (headList {data} ds)) + (headList {data} l) + (casePair + {integer} + {list data} + {Tuple2 bytestring bytestring} + (unConstrData (headList {data} (tailList {data} l))) + (\(index : integer) (args : list data) -> + case + (list data -> Tuple2 bytestring bytestring) + index + [ (\(ds : list data) -> + Tuple2 + {bytestring} + {bytestring} + (unBData (headList {data} ds)) + (unBData + (headList + {data} + (tailList {data} ds)))) ] + args))) ] + args) + data FsDatum | FsDatum_match where + FsDatum : + data -> bytestring -> (\a -> data) integer -> bytestring -> FsDatum + !`$fUnsafeFromDataFsDatum_$cunsafeFromBuiltinData` : data -> FsDatum + = \(d : data) -> + casePair + {integer} + {list data} + {FsDatum} + (unConstrData d) + (\(index : integer) (args : list data) -> + case + (list data -> FsDatum) + index + [ (\(ds : list data) -> + let + !l : list data = tailList {data} ds + !l : list data = tailList {data} l + in + FsDatum + (headList {data} ds) + (unBData (headList {data} l)) + (headList {data} l) + (unBData (headList {data} (tailList {data} l)))) ] + args) + !`txOutRefId_$cunsafeFromBuiltinData` : data -> bytestring + = \(d : data) -> + casePair + {integer} + {list data} + {bytestring} + (unConstrData d) + (\(index : integer) (args : list data) -> + case + (list data -> bytestring) + index + [(\(ds : list data) -> unBData (headList {data} ds))] + args) + !`$mTxInfo` : + all r. + data -> + ((\a -> list data) data -> + (\a -> list data) data -> + (\a -> list data) data -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + (\a -> list data) data -> + (\k a -> list (pair data data)) data integer -> + (\a -> data) integer -> + (\a -> list data) bytestring -> + (\k a -> list (pair data data)) data data -> + (\k a -> list (pair data data)) bytestring data -> + bytestring -> + r) -> + (unit -> r) -> + r + = /\r -> + \(scrut : data) + (cont : + (\a -> list data) data -> + (\a -> list data) data -> + (\a -> list data) data -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + (\a -> list data) data -> + (\k a -> list (pair data data)) data integer -> + (\a -> data) integer -> + (\a -> list data) bytestring -> + (\k a -> list (pair data data)) data data -> + (\k a -> list (pair data data)) bytestring data -> + bytestring -> + r) + (fail : unit -> r) -> + let + !l : list data + = case + (list data) + (unConstrData scrut) + [(\(l : integer) (r : list data) -> r)] + !l : list data = tailList {data} l + !l : list data = tailList {data} l + !l : list data = tailList {data} l + !l : list data = tailList {data} l + !l : list data = tailList {data} l + !l : list data = tailList {data} l + !l : list data = tailList {data} l + !l : list data = tailList {data} l + !l : list data = tailList {data} l + !l : list data = tailList {data} l + in + cont + (unListData (headList {data} l)) + (unListData (headList {data} l)) + (unListData (headList {data} l)) + (unMapData (headList {data} l)) + (unMapData (headList {data} l)) + (unListData (headList {data} l)) + (unMapData (headList {data} l)) + (headList {data} l) + (unListData (headList {data} l)) + (unMapData (headList {data} l)) + (unMapData (headList {data} l)) + (`txOutRefId_$cunsafeFromBuiltinData` + (headList {data} (tailList {data} l))) + !`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` : + all a. (\a -> data -> a) a -> data -> Maybe a + = /\a -> + \(`$dUnsafeFromData` : (\a -> data -> a) a) (d : data) -> + casePair + {integer} + {list data} + {Maybe a} + (unConstrData d) + (\(index : integer) (args : list data) -> + case + (list data -> Maybe a) + index + [ (\(ds : list data) -> + Just {a} (`$dUnsafeFromData` (headList {data} ds))) + , (\(ds : list data) -> Nothing {a}) ] + args) + !`$mTxOut` : + all r. + data -> + (data -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + data -> + Maybe bytestring -> + r) -> + (unit -> r) -> + r + = /\r -> + \(scrut : data) + (cont : + data -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + data -> + Maybe bytestring -> + r) + (fail : unit -> r) -> + let + !l : list data + = case + (list data) + (unConstrData scrut) + [(\(l : integer) (r : list data) -> r)] + !l : list data = tailList {data} l + !l : list data = tailList {data} l + in + cont + (headList {data} l) + (unMapData (headList {data} l)) + (headList {data} l) + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + {bytestring} + unBData + (headList {data} (tailList {data} l))) + data AuthParams | AuthParams_match where + AuthParams : bytestring -> bytestring -> AuthParams + data FsMpParams | FsMpParams_match where + FsMpParams : + Tuple2 bytestring bytestring -> data -> AuthParams -> FsMpParams + data FsMpRedeemer | FsMpRedeemer_match where + FsMpBurn : FsMpRedeemer + FsMpMint : FsMpRedeemer + !addInteger : integer -> integer -> integer + = \(x : integer) (y : integer) -> addInteger x y + !fail : unit -> Ordering + = \(ds : unit) -> + let + !defaultBody : Ordering = error {Ordering} + in + Unit_match (error {Unit}) {Ordering} defaultBody + !`hull_$ccompare` : + all a. + Ord a -> + (\a -> a -> data) a -> + (\a -> data -> a) a -> + (\a -> data) a -> + (\a -> data) a -> + Ordering + = /\a -> + \(`$dOrd` : Ord a) + (`$dToData` : (\a -> a -> data) a) + (`$dUnsafeFromData` : (\a -> data -> a) a) + (ds : (\a -> data) a) + (ds : (\a -> data) a) -> + let + !fail : unit -> Ordering + = \(ds : unit) -> + case + (all dead. Ordering) + (equalsInteger + 2 + (case + integer + (unConstrData ds) + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> + case + (all dead. Ordering) + (equalsInteger + 2 + (case + integer + (unConstrData ds) + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> + let + !tup : pair integer (list data) + = unConstrData ds + in + case + (all dead. Ordering) + (equalsInteger + 1 + (case + integer + tup + [ (\(l : integer) (r : list data) -> + l) ])) + [ (/\dead -> fail ()) + , (/\dead -> + let + !tup : pair integer (list data) + = unConstrData ds + in + case + (all dead. Ordering) + (equalsInteger + 1 + (case + integer + tup + [ (\(l : integer) + (r : list data) -> + l) ])) + [ (/\dead -> fail ()) + , (/\dead -> + Ord_match + {a} + `$dOrd` + {a -> a -> Ordering} + (\(v : + (\a -> a -> a -> bool) a) + (v : a -> a -> Ordering) + (v : a -> a -> bool) + (v : a -> a -> bool) + (v : a -> a -> bool) + (v : a -> a -> bool) + (v : a -> a -> a) + (v : a -> a -> a) -> + v) + (`$dUnsafeFromData` + (headList + {data} + (case + (list data) + tup + [ (\(l : integer) + (r : + list data) -> + r) ]))) + (`$dUnsafeFromData` + (headList + {data} + (case + (list data) + tup + [ (\(l : integer) + (r : + list data) -> + r) ])))) ] + {all dead. dead}) ] + {all dead. dead}) + , (/\dead -> GT) ] + {all dead. dead}) + , (/\dead -> LT) ] + {all dead. dead} + in + case + (all dead. Ordering) + (equalsInteger + 0 + (case + integer + (unConstrData ds) + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> + case + (all dead. Ordering) + (equalsInteger + 0 + (case + integer + (unConstrData ds) + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> + case + (all dead. Ordering) + (equalsInteger + 2 + (case + integer + (unConstrData ds) + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> fail ()) + , (/\dead -> + case + (all dead. Ordering) + (equalsInteger + 2 + (case + integer + (unConstrData ds) + [ (\(l : integer) (r : list data) -> + l) ])) + [(/\dead -> fail ()), (/\dead -> EQ)] + {all dead. dead}) ] + {all dead. dead}) + , (/\dead -> GT) ] + {all dead. dead}) + , (/\dead -> + case + (all dead. Ordering) + (equalsInteger + 0 + (case + integer + (unConstrData ds) + [(\(l : integer) (r : list data) -> l)])) + [(/\dead -> LT), (/\dead -> EQ)] + {all dead. dead}) ] + {all dead. dead} + !`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` : data -> bool + = \(d : data) -> + casePair + {integer} + {list data} + {bool} + (unConstrData d) + (\(index : integer) (args : list data) -> + case + (list data -> bool) + index + [(\(ds : list data) -> False), (\(ds : list data) -> True)] + args) + !inclusiveLowerBound : + all a. + Enum a -> + (\a -> a -> data) a -> + (\a -> data -> a) a -> + (\a -> data) a -> + (\a -> data) a + = /\a -> + \(`$dEnum` : Enum a) + (`$dToData` : (\a -> a -> data) a) + (`$dUnsafeFromData` : (\a -> data -> a) a) + (ds : (\a -> data) a) -> + let + !l : list data + = case + (list data) + (unConstrData ds) + [(\(l : integer) (r : list data) -> r)] + ~v : data = headList {data} l + in + case + (all dead. (\a -> data) a) + (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` + (headList {data} (tailList {data} l))) + [ (/\dead -> + let + !tup : pair integer (list data) = unConstrData v + in + case + (all dead. (\a -> data) a) + (equalsInteger + 1 + (case + integer + tup + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> v) + , (/\dead -> + constrData + 1 + (mkCons + {data} + (`$dToData` + (Enum_match + {a} + `$dEnum` + {a -> a} + (\(v : a -> a) + (v : a -> a) + (v : integer -> a) + (v : a -> integer) + (v : a -> a -> List a) + (v : a -> a -> a -> List a) -> + v) + (`$dUnsafeFromData` + (headList + {data} + (case + (list data) + tup + [ (\(l : integer) + (r : list data) -> + r) ]))))) + [])) ] + {all dead. dead}) + , (/\dead -> v) ] + {all dead. dead} + !inclusiveUpperBound : + all a. + Enum a -> + (\a -> a -> data) a -> + (\a -> data -> a) a -> + (\a -> data) a -> + (\a -> data) a + = /\a -> + \(`$dEnum` : Enum a) + (`$dToData` : (\a -> a -> data) a) + (`$dUnsafeFromData` : (\a -> data -> a) a) + (ds : (\a -> data) a) -> + let + !l : list data + = case + (list data) + (unConstrData ds) + [(\(l : integer) (r : list data) -> r)] + ~v : data = headList {data} l + in + case + (all dead. (\a -> data) a) + (`$fUnsafeFromDataBool_$cunsafeFromBuiltinData` + (headList {data} (tailList {data} l))) + [ (/\dead -> + let + !tup : pair integer (list data) = unConstrData v + in + case + (all dead. (\a -> data) a) + (equalsInteger + 1 + (case + integer + tup + [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> v) + , (/\dead -> + constrData + 1 + (mkCons + {data} + (`$dToData` + (Enum_match + {a} + `$dEnum` + {a -> a} + (\(v : a -> a) + (v : a -> a) + (v : integer -> a) + (v : a -> integer) + (v : a -> a -> List a) + (v : a -> a -> a -> List a) -> + v) + (`$dUnsafeFromData` + (headList + {data} + (case + (list data) + tup + [ (\(l : integer) + (r : list data) -> + r) ]))))) + [])) ] + {all dead. dead}) + , (/\dead -> v) ] + {all dead. dead} + !isEmpty : + all a. + Enum a -> + Ord a -> + (\a -> a -> data) a -> + (\a -> data -> a) a -> + (\a -> data) a -> + bool + = /\a -> + \(`$dEnum` : Enum a) + (`$dOrd` : Ord a) + (`$dToData` : (\a -> a -> data) a) + (`$dUnsafeFromData` : (\a -> data -> a) a) + (ds : (\a -> data) a) -> + let + !l : list data + = case + (list data) + (unConstrData ds) + [(\(l : integer) (r : list data) -> r)] + in + Ordering_match + (`hull_$ccompare` + {a} + `$dOrd` + `$dToData` + `$dUnsafeFromData` + (inclusiveLowerBound + {a} + `$dEnum` + `$dToData` + `$dUnsafeFromData` + (headList {data} l)) + (inclusiveUpperBound + {a} + `$dEnum` + `$dToData` + `$dUnsafeFromData` + (headList {data} (tailList {data} l)))) + {all dead. bool} + (/\dead -> False) + (/\dead -> True) + (/\dead -> False) + {all dead. dead} + !contains : + all a. + Enum a -> + Ord a -> + (\a -> a -> data) a -> + (\a -> data -> a) a -> + (\a -> data) a -> + (\a -> data) a -> + bool + = /\a -> + \(`$dEnum` : Enum a) + (`$dOrd` : Ord a) + (`$dToData` : (\a -> a -> data) a) + (`$dUnsafeFromData` : (\a -> data -> a) a) + (ds : (\a -> data) a) + (i : (\a -> data) a) -> + case + (all dead. bool) + (isEmpty {a} `$dEnum` `$dOrd` `$dToData` `$dUnsafeFromData` i) + [ (/\dead -> + case + (all dead. bool) + (isEmpty + {a} + `$dEnum` + `$dOrd` + `$dToData` + `$dUnsafeFromData` + ds) + [ (/\dead -> + let + !l : list data + = case + (list data) + (unConstrData ds) + [(\(l : integer) (r : list data) -> r)] + !l : list data + = case + (list data) + (unConstrData i) + [(\(l : integer) (r : list data) -> r)] + in + case + (all dead. bool) + (let + !nt : data = headList {data} l + !nt : data = headList {data} l + in + Ordering_match + (`hull_$ccompare` + {a} + `$dOrd` + `$dToData` + `$dUnsafeFromData` + (inclusiveLowerBound + {a} + `$dEnum` + `$dToData` + `$dUnsafeFromData` + nt) + (inclusiveLowerBound + {a} + `$dEnum` + `$dToData` + `$dUnsafeFromData` + nt)) + {all dead. bool} + (/\dead -> True) + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + [ (/\dead -> False) + , (/\dead -> + let + !nt : data + = headList {data} (tailList {data} l) + !nt : data + = headList {data} (tailList {data} l) + in + Ordering_match + (`hull_$ccompare` + {a} + `$dOrd` + `$dToData` + `$dUnsafeFromData` + (inclusiveUpperBound + {a} + `$dEnum` + `$dToData` + `$dUnsafeFromData` + nt) + (inclusiveUpperBound + {a} + `$dEnum` + `$dToData` + `$dUnsafeFromData` + nt)) + {all dead. bool} + (/\dead -> True) + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) ] + {all dead. dead}) + , (/\dead -> False) ] + {all dead. dead}) + , (/\dead -> True) ] + {all dead. dead} + in + letrec + !go : list (pair data data) -> bool + = \(xs : list (pair data data)) -> + case + bool + xs + [ (\(hd : pair data data) -> + case + (all dead. list (pair data data) -> bool) + (equalsInteger + 0 + (unIData (case data hd [(\(l : data) (r : data) -> r)]))) + [ (/\dead -> \(ds : list (pair data data)) -> False) + , (/\dead -> go) ] + {all dead. dead}) + , True ] + in + letrec + !rev : all a. list a -> list a -> list a + = /\a -> + \(l : list a) (acc : list a) -> + case + (Unit -> list a) + l + [ (\(x : a) (xs : list a) (ds : Unit) -> + rev {a} xs (mkCons {a} x acc)) + , (\(ds : Unit) -> acc) ] + Unit + in + let + !unordEqWith : + (data -> bool) -> + (data -> data -> bool) -> + list (pair data data) -> + list (pair data data) -> + bool + = \(is : data -> bool) -> + letrec + !go : list (pair data data) -> bool + = \(xs : list (pair data data)) -> + case + bool + xs + [ (\(hd : pair data data) -> + case + (all dead. list (pair data data) -> bool) + (is (case data hd [(\(l : data) (r : data) -> r)])) + [ (/\dead -> \(ds : list (pair data data)) -> False) + , (/\dead -> go) ] + {all dead. dead}) + , True ] + in + letrec + !go : list (pair data data) -> bool + = \(xs : list (pair data data)) -> + case + bool + xs + [ (\(hd : pair data data) -> + case + (all dead. list (pair data data) -> bool) + (is (case data hd [(\(l : data) (r : data) -> r)])) + [ (/\dead -> \(ds : list (pair data data)) -> False) + , (/\dead -> go) ] + {all dead. dead}) + , True ] + in + \(eqV : data -> data -> bool) -> + letrec + !goBoth : + list (pair data data) -> list (pair data data) -> bool + = \(l : list (pair data data)) + (l : list (pair data data)) -> + case + (Unit -> bool) + l + [ (\(x : pair data data) -> + let + ~v : data + = case data x [(\(l : data) (r : data) -> r)] + in + \(xs : list (pair data data)) + (ds : Unit) -> + case + (Unit -> bool) + l + [ (\(x : pair data data) + (xs : list (pair data data)) + (ds : Unit) -> + let + !d : data + = case + data + x + [(\(l : data) (r : data) -> l)] + in + letrec + !goRight : + list (pair data data) -> + list (pair data data) -> + bool + = \(acc : list (pair data data)) + (l : list (pair data data)) -> + case + (Unit -> bool) + l + [ (\(x : pair data data) + (xs : list (pair data data)) + (ds : Unit) -> + let + !v : data + = case + data + x + [ (\(l : data) + (r : data) -> + r) ] + in + case + (all dead. bool) + (is v) + [ (/\dead -> + case + (all dead. bool) + (equalsData + (case + data + x + [ (\(l : data) + (r : + data) -> + l) ]) + d) + [ (/\dead -> + goRight + (mkCons + {pair + data + data} + x + acc) + xs) + , (/\dead -> + case + (all dead. + bool) + (eqV v v) + [ (/\dead -> + False) + , (/\dead -> + goBoth + xs + (rev + {pair + data + data} + acc + xs)) ] + {all dead. + dead}) ] + {all dead. dead}) + , (/\dead -> + goRight acc xs) ] + {all dead. dead}) + , (\(ds : Unit) -> False) ] + Unit + in + case + (all dead. bool) + (equalsData + d + (case + data + x + [(\(l : data) (r : data) -> l)])) + [ (/\dead -> + case + (all dead. bool) + (is v) + [ (/\dead -> + goRight + (case + (all dead. + list (pair data data)) + (is + (case + data + x + [ (\(l : data) + (r : data) -> + r) ])) + [ (/\dead -> + mkCons + {pair data data} + x + []) + , (/\dead -> []) ] + {all dead. dead}) + xs) + , (/\dead -> goBoth xs l) ] + {all dead. dead}) + , (/\dead -> + case + (all dead. bool) + (eqV + v + (case + data + x + [ (\(l : data) (r : data) -> + r) ])) + [ (/\dead -> False) + , (/\dead -> goBoth xs xs) ] + {all dead. dead}) ] + {all dead. dead}) + , (\(ds : Unit) -> go l) ] + Unit) + , (\(ds : Unit) -> + case + (Unit -> bool) + l + [ (\(x : pair data data) + (xs : list (pair data data)) + (ds : Unit) -> + go l) + , (\(ds : Unit) -> True) ] + Unit) ] + Unit + in + \(eta : list (pair data data)) (eta : list (pair data data)) -> + goBoth eta eta + !eq : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + bool + = \(ds : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer)) + (ds : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer)) -> + unordEqWith + (\(v : data) -> go (unMapData v)) + (\(v : data) (v : data) -> + unordEqWith + (\(v : data) -> equalsInteger 0 (unIData v)) + (\(v : data) (v : data) -> + equalsInteger (unIData v) (unIData v)) + (unMapData v) + (unMapData v)) + ds + ds + !singleton : + bytestring -> + bytestring -> + integer -> + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) + = \(c : bytestring) (tn : bytestring) (i : integer) -> + let + !nt : list (pair data data) + = mkCons {pair data data} (mkPairData (bData tn) (iData i)) [] + in + mkCons {pair data data} (mkPairData (bData c) (mapData nt)) [] + !valueOf : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer) -> + bytestring -> + bytestring -> + integer + = \(value : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer)) + (cur : bytestring) + (tn : bytestring) -> + Maybe_match + {data} + (lookup' (bData cur) value) + {integer} + (\(a : data) -> + let + !m : list (pair data data) = unMapData a + in + Maybe_match + {data} + (lookup' (bData tn) m) + {integer} + (\(a : data) -> unIData a) + 0) + 0 + in + \(p : FsMpParams) + (r : data) + (sc : data) -> + let + !ds : FsMpRedeemer + = casePair + {integer} + {list data} + {FsMpRedeemer} + (unConstrData r) + (\(index : integer) (args : list data) -> + case + (list data -> FsMpRedeemer) + index + [ (\(ds : list data) -> FsMpBurn) + , (\(ds : list data) -> FsMpMint) ] + args) + !fail : + unit -> unit + = \(ds : unit) -> + FsMpParams_match + p + {unit} + (\(ds : Tuple2 bytestring bytestring) + (ds : data) + (ds : AuthParams) -> + AuthParams_match + ds + {unit} + (\(ds : bytestring) -> + letrec + !go : list (pair data data) -> bool + = \(xs : list (pair data data)) -> + case + bool + xs + [ (\(hd : pair data data) -> + case + (all dead. list (pair data data) -> bool) + (equalsData + (bData ds) + (case + data + hd + [(\(l : data) (r : data) -> l)])) + [ (/\dead -> go) + , (/\dead -> + \(ds : list (pair data data)) -> + True) ] + {all dead. dead}) + , False ] + in + \(ds : bytestring) -> + FsMpRedeemer_match + ds + {all dead. unit} + (/\dead -> fail ()) + (/\dead -> + let + !l : list data + = case + (list data) + (unConstrData sc) + [(\(l : integer) (r : list data) -> r)] + in + `$mTxInfo` + {unit} + (headList {data} l) + (\(ds : (\a -> list data) data) + (ds : (\a -> list data) data) + (ds : (\a -> list data) data) + (ds : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) + bytestring + integer)) + (ds : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) + bytestring + integer)) + (ds : (\a -> list data) data) + (ds : + (\k a -> list (pair data data)) + data + integer) + (ds : (\a -> data) integer) + (ds : (\a -> list data) bytestring) + (ds : + (\k a -> list (pair data data)) data data) + (ds : + (\k a -> list (pair data data)) + bytestring + data) + (ds : bytestring) -> + let + !tup : pair integer (list data) + = unConstrData + (headList {data} (tailList {data} l)) + ~ownCs : bytestring + = unBData + (headList + {data} + (case + (list data) + tup + [ (\(l : integer) + (r : list data) -> + r) ])) + in + letrec + !go : + Tuple2 + ((\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) + bytestring + integer)) + (List data) -> + list data -> + Tuple2 + ((\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) + bytestring + integer)) + (List data) + = \(acc : + Tuple2 + ((\k a -> list (pair data data)) + bytestring + ((\k a -> + list (pair data data)) + bytestring + integer)) + (List data)) + (xs : list data) -> + case + (Tuple2 + ((\k a -> list (pair data data)) + bytestring + ((\k a -> + list (pair data data)) + bytestring + integer)) + (List data)) + xs + [ (\(h : data) + (t : list data) -> + go + (Tuple2_match + {(\k a -> + list (pair data data)) + bytestring + ((\k a -> + list + (pair data data)) + bytestring + integer)} + {List data} + acc + {Tuple2 + ((\k a -> + list + (pair data data)) + bytestring + ((\k a -> + list + (pair + data + data)) + bytestring + integer)) + (List data)} + (\(fsToMint' : + (\k a -> + list + (pair + data + data)) + bytestring + ((\k a -> + list + (pair + data + data)) + bytestring + integer)) + (unusedAuthInputs : + List data) -> + let + !l : + list data + = case + (list data) + (unConstrData + h) + [ (\(l : + integer) + (r : + list + data) -> + r) ] + !l : list data + = tailList {data} l + !ds : data + = headList + {data} + (tailList + {data} + l) + !nt : + list + (pair data data) + = let + !nt : bytestring + = ownCs + in + Maybe_match + {data} + (lookup' + (bData nt) + (unMapData + (headList + {data} + l))) + {(\k a -> + list + (pair + data + data)) + bytestring + integer} + (\(a : data) -> + unMapData a) + [] + in + case + (all dead. + Tuple2 + ((\k a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)) + (List data)) + (nullList + {pair data data} + nt) + [ (/\dead -> + Tuple2_match + {Maybe + bytestring} + {List data} + ((let + b + = Tuple2 + (Maybe + bytestring) + (List + data) + in + \(f : + b -> + data -> + b) -> + letrec + !go : + b -> + List + data -> + b + = \(acc : + b) + (ds : + List + data) -> + List_match + {data} + ds + {all dead. + b} + (/\dead -> + acc) + (\(x : + data) + (xs : + List + data) -> + /\dead -> + go + (f + acc + x) + xs) + {all dead. + dead} + in + \(eta : + b) + (eta : + List + data) -> + go + eta + eta) + (\(ds : + Tuple2 + (Maybe + bytestring) + (List + data)) + (authInput : + data) -> + Tuple2_match + {Maybe + bytestring} + {List + data} + ds + {Tuple2 + (Maybe + bytestring) + (List + data)} + (\(ds : + Maybe + bytestring) + (unusedAuthInputs'' : + List + data) -> + Maybe_match + {bytestring} + ds + {all dead. + Tuple2 + (Maybe + bytestring) + (List + data)} + (\(ipv : + bytestring) -> + /\dead -> + Tuple2 + {Maybe + bytestring} + {List + data} + ds + (Cons + {data} + authInput + unusedAuthInputs'')) + (/\dead -> + let + !nt : + bytestring + = let + !l : + list + data + = case + (list + data) + (unConstrData + (headList + {data} + (case + (list + data) + (unConstrData + authInput) + [ (\(l : + integer) + (r : + list + data) -> + r) ]))) + [ (\(l : + integer) + (r : + list + data) -> + r) ] + !x : + integer + = unIData + (headList + {data} + (tailList + {data} + l)) + in + case + (all dead. + bytestring) + (lessThanInteger + x + 256) + [ (/\dead -> + let + !x : + Unit + = trace + {Unit} + "hashInput: Transaction output index must fit in an octet" + Unit + in + error + {bytestring}) + , (/\dead -> + blake2b_256 + (consByteString + x + (`txOutRefId_$cunsafeFromBuiltinData` + (headList + {data} + l)))) ] + {all dead. + dead} + in + case + (all dead. + Tuple2 + (Maybe + bytestring) + (List + data)) + (eq + (mkCons + {pair + data + data} + (mkPairData + (bData + ownCs) + (mapData + nt)) + [ ]) + (singleton + ownCs + nt + 1)) + [ (/\dead -> + Tuple2 + {Maybe + bytestring} + {List + data} + (Nothing + {bytestring}) + (Cons + {data} + authInput + unusedAuthInputs'')) + , (/\dead -> + Tuple2 + {Maybe + bytestring} + {List + data} + (Just + {bytestring} + nt) + unusedAuthInputs'') ] + {all dead. + dead}) + {all dead. + dead})) + (Tuple2 + {Maybe + bytestring} + {List + data} + (Nothing + {bytestring}) + (Nil + {data})) + unusedAuthInputs) + {Tuple2 + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)) + (List + data)} + (\(ipv : + Maybe + bytestring) + (ipv : + List + data) -> + let + !_checkAddress : + unit + = case + (all dead. + unit) + (let + !l : + list + data + = case + (list + data) + (unConstrData + ds) + [ (\(l : + integer) + (r : + list + data) -> + r) ] + !l : + list + data + = case + (list + data) + (unConstrData + (headList + {data} + l)) + [ (\(l : + integer) + (r : + list + data) -> + r) ] + in + case + (all dead. + bool) + (`$fEqCredential_$c==` + (headList + {data} + l) + (headList + {data} + l)) + [ (/\dead -> + False) + , (/\dead -> + Maybe_match + {data} + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + {data} + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (headList + {data} + (tailList + {data} + l))) + {all dead. + bool} + (\(a : + data) -> + /\dead -> + Maybe_match + {data} + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + {data} + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (headList + {data} + (tailList + {data} + l))) + {bool} + (\(a : + data) -> + let + !fail : + unit -> + bool + = \(ds : + unit) -> + `$mStakingPtr` + {bool} + a + (\(a : + integer) + (b : + integer) + (c : + integer) -> + `$mStakingPtr` + {bool} + a + (\(a' : + integer) + (b' : + integer) + (c' : + integer) -> + case + (all dead. + bool) + (equalsInteger + a + a') + [ (/\dead -> + False) + , (/\dead -> + case + (all dead. + bool) + (equalsInteger + b + b') + [ (/\dead -> + False) + , (/\dead -> + equalsInteger + c + c') ] + {all dead. + dead}) ] + {all dead. + dead}) + (\(void : + unit) -> + False)) + (\(void : + unit) -> + False) + !tup : + pair + integer + (list + data) + = unConstrData + a + in + case + (all dead. + bool) + (equalsInteger + 0 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + fail + ()) + , (/\dead -> + let + !tup : + pair + integer + (list + data) + = unConstrData + a + in + case + (all dead. + bool) + (equalsInteger + 0 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + fail + ()) + , (/\dead -> + `$fEqCredential_$c==` + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ])) + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ]))) ] + {all dead. + dead}) ] + {all dead. + dead}) + False) + (/\dead -> + Maybe_match + {data} + (`$fUnsafeFromDataMaybe_$cunsafeFromBuiltinData` + {data} + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (headList + {data} + (tailList + {data} + l))) + {bool} + (\(ipv : + data) -> + False) + True) + {all dead. + dead}) ] + {all dead. + dead}) + [ (/\dead -> + let + !x : + Unit + = trace + {Unit} + "minted value is not sent to correct address" + Unit + in + error + {unit}) + , (/\dead -> + ()) ] + {all dead. + dead} + !_checkDatum : + FsDatum + = case + (all dead. + FsDatum) + (equalsInteger + 0 + (case + integer + (unConstrData + ds) + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !tup : + pair + integer + (list + data) + = unConstrData + ds + in + case + (all dead. + FsDatum) + (equalsInteger + 1 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !tup : + pair + integer + (list + data) + = unConstrData + ds + in + case + (all dead. + FsDatum) + (equalsInteger + 2 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !defaultBody : + FsDatum + = error + {FsDatum} + in + Unit_match + (error + {Unit}) + {FsDatum} + defaultBody) + , (/\dead -> + `$fUnsafeFromDataFsDatum_$cunsafeFromBuiltinData` + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ]))) ] + {all dead. + dead}) + , (/\dead -> + let + !nt : + bytestring + = unBData + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ])) + in + Maybe_match + {data} + (lookup' + (bData + nt) + ds) + {all dead. + FsDatum} + (\(a : + data) -> + /\dead -> + `$fUnsafeFromDataFsDatum_$cunsafeFromBuiltinData` + a) + (/\dead -> + let + !x : + Unit + = trace + {Unit} + "expected datum but given datum hash have no associated datum" + Unit + in + error + {FsDatum}) + {all dead. + dead}) ] + {all dead. + dead}) + , (/\dead -> + let + !x : + Unit + = trace + {Unit} + "expected datum but got no datum" + Unit + in + error + {FsDatum}) ] + {all dead. + dead} + in + Maybe_match + {bytestring} + ipv + {all dead. + Tuple2 + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)) + (List + data)} + (\(fsTn : + bytestring) -> + /\dead -> + Tuple2 + {(\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)} + {List + data} + (`$fAdditiveGroupValue` + addInteger + fsToMint' + (singleton + ownCs + fsTn + 1)) + ipv) + (/\dead -> + let + !x : + Unit + = trace + {Unit} + "$FS must have a token name formed from a matching $AUTH input" + Unit + in + error + {Tuple2 + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)) + (List + data)}) + {all dead. + dead})) + , (/\dead -> acc) ] + {all dead. dead})) + t) + , acc ] + in + case + (all dead. unit) + (equalsInteger + 0 + (case + integer + tup + [ (\(l : integer) (r : list data) -> + l) ])) + [ (/\dead -> fail ()) + , (/\dead -> + let + !validCerts : + List CertDatum + = (let + b = List CertDatum + in + \(`$dUnsafeFromData` : + (\a -> data -> a) data) + (f : b -> data -> b) -> + letrec + !go : + b -> list data -> b + = \(acc : b) + (xs : list data) -> + case + b + xs + [ (\(h : data) + (t : + list + data) -> + let + !h' : + data + = `$dUnsafeFromData` + h + in + go + (f acc h') + t) + , acc ] + in + \(z : b) + (eta : + (\a -> list data) + data) -> + go z eta) + `$fUnsafeFromDataBuiltinData_$cunsafeFromBuiltinData` + (\(acc : List CertDatum) + (ds : data) -> + let + !l : list data + = case + (list data) + (unConstrData ds) + [ (\(l : integer) + (r : + list data) -> + r) ] + in + `$mTxOut` + {List CertDatum} + (headList + {data} + (tailList {data} l)) + (\(ds : data) + (ds : + (\k a -> + list + (pair + data + data)) + bytestring + ((\k a -> + list + (pair + data + data)) + bytestring + integer)) + (ds : data) + (ds : + Maybe bytestring) -> + let + !nt : + list + (pair data data) + = Maybe_match + {data} + (lookup' + (bData ds) + ds) + {(\k a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)} + (\(a : data) -> + let + !nt : + list + (pair + data + data) + = unMapData + a + in + mkCons + {pair + data + data} + (mkPairData + (bData + ds) + (mapData + nt)) + []) + [] + in + case + (all dead. + List CertDatum) + (eq nt []) + [ (/\dead -> + CertDatum_match + (case + (all dead. + CertDatum) + (equalsInteger + 0 + (case + integer + (unConstrData + ds) + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !tup : + pair + integer + (list + data) + = unConstrData + ds + in + case + (all dead. + CertDatum) + (equalsInteger + 1 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !tup : + pair + integer + (list + data) + = unConstrData + ds + in + case + (all dead. + CertDatum) + (equalsInteger + 2 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !defaultBody : + CertDatum + = error + {CertDatum} + in + Unit_match + (error + {Unit}) + {CertDatum} + defaultBody) + , (/\dead -> + `$fUnsafeFromDataCertDatum_$cunsafeFromBuiltinData` + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ]))) ] + {all dead. + dead}) + , (/\dead -> + let + !nt : + bytestring + = unBData + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ])) + in + Maybe_match + {data} + (lookup' + (bData + nt) + ds) + {all dead. + CertDatum} + (\(a : + data) -> + /\dead -> + `$fUnsafeFromDataCertDatum_$cunsafeFromBuiltinData` + a) + (/\dead -> + let + !x : + Unit + = trace + {Unit} + "expected datum but given datum hash have no associated datum" + Unit + in + error + {CertDatum}) + {all dead. + dead}) ] + {all dead. + dead}) + , (/\dead -> + let + !x : + Unit + = trace + {Unit} + "expected datum but got no datum" + Unit + in + error + {CertDatum}) ] + {all dead. + dead}) + {List + CertDatum} + (\(ds : + bytestring) + (ds : + (\a -> + data) + integer) + (ds : + Tuple2 + bytestring + bytestring) -> + let + !_checkTokenName : + unit + = case + (all dead. + unit) + (equalsInteger + 1 + (valueOf + nt + ds + ds)) + [ (/\dead -> + let + !x : + Unit + = trace + {Unit} + "$CERT token name must match CertDatum ID" + Unit + in + error + {unit}) + , (/\dead -> + ()) ] + {all dead. + dead} + !_checkRange : + unit + = case + (all dead. + unit) + (contains + {integer} + `$fEnumPOSIXTime` + `$fOrdPOSIXTime` + `$fToDataInteger_$ctoBuiltinData` + unIData + ds + ds) + [ (/\dead -> + let + !x : + Unit + = trace + {Unit} + "cert is invalid" + Unit + in + error + {unit}) + , (/\dead -> + ()) ] + {all dead. + dead} + in + Cons + {CertDatum} + (case + (all dead. + CertDatum) + (equalsInteger + 0 + (case + integer + (unConstrData + ds) + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !tup : + pair + integer + (list + data) + = unConstrData + ds + in + case + (all dead. + CertDatum) + (equalsInteger + 1 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !tup : + pair + integer + (list + data) + = unConstrData + ds + in + case + (all dead. + CertDatum) + (equalsInteger + 2 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !defaultBody : + CertDatum + = error + {CertDatum} + in + Unit_match + (error + {Unit}) + {CertDatum} + defaultBody) + , (/\dead -> + `$fUnsafeFromDataCertDatum_$cunsafeFromBuiltinData` + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ]))) ] + {all dead. + dead}) + , (/\dead -> + let + !nt : + bytestring + = unBData + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ])) + in + Maybe_match + {data} + (lookup' + (bData + nt) + ds) + {all dead. + CertDatum} + (\(a : + data) -> + /\dead -> + `$fUnsafeFromDataCertDatum_$cunsafeFromBuiltinData` + a) + (/\dead -> + let + !x : + Unit + = trace + {Unit} + "expected datum but given datum hash have no associated datum" + Unit + in + error + {CertDatum}) + {all dead. + dead}) ] + {all dead. + dead}) + , (/\dead -> + let + !x : + Unit + = trace + {Unit} + "expected datum but got no datum" + Unit + in + error + {CertDatum}) ] + {all dead. + dead}) + acc)) + , (/\dead -> acc) ] + {all dead. dead}) + (\(void : unit) -> + let + !defaultBody : + List CertDatum + = error + {List + CertDatum} + in + Unit_match + (error {Unit}) + {List CertDatum} + defaultBody)) + (Nil {CertDatum}) + ds + in + letrec + !go : + Tuple2 + (List data) + ((\k a -> list (pair data data)) + bytestring + ((\k a -> + list (pair data data)) + bytestring + integer)) -> + list data -> + Tuple2 + (List data) + ((\k a -> list (pair data data)) + bytestring + ((\k a -> + list (pair data data)) + bytestring + integer)) + = \(acc : + Tuple2 + (List data) + ((\k a -> + list (pair data data)) + bytestring + ((\k a -> + list + (pair data data)) + bytestring + integer))) + (xs : list data) -> + case + (Tuple2 + (List data) + ((\k a -> + list (pair data data)) + bytestring + ((\k a -> + list + (pair data data)) + bytestring + integer))) + xs + [ (\(h : data) + (t : list data) -> + go + (Tuple2_match + {List data} + {(\k a -> + list + (pair + data + data)) + bytestring + ((\k a -> + list + (pair + data + data)) + bytestring + integer)} + acc + {Tuple2 + (List data) + ((\k a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer))} + (\(validAuthInputs'' : + List data) + (shouldBeBurned : + (\k a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)) -> + let + !l : + list data + = case + (list + data) + (unConstrData + h) + [ (\(l : + integer) + (r : + list + data) -> + r) ] + in + `$mTxOut` + {Tuple2 + (List data) + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer))} + (headList + {data} + (tailList + {data} + l)) + (\(ds : data) + (ds : + (\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)) -> + letrec + !go : + List + CertDatum -> + Maybe + CertDatum + = \(ds : + List + CertDatum) -> + List_match + {CertDatum} + ds + {all dead. + Maybe + CertDatum} + (/\dead -> + Nothing + {CertDatum}) + (\(x : + CertDatum) + (xs : + List + CertDatum) -> + /\dead -> + case + (all dead. + Maybe + CertDatum) + (CertDatum_match + x + {bool} + (\(ds : + bytestring) + (ds : + (\a -> + data) + integer) + (ds : + Tuple2 + bytestring + bytestring) -> + lessThanInteger + 0 + (valueOf + ds + ds + ds))) + [ (/\dead -> + go + xs) + , (/\dead -> + Just + {CertDatum} + x) ] + {all dead. + dead}) + {all dead. + dead} + in + \(ds : + data) + (ds : + Maybe + bytestring) -> + case + (all dead. + Tuple2 + (List + data) + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer))) + (go ds) + [ (/\dead -> + acc) + , (/\dead -> + Maybe_match + {CertDatum} + (go + validCerts) + {all dead. + Tuple2 + (List + data) + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer))} + (\(ds : + CertDatum) -> + /\dead -> + CertDatum_match + ds + {Tuple2 + (List + data) + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer))} + (\(ds : + bytestring) + (ds : + (\a -> + data) + integer) + (ds : + Tuple2 + bytestring + bytestring) -> + Tuple2 + {List + data} + {(\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)} + (Cons + {data} + h + validAuthInputs'') + (`$fAdditiveGroupValue` + addInteger + shouldBeBurned + (singleton + ds + ds + -1)))) + (/\dead -> + let + !x : + Unit + = trace + {Unit} + "$AUTH must be validated with a $CERT" + Unit + in + error + {Tuple2 + (List + data) + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer))}) + {all dead. + dead}) ] + {all dead. + dead}) + (\(void : + unit) -> + let + !defaultBody : + Tuple2 + (List + data) + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)) + = error + {Tuple2 + (List + data) + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer))} + in + Unit_match + (error + {Unit}) + {Tuple2 + (List + data) + ((\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer))} + defaultBody))) + t) + , acc ] + in + let + !f : + list data -> + Tuple2 + (List data) + ((\k a -> list (pair data data)) + bytestring + ((\k a -> + list (pair data data)) + bytestring + integer)) + = go + (Tuple2 + {List data} + {(\k a -> + list (pair data data)) + bytestring + ((\k a -> + list + (pair data data)) + bytestring + integer)} + (Nil {data}) + []) + !validAuthInputs : + List data + = Tuple2_match + {List data} + {(\k a -> + list (pair data data)) + bytestring + ((\k a -> + list (pair data data)) + bytestring + integer)} + (f ds) + {List data} + (\(ipv : List data) + (ipv : + (\k a -> + list (pair data data)) + bytestring + ((\k a -> + list + (pair data data)) + bytestring + integer)) -> + let + !_checkBurn : + unit + = case + (all dead. unit) + (eq + (Maybe_match + {data} + (lookup' + (bData ds) + ds) + {(\k + a -> + list + (pair + data + data)) + bytestring + ((\k + a -> + list + (pair + data + data)) + bytestring + integer)} + (\(a : + data) -> + let + !nt : + list + (pair + data + data) + = unMapData + a + in + mkCons + {pair + data + data} + (mkPairData + (bData + ds) + (mapData + nt)) + []) + []) + ipv) + [ (/\dead -> + let + !x : Unit + = trace + {Unit} + "" + Unit + in + error {unit}) + , (/\dead -> ()) ] + {all dead. dead} + in + ipv) + !f : + list data -> + Tuple2 + ((\k a -> list (pair data data)) + bytestring + ((\k a -> + list (pair data data)) + bytestring + integer)) + (List data) + = go + (Tuple2 + {(\k a -> + list (pair data data)) + bytestring + ((\k a -> + list + (pair data data)) + bytestring + integer)} + {List data} + [] + validAuthInputs) + in + Tuple2_match + {(\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) + bytestring + integer)} + {List data} + (f ds) + {unit} + (\(ipv : + (\k a -> list (pair data data)) + bytestring + ((\k a -> + list (pair data data)) + bytestring + integer)) + (ipv : List data) -> + let + !_checkAuthUse : + unit + = case + (all dead. unit) + (List_match + {data} + ipv + {bool} + True + (\(ipv : data) + (ipv : List data) -> + False)) + [ (/\dead -> + let + !x : + Unit + = trace + {Unit} + "Auth inputs must ALL be used" + Unit + in + error {unit}) + , (/\dead -> ()) ] + {all dead. dead} + !_checkBurn : unit + = case + (all dead. unit) + (eq + (Maybe_match + {data} + (lookup' + (bData ownCs) + ds) + {(\k a -> + list + (pair + data + data)) + bytestring + ((\k a -> + list + (pair + data + data)) + bytestring + integer)} + (\(a : data) -> + let + !nt : + list + (pair + data + data) + = unMapData a + in + mkCons + {pair + data + data} + (mkPairData + (bData + ownCs) + (mapData + nt)) + []) + []) + ipv) + [ (/\dead -> + let + !x : Unit + = trace + {Unit} + "" + Unit + in + error {unit}) + , (/\dead -> ()) ] + {all dead. dead} + in + ())) ] + {all dead. dead}) + (\(void : unit) -> fail ())) + {all dead. dead})) + in + FsMpRedeemer_match + ds + {all dead. unit} + (/\dead -> + let + !l : list data + = case + (list data) + (unConstrData sc) + [(\(l : integer) (r : list data) -> r)] + in + `$mTxInfo` + {unit} + (headList {data} l) + (\(ds : (\a -> list data) data) + (ds : (\a -> list data) data) + (ds : (\a -> list data) data) + (ds : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer)) + (ds : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer)) + (ds : (\a -> list data) data) + (ds : (\k a -> list (pair data data)) data integer) + (ds : (\a -> data) integer) + (ds : (\a -> list data) bytestring) + (ds : (\k a -> list (pair data data)) data data) + (ds : (\k a -> list (pair data data)) bytestring data) + (ds : bytestring) -> + let + !tup : pair integer (list data) + = unConstrData (headList {data} (tailList {data} l)) + in + case + (all dead. unit) + (equalsInteger + 0 + (case integer tup [(\(l : integer) (r : list data) -> l)])) + [ (/\dead -> fail ()) + , (/\dead -> + let + !ownCs : bytestring + = unBData + (headList + {data} + (case + (list data) + tup + [(\(l : integer) (r : list data) -> r)])) + in + letrec + !go : + (\k a -> list (pair data data)) bytestring integer -> + list data -> + (\k a -> list (pair data data)) bytestring integer + = \(acc : + (\k a -> list (pair data data)) + bytestring + integer) + (xs : list data) -> + case + ((\k a -> list (pair data data)) + bytestring + integer) + xs + [ (\(h : data) + (t : list data) -> + go + (let + !l : list data + = case + (list data) + (unConstrData h) + [ (\(l : integer) + (r : list data) -> + r) ] + in + `$mTxOut` + {(\k a -> list (pair data data)) + bytestring + integer} + (headList {data} (tailList {data} l)) + (\(ds : data) + (ds : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) + bytestring + integer)) + (ds : data) + (ds : Maybe bytestring) -> + let + !nt : list (pair data data) + = Maybe_match + {data} + (lookup' (bData ownCs) ds) + {(\k a -> + list (pair data data)) + bytestring + integer} + (\(a : data) -> unMapData a) + [] + in + case + (all dead. + (\k a -> list (pair data data)) + bytestring + integer) + (nullList {pair data data} nt) + [ (/\dead -> + FsDatum_match + (case + (all dead. FsDatum) + (equalsInteger + 0 + (case + integer + (unConstrData ds) + [ (\(l : integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !tup : + pair + integer + (list data) + = unConstrData + ds + in + case + (all dead. + FsDatum) + (equalsInteger + 1 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !tup : + pair + integer + (list + data) + = unConstrData + ds + in + case + (all dead. + FsDatum) + (equalsInteger + 2 + (case + integer + tup + [ (\(l : + integer) + (r : + list + data) -> + l) ])) + [ (/\dead -> + let + !defaultBody : + FsDatum + = error + {FsDatum} + in + Unit_match + (error + {Unit}) + {FsDatum} + defaultBody) + , (/\dead -> + `$fUnsafeFromDataFsDatum_$cunsafeFromBuiltinData` + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ]))) ] + {all dead. + dead}) + , (/\dead -> + let + !nt : + bytestring + = unBData + (headList + {data} + (case + (list + data) + tup + [ (\(l : + integer) + (r : + list + data) -> + r) ])) + in + Maybe_match + {data} + (lookup' + (bData + nt) + ds) + {all dead. + FsDatum} + (\(a : + data) -> + /\dead -> + `$fUnsafeFromDataFsDatum_$cunsafeFromBuiltinData` + a) + (/\dead -> + let + !x : + Unit + = trace + {Unit} + "expected datum but given datum hash have no associated datum" + Unit + in + error + {FsDatum}) + {all dead. + dead}) ] + {all dead. dead}) + , (/\dead -> + let + !x : + Unit + = trace + {Unit} + "expected datum but got no datum" + Unit + in + error {FsDatum}) ] + {all dead. dead}) + {(\k a -> + list (pair data data)) + bytestring + integer} + (\(ipv : data) + (ipv : bytestring) + (ipv : + (\a -> data) integer) + (ipv : bytestring) -> + let + !_checkSignature : + unit + = case + (all dead. unit) + ((letrec + !go : + list + data -> + bool + = let + !x' : + data + = bData + ipv + in + \(xs : + list + data) -> + case + bool + xs + [ (\(h : + data) + (t : + list + data) -> + case + (all dead. + bool) + (equalsData + x' + h) + [ (/\dead -> + go + t) + , (/\dead -> + True) ] + {all dead. + dead}) + , False ] + in + \(eta : + (\a -> + list + data) + bytestring) -> + go eta) + ds) + [ (/\dead -> + let + !x : + Unit + = trace + {Unit} + "submitter must sign" + Unit + in + error + {unit}) + , (/\dead -> + ()) ] + {all dead. dead} + !_checkRange : + unit + = case + (all dead. unit) + (contains + {integer} + `$fEnumPOSIXTime` + `$fOrdPOSIXTime` + `$fToDataInteger_$ctoBuiltinData` + unIData + (constrData + 0 + (mkCons + {data} + (constrData + 0 + (mkCons + {data} + ipv + [ Constr 0 + [ ] ])) + [ Constr 0 + [ Constr 2 + [ ] + , Constr 1 + [ ] ] ])) + ds) + [ (/\dead -> + let + !x : + Unit + = trace + {Unit} + "valid range is correct" + Unit + in + error + {unit}) + , (/\dead -> + ()) ] + {all dead. dead} + in + (let + a = pair data data + in + /\b -> + \(f : a -> b -> b) + (acc : b) -> + letrec + !go : + list a -> b + = \(xs : + list + a) -> + case + b + xs + [ (\(x : + a) + (xs : + list + a) -> + f + x + (go + xs)) + , acc ] + in + go) + {list (pair data data)} + (mkCons + {pair data data}) + nt + acc)) + , (/\dead -> acc) ] + {all dead. dead}) + (\(void : unit) -> + let + !defaultBody : + (\k a -> list (pair data data)) + bytestring + integer + = error + {(\k a -> + list (pair data data)) + bytestring + integer} + in + Unit_match + (error {Unit}) + {(\k a -> list (pair data data)) + bytestring + integer} + defaultBody)) + t) + , acc ] + in + let + !nt : list (pair data data) + = let + !nt : list (pair data data) + = let + !nt : list (pair data data) = go [] ds + in + mkCons + {pair data data} + (mkPairData (bData ownCs) (mapData nt)) + [] + in + `$fAdditiveGroupValue` + addInteger + [] + (map + {bytestring} + {(\k a -> list (pair data data)) + bytestring + integer} + {(\k a -> list (pair data data)) + bytestring + integer} + (\(eta : data) -> unMapData eta) + (`$fToDataMap_$ctoBuiltinData` + {bytestring} + {integer}) + (map + {bytestring} + {integer} + {integer} + unIData + `$fToDataInteger_$ctoBuiltinData` + (\(i' : integer) -> multiplyInteger -1 i')) + nt) + !_checkBurn : unit + = case + (all dead. unit) + (eq + (Maybe_match + {data} + (lookup' (bData ownCs) ds) + {(\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) + bytestring + integer)} + (\(a : data) -> + let + !nt : list (pair data data) + = unMapData a + in + mkCons + {pair data data} + (mkPairData (bData ownCs) (mapData nt)) + []) + []) + nt) + [ (/\dead -> + let + !x : Unit = trace {Unit} "" Unit + in + error {unit}) + , (/\dead -> ()) ] + {all dead. dead} + in + ()) ] + {all dead. dead}) + (\(void : unit) -> fail ())) + (/\dead -> fail ()) + {all dead. dead}) + (let + `PlutusLedgerApi.V1.Data.Value.TokenName` = bytestring + in + let + `PlutusLedgerApi.V1.Data.Value.CurrencySymbol` = bytestring + in + let + data (`GHC.Tuple.Prim.Tuple2` :: * -> * -> *) a + b | `match_GHC.Tuple.Prim.Tuple2` where + `GHC.Tuple.Prim.Tuple2` : a -> b -> `GHC.Tuple.Prim.Tuple2` a b + in + let + `PlutusLedgerApi.V1.Data.Value.AssetClass` + = `GHC.Tuple.Prim.Tuple2` bytestring bytestring + in + let + `PlutusLedgerApi.V1.Data.Address.Address` = data + in + let + data `PlutusBenchmark.Coop.Types.AuthParams` | `match_PlutusBenchmark.Coop.Types.AuthParams` where + `PlutusBenchmark.Coop.Types.AuthParams` : + bytestring -> bytestring -> `PlutusBenchmark.Coop.Types.AuthParams` + in + let + data `PlutusBenchmark.Coop.Types.FsMpParams` | `match_PlutusBenchmark.Coop.Types.FsMpParams` where + `PlutusBenchmark.Coop.Types.FsMpParams` : + `GHC.Tuple.Prim.Tuple2` bytestring bytestring -> + data -> + `PlutusBenchmark.Coop.Types.AuthParams` -> + `PlutusBenchmark.Coop.Types.FsMpParams` + in + `PlutusBenchmark.Coop.Types.FsMpParams` + (`GHC.Tuple.Prim.Tuple2` + {bytestring} + {bytestring} + #24434f4f502043757272656e637953796d626f6c + #24434f4f5020546f6b656e4e616d65) + (Constr 0 [Constr 1 [B #404673562068617368], Constr 1 []]) + (`PlutusBenchmark.Coop.Types.AuthParams` + #617574682d706f6c6963792d2068617368 + #636572742d706f6c6963792d2068617368)) + (Constr 1 []) + (Constr 0 + [ Constr 0 + [ List + [ Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d69647572786b75666675776168616972646b736c61 ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d6263747a65757072636672656b7074767566646b6563776178 ] + , Constr 1 [] ] + , Map + [ ( B #617574682d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d69647572786b75666675776168616972646b736c61 + , I 1 ) ] ) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d69657272666f66707a687075646868656f7371727a ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d687775686973676a7773636277776e7a7a7169636f6c7a726f ] + , Constr 1 [] ] + , Map + [ ( B #617574682d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d69657272666f66707a687075646868656f7371727a + , I 8 ) ] ) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d6b6c6f73617a7366706373747374626f6270746c6e ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d7776617a6972696f7674736f657a676476626e697663766161 ] + , Constr 1 [] ] + , Map + [ ( B #617574682d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d6b6c6f73617a7366706373747374626f6270746c6e + , I 4 ) ] ) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d6d6a617471706f6172777163787069676978706765 ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d7a71636467796e726b6d74636b737a666e67697078636e65 ] + , Constr 1 [] ] + , Map + [ ( B #617574682d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d6d6a617471706f6172777163787069676978706765 + , I 10 ) ] ) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d7376767a7a6166646a647576766173717261706862 ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d6c6a6c7662766f72626a7161786a6962736d79676572746b ] + , Constr 1 [] ] + , Map + [ ( B #617574682d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d7376767a7a6166646a647576766173717261706862 + , I 6 ) ] ) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #747869642d67716177626a6d676f706465706673697a66717361776a ] + , I 165 ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d6d626f6e666c646571686664667578777278696b6a6376647a ] + , Constr 1 [] ] + , Map + [ ( B #63732d7878786e6466676b76716479647a6b796976787065726f6c71 + , Map + [ ( B #746e2d7a7365736f71636f7a6b77627870616e676a716273797668787a68776c + , I 50 ) ] ) + , (B #, Map [(B #, I 1)]) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #747869642d6a67736e6a736b6c7175716677687a716c6d65796f6778 ] + , I 185 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d71777672626f6e6f6f65637a7562696e7461706379737861 ] + , Constr 1 [] ] + , Map + [ ( B #63732d706c646e7466796f736e74666a73726e69787775717374636e + , Map + [ ( B #746e2d7a7670796272687565616e6f6a746d656d66796470677a6f6474707370 + , I 24 ) ] ) + , (B #, Map [(B #, I 1)]) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #747869642d6a7774656f6b617172616f68706273636d626779746172 ] + , I 28 ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d6a7370666c6d746862786a687a786c7373646c6c7a74786c74 ] + , Constr 1 [] ] + , Map + [ ( B #63732d7172656a6a68687a7a67696d666574666e62776174746c7873 + , Map + [ ( B #746e2d6f7876726e6a62697a6662687072646472796561656a6f756f72746c6f + , I 54 ) ] ) + , (B #, Map [(B #, I 1)]) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #747869642d6e736a7a7673726162766e6f6c7a746f78636e6f65706a ] + , I 119 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d62616378746a6b6a637769726274737165787767636a6261 ] + , Constr 1 [] ] + , Map + [ ( B #63732d7565676e74716661717477656d616469626d65676269766e6b + , Map + [ ( B #746e2d69706f656d756f6473756c62746e75697a7a70626d74616f6c796c7375 + , I 24 ) ] ) + , (B #, Map [(B #, I 1)]) ] + , Constr 0 [] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #747869642d70726969767267696e736c6279647874637a63786f6961 ] + , I 32 ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d7a73786d6973766f6669666c786c6168796f64697363676a68 ] + , Constr 1 [] ] + , Map + [ ( B #63732d6e7273786177786376667274616e697369626b786b6978696c + , Map + [ ( B #746e2d6869616d657863766f7877797469616577687a786777637071776c707a + , I 65 ) ] ) + , (B #, Map [(B #, I 1)]) ] + , Constr 0 [] + , Constr 1 [] ] ] ] + , List + [ Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d69647572786b75666675776168616972646b736c61 ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d636e72616477686f7362747661787a6e6176686f66796768 ] + , Constr 1 [] ] + , Map + [ ( B #636572742d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d69647572786b75666675776168616972646b736c61 + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ B #6175746869642d69647572786b75666675776168616972646b736c61 + , Constr 0 + [ Constr 0 [Constr 1 [I 48], Constr 1 []] + , Constr 0 [Constr 1 [I 55], Constr 1 []] ] + , Constr 0 + [ B #63732d727a6d716173666c666367697a69756f616c66676979656c77 + , B #24434552542d52444d5220544e ] ] ] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d69657272666f66707a687075646868656f7371727a ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d636e72616477686f7362747661787a6e6176686f66796768 ] + , Constr 1 [] ] + , Map + [ ( B #636572742d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d69657272666f66707a687075646868656f7371727a + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ B #6175746869642d69657272666f66707a687075646868656f7371727a + , Constr 0 + [ Constr 0 [Constr 1 [I 48], Constr 1 []] + , Constr 0 [Constr 1 [I 55], Constr 1 []] ] + , Constr 0 + [ B #63732d727a6d716173666c666367697a69756f616c66676979656c77 + , B #24434552542d52444d5220544e ] ] ] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d6b6c6f73617a7366706373747374626f6270746c6e ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d636e72616477686f7362747661787a6e6176686f66796768 ] + , Constr 1 [] ] + , Map + [ ( B #636572742d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d6b6c6f73617a7366706373747374626f6270746c6e + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ B #6175746869642d6b6c6f73617a7366706373747374626f6270746c6e + , Constr 0 + [ Constr 0 [Constr 1 [I 48], Constr 1 []] + , Constr 0 [Constr 1 [I 55], Constr 1 []] ] + , Constr 0 + [ B #63732d727a6d716173666c666367697a69756f616c66676979656c77 + , B #24434552542d52444d5220544e ] ] ] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d6d6a617471706f6172777163787069676978706765 ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d636e72616477686f7362747661787a6e6176686f66796768 ] + , Constr 1 [] ] + , Map + [ ( B #636572742d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d6d6a617471706f6172777163787069676978706765 + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ B #6175746869642d6d6a617471706f6172777163787069676978706765 + , Constr 0 + [ Constr 0 [Constr 1 [I 48], Constr 1 []] + , Constr 0 [Constr 1 [I 55], Constr 1 []] ] + , Constr 0 + [ B #63732d727a6d716173666c666367697a69756f616c66676979656c77 + , B #24434552542d52444d5220544e ] ] ] + , Constr 1 [] ] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #6175746869642d7376767a7a6166646a647576766173717261706862 ] + , I 0 ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d636e72616477686f7362747661787a6e6176686f66796768 ] + , Constr 1 [] ] + , Map + [ ( B #636572742d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d7376767a7a6166646a647576766173717261706862 + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ B #6175746869642d7376767a7a6166646a647576766173717261706862 + , Constr 0 + [ Constr 0 [Constr 1 [I 48], Constr 1 []] + , Constr 0 [Constr 1 [I 55], Constr 1 []] ] + , Constr 0 + [ B #63732d727a6d716173666c666367697a69756f616c66676979656c77 + , B #24434552542d52444d5220544e ] ] ] + , Constr 1 [] ] ] ] + , List + [ Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d73646f79666f657879657a636c77776c666978686a696e77 ] + , Constr 1 [] ] + , Map + [ ( B #63732d706c646e7466796f736e74666a73726e69787775717374636e + , Map + [ ( B #746e2d7a7670796272687565616e6f6a746d656d66796470677a6f6474707370 + , I 24 ) ] ) + , (B #, Map [(B #, I 3)]) + , ( B #63732d6b6b666a75636e69646b6c6471626d766f6568706661646c71 + , Map + [ ( B #746e2d6e74717a7663657172637a72676c7966696667666b686b646c62647a62 + , I 39 ) ] ) + , ( B #63732d656679726669636f74696a6179796c666f766f786f6c756a72 + , Map + [ ( B #746e2d676274767179796266776e716261757471736262687361617271767962 + , I 64 ) ] ) + , ( B #63732d737a77766c717477726c776a6575706d62796e676662716163 + , Map + [ ( B #746e2d78746b756f6b65666f7171777076716b6765616f726463636d6f74646a + , I 23 ) ] ) + , ( B #63732d7878786e6466676b76716479647a6b796976787065726f6c71 + , Map + [ ( B #746e2d7a7365736f71636f7a6b77627870616e676a716273797668787a68776c + , I 50 ) ] ) ] + , Constr 0 [] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 + [ Constr 0 + [ B #706b682d76626b6d746b6d746d6478757671727a64677272706e656d ] + , Constr 1 [] ] + , Map [] + , Constr 0 [] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d6272707872686b62757076716c777172717a6f636774757873 ] + , Constr 1 [] ] + , Map + [ ( B #63732d6469666d776477716a74786a79776b796f736571736a767667 + , Map + [ ( B #746e2d727a6a766275677a6a6e7a7975687074726d6e6d786971646c686e7869 + , I 95 ) ] ) + , (B #, Map [(B #, I 2)]) ] + , Constr 0 [] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d74637579646679756363767663736169796f6e687667687172 ] + , Constr 1 [] ] + , Map + [ ( B #63732d7172656a6a68687a7a67696d666574666e62776174746c7873 + , Map + [ ( B #746e2d6f7876726e6a62697a6662687072646472796561656a6f756f72746c6f + , I 54 ) ] ) + , (B #, Map [(B #, I 2)]) + , ( B #63732d65766968697974726477626d6e717a78656f6e736773657661 + , Map + [ ( B #746e2d656f786e626a64797662757971786a656b7876746c696f696672797675 + , I 6 ) ] ) ] + , Constr 0 [] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 + [ Constr 1 + [ B #76682d7570756a6a6b6a716c7065687678776e6b76646e72756c7168 ] + , Constr 1 [] ] + , Map [] + , Constr 0 [] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 [Constr 1 [B #404673562068617368], Constr 1 []] + , Map + [ ( B #66732d706f6c6963792d2068617368 + , Map + [ ( B #eaed91dd96cca80bd5c464872dcebbf266bba3832da75f8e9c3e7552dfc074a9 + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ Constr 1 [] + , B #deadbeef + , Constr 1 [I 100] + , B #706b682d73696c69636f6176696662766168676b7a6c68627a716f66 ] ] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 [Constr 1 [B #404673562068617368], Constr 1 []] + , Map + [ ( B #66732d706f6c6963792d2068617368 + , Map + [ ( B #584a696e09cdf81c476b0da2c386c19b1a8f9a0db8ddab116a4df06402918b69 + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ Constr 1 [] + , B #deadbeef + , Constr 1 [I 100] + , B #706b682d73696c69636f6176696662766168676b7a6c68627a716f66 ] ] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 [Constr 1 [B #404673562068617368], Constr 1 []] + , Map + [ ( B #66732d706f6c6963792d2068617368 + , Map + [ ( B #492bf4b40c78e811904fce90e05d6923ac2cbf857a290cdd78465644e02b5311 + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ Constr 1 [] + , B #deadbeef + , Constr 1 [I 100] + , B #706b682d73696c69636f6176696662766168676b7a6c68627a716f66 ] ] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 [Constr 1 [B #404673562068617368], Constr 1 []] + , Map + [ ( B #66732d706f6c6963792d2068617368 + , Map + [ ( B #8e058dcf1cd49d824ee2cf20b06ffcd26e16478893e9172538e6e0b5960d0b17 + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ Constr 1 [] + , B #deadbeef + , Constr 1 [I 100] + , B #706b682d73696c69636f6176696662766168676b7a6c68627a716f66 ] ] + , Constr 1 [] ] + , Constr 0 + [ Constr 0 [Constr 1 [B #404673562068617368], Constr 1 []] + , Map + [ ( B #66732d706f6c6963792d2068617368 + , Map + [ ( B #3d03e3eb061394bfeaca410fad50b4c9e4696da3415e19e717dcac4c10e050b5 + , I 1 ) ] ) ] + , Constr 2 + [ Constr 0 + [ Constr 1 [] + , B #deadbeef + , Constr 1 [I 100] + , B #706b682d73696c69636f6176696662766168676b7a6c68627a716f66 ] ] + , Constr 1 [] ] ] + , Map [] + , Map + [ ( B #66732d706f6c6963792d2068617368 + , Map + [ ( B #eaed91dd96cca80bd5c464872dcebbf266bba3832da75f8e9c3e7552dfc074a9 + , I 1 ) + , ( B #8e058dcf1cd49d824ee2cf20b06ffcd26e16478893e9172538e6e0b5960d0b17 + , I 1 ) + , ( B #584a696e09cdf81c476b0da2c386c19b1a8f9a0db8ddab116a4df06402918b69 + , I 1 ) + , ( B #492bf4b40c78e811904fce90e05d6923ac2cbf857a290cdd78465644e02b5311 + , I 1 ) + , ( B #3d03e3eb061394bfeaca410fad50b4c9e4696da3415e19e717dcac4c10e050b5 + , I 1 ) ] ) + , ( B #63732d7565676e74716661717477656d616469626d65676269766e6b + , Map + [ ( B #746e2d69706f656d756f6473756c62746e75697a7a70626d74616f6c796c7375 + , I -24 ) ] ) + , ( B #63732d737a77766c717477726c776a6575706d62796e676662716163 + , Map + [ ( B #746e2d78746b756f6b65666f7171777076716b6765616f726463636d6f74646a + , I 23 ) ] ) + , ( B #63732d6e7273786177786376667274616e697369626b786b6978696c + , Map + [ ( B #746e2d6869616d657863766f7877797469616577687a786777637071776c707a + , I -65 ) ] ) + , ( B #63732d6b6b666a75636e69646b6c6471626d766f6568706661646c71 + , Map + [ ( B #746e2d6e74717a7663657172637a72676c7966696667666b686b646c62647a62 + , I 39 ) ] ) + , ( B #63732d65766968697974726477626d6e717a78656f6e736773657661 + , Map + [ ( B #746e2d656f786e626a64797662757971786a656b7876746c696f696672797675 + , I 6 ) ] ) + , ( B #63732d656679726669636f74696a6179796c666f766f786f6c756a72 + , Map + [ ( B #746e2d676274767179796266776e716261757471736262687361617271767962 + , I 64 ) ] ) + , ( B #63732d6469666d776477716a74786a79776b796f736571736a767667 + , Map + [ ( B #746e2d727a6a766275677a6a6e7a7975687074726d6e6d786971646c686e7869 + , I 95 ) ] ) + , ( B #617574682d706f6c6963792d2068617368 + , Map + [ ( B #6175746869642d7376767a7a6166646a647576766173717261706862 + , I -1 ) + , ( B #6175746869642d6d6a617471706f6172777163787069676978706765 + , I -1 ) + , ( B #6175746869642d6b6c6f73617a7366706373747374626f6270746c6e + , I -1 ) + , ( B #6175746869642d69657272666f66707a687075646868656f7371727a + , I -1 ) + , ( B #6175746869642d69647572786b75666675776168616972646b736c61 + , I -1 ) ] ) + , (B #, Map [(B #, I 5)]) ] + , List [] + , Map [] + , Constr 0 + [ Constr 0 [Constr 1 [I 48], Constr 1 []] + , Constr 0 [Constr 1 [I 55], Constr 1 []] ] + , List [] + , Map [] + , Map [] + , Constr 0 [B #] ] + , Constr 0 [B #66732d706f6c6963792d2068617368] ]) \ No newline at end of file diff --git a/plutus-core/changelog.d/20260701_195541_me_pirMutualRecInline.md b/plutus-core/changelog.d/20260701_195541_me_pirMutualRecInline.md new file mode 100644 index 00000000000..6cb82ae10f6 --- /dev/null +++ b/plutus-core/changelog.d/20260701_195541_me_pirMutualRecInline.md @@ -0,0 +1,3 @@ +### Added + +- Add RecInline optimization pass that inlines eligible mutually recursive pir function binds. diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 6e795a8b5d1..8c5a951729f 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -580,6 +580,7 @@ library plutus-ir PlutusIR.Transform.LetFloatOut PlutusIR.Transform.LetMerge PlutusIR.Transform.NonStrict + PlutusIR.Transform.RecInline PlutusIR.Transform.RecSplit PlutusIR.Transform.Rename PlutusIR.Transform.RewriteRules @@ -663,6 +664,7 @@ test-suite plutus-ir-test PlutusIR.Transform.LetFloatIn.Tests PlutusIR.Transform.LetFloatOut.Tests PlutusIR.Transform.NonStrict.Tests + PlutusIR.Transform.RecInline.Tests PlutusIR.Transform.RecSplit.Tests PlutusIR.Transform.Rename.Tests PlutusIR.Transform.RewriteRules.Tests diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs index 1b2123a2103..988d3dc508a 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler.hs @@ -79,6 +79,7 @@ import PlutusIR.Transform.LetFloatIn qualified as LetFloatIn import PlutusIR.Transform.LetFloatOut qualified as LetFloatOut import PlutusIR.Transform.LetMerge qualified as LetMerge import PlutusIR.Transform.NonStrict qualified as NonStrict +import PlutusIR.Transform.RecInline qualified as RecInline import PlutusIR.Transform.RecSplit qualified as RecSplit import PlutusIR.Transform.Rename () import PlutusIR.Transform.RewriteRules qualified as RewriteRules @@ -113,12 +114,13 @@ floatOutPasses = do optimize <- view (ccOpts . coOptimize) tcconfig <- view ccTypeCheckConfig binfo <- view ccBuiltinsInfo + recursiveInlinePasses <- recInlinePasses pure $ mwhen optimize $ P.NamedPass "float-out" $ fold [ LetFloatOut.floatTermPassSC tcconfig binfo - , RecSplit.recSplitPass tcconfig + , recursiveInlinePasses , LetMerge.letMergePass tcconfig ] @@ -174,6 +176,21 @@ simplifier = do passes <- for [1 .. maxIterations] $ \i -> simplifierIteration (" (pass " ++ show i ++ ")") pure $ mwhen optimize $ P.NamedPass "simplifier" (fold passes) +recInlinePasses :: Compiling m uni fun a => m (P.Pass m TyName Name uni fun (Provenance a)) +recInlinePasses = do + optimize <- view (ccOpts . coOptimize) + tcconfig <- view ccTypeCheckConfig + binfo <- view ccBuiltinsInfo + inlineConstants <- view (ccOpts . coInlineConstants) + pure $ + mwhen optimize $ + P.NamedPass "recursive inline" $ + fold + [ RecSplit.recSplitPass tcconfig + , RecInline.recInlinePassSC binfo inlineConstants tcconfig + , RecSplit.recSplitPass tcconfig + ] + -- | Typecheck a PIR Term iff the context demands it. typeCheckTerm :: Compiling m uni fun a => m (P.Pass m TyName Name uni fun (Provenance a)) typeCheckTerm = do diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Utils.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Utils.hs index 7e4e90146a1..7d3641cd027 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Utils.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/Inline/Utils.hs @@ -395,6 +395,33 @@ costIsAcceptable = \case TyInst {} -> False Let {} -> False +-- See Note [Inlining criteria] +{-| Is the size increase (in the AST) of inlining a variable whose RHS is +the given term acceptable? -} +sizeIsAcceptable :: Bool -> Term tyname name uni fun ann -> Bool +sizeIsAcceptable inlineConstants = \case + Builtin {} -> True + Var {} -> True + Error {} -> True + LamAbs {} -> False + TyAbs {} -> False + -- Inlining constructors of size 1 or 0 seems okay + Constr _ _ _ es -> case es of + [] -> True + [e] -> sizeIsAcceptable inlineConstants e + _ -> False + -- Cases are pretty big, due to the case branches + Case {} -> False + -- Arguably we could allow these two, but they're uncommon anyway + IWrap {} -> False + Unwrap {} -> False + -- Inlining constants is deemed acceptable if the 'inlineConstants' + -- flag is turned on, see Note [Inlining constants]. + Constant {} -> inlineConstants + Apply {} -> False + TyInst {} -> False + Let {} -> False + -- | Is this an utterly trivial type which might as well be inlined? trivialType :: Type tyname uni ann -> Bool trivialType = \case diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/RecInline.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/RecInline.hs new file mode 100644 index 00000000000..953364a9db9 --- /dev/null +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/RecInline.hs @@ -0,0 +1,293 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} + +{-| Mutual recursion inlining. + +Given a @let rec@ group, this pass identifies helper bindings — those not +used by the body (non-roots), not self-recursive, and safe to inline according +to the same size/cost heuristics as the main inliner — and inlines them into +their callers. +This works across independent subgroups within the same @let rec@, e.g. +@{even, odd, f, g}@ where @{even, odd}@ and @{f, g}@ are separate cycles. + +No beta reduction is performed here; the resulting applications +are left for downstream passes to clean up. -} +module PlutusIR.Transform.RecInline + ( recInline + , recInlinePass + , recInlinePassSC + ) where + +import Algebra.Graph.AdjacencyMap qualified as Graph +import Control.Lens (transformMOf, (^.)) +import Control.Monad (guard) +import Data.List.NonEmpty qualified as NE +import Data.Map qualified as Map +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Set qualified as Set +import PlutusCore qualified as PLC +import PlutusCore.Analysis.Usages qualified as Usages +import PlutusCore.Builtin qualified as PLC +import PlutusCore.Name.Unique qualified as Unique +import PlutusCore.Quote (MonadQuote) +import PlutusIR +import PlutusIR.Analysis.Builtins (BuiltinsInfo) +import PlutusIR.Analysis.VarInfo (termVarInfo) +import PlutusIR.Pass +import PlutusIR.Purity (isPure) +import PlutusIR.Subst (termUsages) +import PlutusIR.Transform.Inline.Utils (costIsAcceptable, sizeIsAcceptable) +import PlutusIR.Transform.Rename () +import PlutusIR.TypeCheck qualified as TC + +{-| A single term binding within a recursive group, carrying cached usage +information so we don't recompute it on every step. -} +data RecBinding uni fun a = RecBinding + { rbAnn :: a + , rbStrictness :: Strictness + , rbDecl :: VarDecl TyName Name uni a + , rbRhs :: Term TyName Name uni fun a + , rbUsages :: Usages.Usages + } + +rbName :: RecBinding uni fun a -> Name +rbName RecBinding {rbDecl = VarDecl _ n _} = n + +{-| A recursive binding group together with its call graph. +"Roots" are the bindings actually referenced by the @let@ body. -} +data RecGroup uni fun a = RecGroup + { rgBindings :: Map.Map Unique.Unique (RecBinding uni fun a) + , rgOrder :: [Unique.Unique] + , rgRoots :: Set.Set Unique.Unique + , rgGraph :: Graph.AdjacencyMap Unique.Unique + } + +data InlineCandidate = InlineCandidate Unique.Unique Bool + +recInlinePassSC + :: (PLC.Typecheckable uni fun, PLC.GEq uni, MonadQuote m, Ord a) + => BuiltinsInfo uni fun + -> Bool + -> TC.PirTCConfig uni fun + -> Pass m TyName Name uni fun a +recInlinePassSC binfo inlineConstants tcconfig = + renamePass <> recInlinePass binfo inlineConstants tcconfig + +recInlinePass + :: (PLC.Typecheckable uni fun, PLC.GEq uni, MonadQuote m, Ord a) + => BuiltinsInfo uni fun + -> Bool + -> TC.PirTCConfig uni fun + -> Pass m TyName Name uni fun a +recInlinePass binfo inlineConstants tcconfig = + NamedPass "recursive inlining" $ + Pass + (recInline binfo inlineConstants) + [Typechecks tcconfig, GloballyUniqueNames] + [ConstCondition (Typechecks tcconfig), ConstCondition GloballyUniqueNames] + +-- | Walk the term bottom-up, attempting to collapse each @let rec@ group. +recInline + :: (PLC.ToBuiltinMeaning uni fun, MonadQuote m) + => BuiltinsInfo uni fun + -> Bool + -> Term TyName Name uni fun a + -> m (Term TyName Name uni fun a) +recInline binfo inlineConstants = + transformMOf termSubterms $ \case + Let ann Rec bs body -> rewriteRecGroup binfo inlineConstants ann bs body + term -> pure term + +{-| Try to collapse a recursive group by inlining helpers. If we manage to +eliminate at least one binding, emit the smaller group; otherwise return the +original term unchanged. -} +rewriteRecGroup + :: (PLC.ToBuiltinMeaning uni fun, MonadQuote m) + => BuiltinsInfo uni fun + -> Bool + -> a + -> NE.NonEmpty (Binding TyName Name uni fun a) + -> Term TyName Name uni fun a + -> m (Term TyName Name uni fun a) +rewriteRecGroup binfo inlineConstants ann bs body = + case mkRecGroup binfo ann bs body of + Nothing -> pure original + Just (group, passthrough) -> do + collapsed <- collapseRecGroup inlineConstants group + pure $ fromMaybe original (extractResult group collapsed passthrough) + where + original = Let ann Rec bs body + extractResult orig col passthrough = do + -- At least one helper was inlined away. + guard (length (rgOrder col) < length (rgOrder orig)) + let collapsed = + [ TermBind (rbAnn b) (rbStrictness b) (rbDecl b) (rbRhs b) + | key <- rgOrder col + , Just b <- [Map.lookup key (rgBindings col)] + ] + bs' <- NE.nonEmpty (collapsed ++ passthrough) + pure $ Let ann Rec bs' body + +{-| Extract eligible function bindings from a @let rec@ group. Returns +the 'RecGroup' and any passthrough bindings (type bindings, datatype bindings, +effectful strict value bindings) that are left untouched. Returns 'Nothing' if +fewer than 2 safe term bindings are found. -} +mkRecGroup + :: PLC.ToBuiltinMeaning uni fun + => BuiltinsInfo uni fun + -> a + -> NE.NonEmpty (Binding TyName Name uni fun a) + -> Term TyName Name uni fun a + -> Maybe (RecGroup uni fun a, [Binding TyName Name uni fun a]) +mkRecGroup binfo ann bs body = do + let paired = [(b, asRecBinding b) | b <- NE.toList bs] + -- Safe term bindings that we can try to collapse. + eligible = [rb | (_, Just rb) <- paired] + -- Everything else: type bindings, datatype bindings, and effectful + -- strict value bindings. + passthrough = [b | (b, Nothing) <- paired] + -- Need at least 2 bindings to have anything to collapse. + guard (length eligible > 1) + let key b = rbName b ^. Unique.theUnique + bindingMap = Map.fromList [(key b, b) | b <- eligible] + -- Bindings used by the let body or by passthrough bindings are roots — + -- inlining them away would break references from outside the group. + bodyUsed = Usages.allUsed (termUsages body) + passthroughUsed = + Set.unions + [ Usages.allUsed (termUsages rhs) + | TermBind _ _ _ rhs <- passthrough + ] + roots = + Map.keysSet bindingMap + `Set.intersection` (bodyUsed `Set.union` passthroughUsed) + pure (buildGraph (fmap key eligible) bindingMap roots, passthrough) + where + vinfo = termVarInfo (Let ann Rec bs body) + + asRecBinding = \case + TermBind bindAnn strictness decl rhs + | let rhsPure = isPure binfo vinfo rhs + , strictness == NonStrict || rhsPure -> + Just + RecBinding + { rbAnn = bindAnn + , rbStrictness = strictness + , rbDecl = decl + , rbRhs = rhs + , rbUsages = termUsages rhs + } + _ -> Nothing + +{-| Construct a 'RecGroup' by computing the intra-group call graph from the +cached usage information on each binding. -} +buildGraph + :: [Unique.Unique] + -> Map.Map Unique.Unique (RecBinding uni fun a) + -> Set.Set Unique.Unique + -> RecGroup uni fun a +buildGraph order bindings roots = + RecGroup {rgBindings = bindings, rgOrder = order, rgRoots = roots, rgGraph = graph} + where + graph = + Graph.fromAdjacencySets + [ (key, keys `Set.intersection` Usages.allUsed (rbUsages b)) + | (key, b) <- Map.toList bindings + ] + keys = Map.keysSet bindings + +{-| Iteratively inline helpers into their callers until no more candidates +remain. -} +collapseRecGroup + :: MonadQuote m + => Bool + -> RecGroup uni fun a + -> m (RecGroup uni fun a) +collapseRecGroup inlineConstants group = tryCandidates (findCandidates inlineConstants group) + where + tryCandidates [] = pure group + tryCandidates (candidate : rest) = + tryInline group candidate >>= \case + Just group' -> collapseRecGroup inlineConstants group' + Nothing -> tryCandidates rest + +{-| Find helpers eligible for inlining: not roots, not self-recursive, and +acceptable according to the main inliner's single-use/size/cost criteria. -} +findCandidates :: Bool -> RecGroup uni fun a -> [InlineCandidate] +findCandidates inlineConstants group = mapMaybe check (rgOrder group) + where + check helper = do + -- Roots are used by the let body — removing them would change semantics. + guard (helper `Set.notMember` rgRoots group) + -- Self-recursive helpers can't be fully eliminated by inlining. + guard (helper `Set.notMember` Graph.postSet helper (rgGraph group)) + helperBinding <- Map.lookup helper (rgBindings group) + let totalUses = + sum + [ Usages.getUsageCount (rbName helperBinding) (rbUsages binding) + | (key, binding) <- Map.toList (rgBindings group) + , key /= helper + ] + guard (totalUses > 0) + guard $ + totalUses == 1 + || ( costIsAcceptable (rbRhs helperBinding) + && sizeIsAcceptable inlineConstants (rbRhs helperBinding) + ) + pure $ InlineCandidate helper (totalUses > 1) + +{-| Inline all references to the helper within the rest of the recursive group. +If successful, remove the helper from the group. -} +tryInline + :: MonadQuote m + => RecGroup uni fun a + -> InlineCandidate + -> m (Maybe (RecGroup uni fun a)) +tryInline group (InlineCandidate helperKey needsRename) = + case Map.lookup helperKey (rgBindings group) of + Just helper -> do + let helperName = rbName helper + updatedBindings <- + traverse + (updateBinding helperName (rbRhs helper)) + (Map.toList $ Map.delete helperKey (rgBindings group)) + let bindings = Map.fromList updatedBindings + pure $ do + -- Verify all references were eliminated before removing the binding. + guard $ + all + ( \binding -> + Usages.getUsageCount helperName (rbUsages binding) == 0 + ) + (Map.elems bindings) + let order = filter (/= helperKey) (rgOrder group) + pure $ buildGraph order bindings (rgRoots group) + _ -> pure Nothing + where + updateBinding helperName helperRhs (key, binding) = do + rhs' <- inlineCallsOf needsRename helperName helperRhs (rbRhs binding) + let updated = + binding + { rbRhs = rhs' + , rbUsages = termUsages rhs' + } + pure (key, updated) + +{-| Replace helper variables with the helper's RHS. Multi-use substitutions use +a fresh rename for each occurrence; single-use substitutions move the original +RHS so they do not perturb fresh-name allocation unnecessarily. -} +inlineCallsOf + :: MonadQuote m + => Bool + -> Name + -> Term TyName Name uni fun a + -> Term TyName Name uni fun a + -> m (Term TyName Name uni fun a) +inlineCallsOf needsRename helperName helperRhs = + transformMOf termSubterms $ \case + Var _ name + | name == helperName -> + if needsRename + then PLC.rename helperRhs + else pure helperRhs + term -> pure term diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/recursiveTypeBind.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/recursiveTypeBind.golden index dbaf1b2c422..0edf43600b6 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/recursiveTypeBind.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/recursiveTypeBind.golden @@ -1,4 +1,4 @@ Error during compilation: Type bindings cannot appear in recursive let, use datatypebind insteadThe type binding is (typebind - (tyvardecl unit-209 (type)) (all a-210 (type) (fun unit-209 unit-209)) + (tyvardecl unit-212 (type)) (all a-213 (type) (fun unit-212 unit-212)) )((recursive) let binding; from recursiveTypeBind:1:1-11:1) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/Tests.hs index 2e5ac7faa54..4497b9522f2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/Tests.hs @@ -1,7 +1,21 @@ module PlutusIR.Compiler.Recursion.Tests where +import Control.Monad.Except (runExceptT) +import Control.Monad.Reader (ask) +import Data.Text.IO qualified as T +import PlutusCore qualified as PLC +import PlutusCore.Default (someValue) +import PlutusCore.MkPlc (constant) +import PlutusCore.Pretty (pretty) +import PlutusCore.Pretty qualified as PrettyPLC +import PlutusCore.Quote (runQuoteT) +import PlutusCore.Test (runUPlc, runUPlcFull) +import PlutusCore.Version (latestVersion) +import PlutusIR qualified as PIR +import PlutusIR.Parser (parse) import PlutusIR.Test +import System.FilePath (joinPath, ()) import Test.Tasty import Test.Tasty.Extras @@ -15,4 +29,63 @@ test_recursion = , goldenPlcFromPir pTermAsProg "stupidZero" , goldenPlcFromPir pTermAsProg "mutuallyRecursiveValues" , goldenEvalPir pTermAsProg "errorBinding" + , goldenNamedUPlcFromPir pTermAsProg "evenOddIntegerMutual" + , goldenEvalPirAppliedInteger "evenOddIntegerMutual" "evenOddIntegerMutual-10" 10 + , goldenEvalPirAppliedInteger "evenOddIntegerMutual" "evenOddIntegerMutual-11" 11 + , goldenBudgetPirAppliedInteger "evenOddIntegerMutual" "evenOddIntegerMutual-200" 200 + , goldenNamedUPlcFromPir pTermAsProg "evenIntegerSelf" + , goldenEvalPirAppliedInteger "evenIntegerSelf" "evenIntegerSelf-10" 10 + , goldenEvalPirAppliedInteger "evenIntegerSelf" "evenIntegerSelf-11" 11 + , goldenBudgetPirAppliedInteger "evenIntegerSelf" "evenIntegerSelf-200" 200 + , goldenNamedUPlcFromPir pTermAsProg "divisibleByThreeIntegerMutual" + , goldenEvalPirAppliedInteger "divisibleByThreeIntegerMutual" "divisibleByThreeIntegerMutual-9" 9 + , goldenEvalPirAppliedInteger "divisibleByThreeIntegerMutual" "divisibleByThreeIntegerMutual-10" 10 + , goldenBudgetPirAppliedInteger + "divisibleByThreeIntegerMutual" + "divisibleByThreeIntegerMutual-300" + 300 + , goldenNamedUPlcFromPir pTermAsProg "divisibleByThreeIntegerSelf" + , goldenEvalPirAppliedInteger "divisibleByThreeIntegerSelf" "divisibleByThreeIntegerSelf-9" 9 + , goldenEvalPirAppliedInteger "divisibleByThreeIntegerSelf" "divisibleByThreeIntegerSelf-10" 10 + , goldenBudgetPirAppliedInteger "divisibleByThreeIntegerSelf" "divisibleByThreeIntegerSelf-300" 300 ] + +goldenEvalPirAppliedInteger :: String -> TestName -> Integer -> TestNested +goldenEvalPirAppliedInteger sourceName goldenName n = do + sourceDir <- joinPath <$> ask + nestedGoldenVsDocM goldenName ".eval" $ do + program <- loadPirProgram (sourceDir sourceName) + result <- runExceptT $ runUPlc [program, integerProgram n] + pure $ either (pretty . show) PrettyPLC.prettyPlcReadableSimple result + +goldenBudgetPirAppliedInteger :: String -> TestName -> Integer -> TestNested +goldenBudgetPirAppliedInteger sourceName goldenName n = do + sourceDir <- joinPath <$> ask + nestedGoldenVsDocM goldenName ".budget" $ do + program <- loadPirProgram (sourceDir sourceName) + result <- runExceptT $ runUPlcFull [program, integerProgram n] + pure $ + either + (pretty . show) + ( \(termRes, budget, _) -> + pretty $ + "Final budget: " + <> show budget + <> "\nResult: " + <> PrettyPLC.render (PrettyPLC.prettyPlcReadableSimple termRes) + ) + result + +loadPirProgram + :: FilePath + -> IO (PIR.Program PIR.TyName PIR.Name PLC.DefaultUni PLC.DefaultFun PLC.SrcSpan) +loadPirProgram filePath = do + contents <- T.readFile filePath + case runQuoteT $ parse pTermAsProg filePath contents of + Left err -> fail $ show err + Right program -> pure program + +integerProgram + :: Integer + -> PIR.Program PIR.TyName PIR.Name PLC.DefaultUni PLC.DefaultFun PLC.SrcSpan +integerProgram n = PIR.Program topSrcSpan latestVersion $ constant topSrcSpan $ someValue n diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual new file mode 100644 index 00000000000..cd07d7c5d2b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual @@ -0,0 +1,29 @@ +(let (rec) + (termbind (strict) (vardecl div3 (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [step1 [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl step1 (fun (con integer) (con bool))) + (lam n1 (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n1 (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [step2 [(builtin subtractInteger) n1 (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl step2 (fun (con integer) (con bool))) + (lam n2 (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n2 (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [div3 [(builtin subtractInteger) n2 (con integer 1)]]) + (con unit ()) + ])) + div3) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-10.golden.eval b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-10.golden.eval new file mode 100644 index 00000000000..c1f22fbc23b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-10.golden.eval @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-300.golden.budget b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-300.golden.budget new file mode 100644 index 00000000000..b728f7350dc --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-300.golden.budget @@ -0,0 +1,2 @@ +Final budget: ExBudget {exBudgetCPU = ExCPU 165405482, exBudgetMemory = ExMemory 603802} +Result: True \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-9.golden.eval b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-9.golden.eval new file mode 100644 index 00000000000..4791ed5559b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual-9.golden.eval @@ -0,0 +1 @@ +True \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual.golden new file mode 100644 index 00000000000..31163883d8c --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerMutual.golden @@ -0,0 +1,33 @@ +program + 1.1.0 + ((\forced -> + (\s -> s s) + (\s n -> + case + (constr 0 + [ (equalsInteger 0 n) + , (\u -> True) + , (\u -> + (\n1 -> + case + (constr 0 + [ (equalsInteger 0 n1) + , (\u -> False) + , (\u -> + (\n2 -> + case + (constr 0 + [ (equalsInteger 0 n2) + , (\u -> False) + , (\u -> + (\x -> s s x) + (subtractInteger n2 1)) + , () ]) + [forced]) + (subtractInteger n1 1)) + , () ]) + [forced]) + (subtractInteger n 1)) + , () ]) + [forced])) + (force ifThenElse)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf new file mode 100644 index 00000000000..941ef7a25e6 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf @@ -0,0 +1,29 @@ +(let (rec) + (termbind (strict) (vardecl div3 (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + (let (nonrec) + (termbind (strict) (vardecl n1 (con integer)) + [(builtin subtractInteger) n (con integer 1)]) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n1 (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + (let (nonrec) + (termbind (strict) (vardecl n2 (con integer)) + [(builtin subtractInteger) n1 (con integer 1)]) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n2 (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [div3 [(builtin subtractInteger) n2 (con integer 1)]]) + (con unit ()) + ])) + (con unit ()) + ])) + (con unit ()) + ])) + div3) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-10.golden.eval b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-10.golden.eval new file mode 100644 index 00000000000..c1f22fbc23b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-10.golden.eval @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-300.golden.budget b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-300.golden.budget new file mode 100644 index 00000000000..b728f7350dc --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-300.golden.budget @@ -0,0 +1,2 @@ +Final budget: ExBudget {exBudgetCPU = ExCPU 165405482, exBudgetMemory = ExMemory 603802} +Result: True \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-9.golden.eval b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-9.golden.eval new file mode 100644 index 00000000000..4791ed5559b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf-9.golden.eval @@ -0,0 +1 @@ +True \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf.golden new file mode 100644 index 00000000000..31163883d8c --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/divisibleByThreeIntegerSelf.golden @@ -0,0 +1,33 @@ +program + 1.1.0 + ((\forced -> + (\s -> s s) + (\s n -> + case + (constr 0 + [ (equalsInteger 0 n) + , (\u -> True) + , (\u -> + (\n1 -> + case + (constr 0 + [ (equalsInteger 0 n1) + , (\u -> False) + , (\u -> + (\n2 -> + case + (constr 0 + [ (equalsInteger 0 n2) + , (\u -> False) + , (\u -> + (\x -> s s x) + (subtractInteger n2 1)) + , () ]) + [forced]) + (subtractInteger n1 1)) + , () ]) + [forced]) + (subtractInteger n 1)) + , () ]) + [forced])) + (force ifThenElse)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3.golden index 1d6982b4a9f..82d36617a45 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3.golden @@ -10,69 +10,28 @@ program (Suc : Nat -> Nat) (match_Nat : Nat -> (all out_Nat. out_Nat -> (Nat -> out_Nat) -> out_Nat)) -> - (\(tup : all r. ((Nat -> Bool) -> (Nat -> Bool) -> r) -> r) -> - (\(even : Nat -> Bool) -> - (\(odd : Nat -> Bool) -> even (Suc (Suc (Suc Zero)))) - (tup - {Nat -> Bool} - (\(arg_0 : Nat -> Bool) (arg_1 : Nat -> Bool) -> - arg_1))) - (tup - {Nat -> Bool} - (\(arg_0 : Nat -> Bool) (arg_1 : Nat -> Bool) -> arg_0))) - ((/\(F :: * -> *) -> - \(by : (all Q. F Q -> Q) -> (all Q. F Q -> Q)) -> - (/\a b -> - \(f : (a -> b) -> a -> b) -> - (\(s : - (\a -> - ifix (\(self :: * -> *) a -> self a -> a) a) - (a -> b)) -> - unwrap s s) - (iwrap - (\(self :: * -> *) a -> self a -> a) - (a -> b) - (\(s : - (\a -> - ifix - (\(self :: * -> *) a -> self a -> a) - a) - (a -> b)) -> - f (\(x : a) -> unwrap s s x)))) - {all Q. F Q -> F Q} - {all Q. F Q -> Q} - (\(rec : (all Q. F Q -> F Q) -> (all Q. F Q -> Q)) - (h : all Q. F Q -> F Q) -> - /\R -> - \(fr : F R) -> - by - (/\Q -> \(fq : F Q) -> rec h {Q} (h {Q} fq)) - {R} - fr)) - {\X -> (Nat -> Bool) -> (Nat -> Bool) -> X} - (\(k : all Q. ((Nat -> Bool) -> (Nat -> Bool) -> Q) -> Q) -> - /\S -> - \(h : (Nat -> Bool) -> (Nat -> Bool) -> S) -> - h - (\(x : Nat) -> - k - {Bool} - (\(f_0 : Nat -> Bool) (f_1 : Nat -> Bool) -> - f_0 x)) - (\(x : Nat) -> - k - {Bool} - (\(f_0 : Nat -> Bool) (f_1 : Nat -> Bool) -> - f_1 x))) - (/\Q -> - \(choose : (Nat -> Bool) -> (Nat -> Bool) -> Q) - (even : Nat -> Bool) - (odd : Nat -> Bool) -> - choose - (\(n : Nat) -> - match_Nat n {Bool} True (\(p : Nat) -> odd p)) - (\(n : Nat) -> - match_Nat n {Bool} False (\(p : Nat) -> even p))))) + (\(s : + (\a -> ifix (\(self :: * -> *) a -> self a -> a) a) + (Nat -> Bool)) -> + unwrap s s) + (iwrap + (\(self :: * -> *) a -> self a -> a) + (Nat -> Bool) + (\(s : + (\a -> ifix (\(self :: * -> *) a -> self a -> a) a) + (Nat -> Bool)) + (n : Nat) -> + match_Nat + n + {Bool} + True + (\(p : Nat) -> + match_Nat + p + {Bool} + False + (\(p : Nat) -> unwrap s s p)))) + (Suc (Suc (Suc Zero)))) {ifix (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) (\Nat -> sop [] [Nat])} diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf new file mode 100644 index 00000000000..0d35ec622e9 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf @@ -0,0 +1,20 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + (let (nonrec) + (termbind (strict) (vardecl n1 (con integer)) + [(builtin subtractInteger) n (con integer 1)]) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n1 (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) n1 (con integer 1)]]) + (con unit ()) + ])) + (con unit ()) + ])) + even) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-10.golden.eval b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-10.golden.eval new file mode 100644 index 00000000000..4791ed5559b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-10.golden.eval @@ -0,0 +1 @@ +True \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-11.golden.eval b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-11.golden.eval new file mode 100644 index 00000000000..c1f22fbc23b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-11.golden.eval @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-200.golden.budget b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-200.golden.budget new file mode 100644 index 00000000000..f9e25858b6e --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf-200.golden.budget @@ -0,0 +1,2 @@ +Final budget: ExBudget {exBudgetCPU = ExCPU 113646482, exBudgetMemory = ExMemory 423402} +Result: True \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf.golden new file mode 100644 index 00000000000..c27691637dd --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenIntegerSelf.golden @@ -0,0 +1,22 @@ +program + 1.1.0 + ((\forced -> + (\s -> s s) + (\s n -> + case + (constr 0 + [ (equalsInteger 0 n) + , (\u -> True) + , (\u -> + (\n1 -> + case + (constr 0 + [ (equalsInteger 0 n1) + , (\u -> False) + , (\u -> (\x -> s s x) (subtractInteger n1 1)) + , () ]) + [forced]) + (subtractInteger n 1)) + , () ]) + [forced])) + (force ifThenElse)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual new file mode 100644 index 00000000000..77f223d2bb7 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual @@ -0,0 +1,20 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl odd (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + even) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-10.golden.eval b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-10.golden.eval new file mode 100644 index 00000000000..4791ed5559b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-10.golden.eval @@ -0,0 +1 @@ +True \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-11.golden.eval b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-11.golden.eval new file mode 100644 index 00000000000..c1f22fbc23b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-11.golden.eval @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-200.golden.budget b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-200.golden.budget new file mode 100644 index 00000000000..f9e25858b6e --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual-200.golden.budget @@ -0,0 +1,2 @@ +Final budget: ExBudget {exBudgetCPU = ExCPU 113646482, exBudgetMemory = ExMemory 423402} +Result: True \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual.golden new file mode 100644 index 00000000000..b3160ea1377 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/evenOddIntegerMutual.golden @@ -0,0 +1,22 @@ +program + 1.1.0 + ((\forced -> + (\s -> s s) + (\s n -> + case + (constr 0 + [ (equalsInteger 0 n) + , (\u -> True) + , (\u -> + (\n -> + case + (constr 0 + [ (equalsInteger 0 n) + , (\u -> False) + , (\u -> (\x -> s s x) (subtractInteger n 1)) + , () ]) + [forced]) + (subtractInteger n 1)) + , () ]) + [forced])) + (force ifThenElse)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/mutuallyRecursiveValues.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/mutuallyRecursiveValues.golden index bb0ec557725..e844a8c7309 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/mutuallyRecursiveValues.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/mutuallyRecursiveValues.golden @@ -1,77 +1,18 @@ program 1.1.0 - ((\(tup : - all r. - (((all a. a -> a) -> (all a. a -> a)) -> - ((all a. a -> a) -> (all a. a -> a)) -> - r) -> - r) -> - (\(x : (all a. a -> a) -> (all a. a -> a)) -> - (\(y : (all a. a -> a) -> (all a. a -> a)) -> - (\(x : all a. a -> a) -> - (\(y : all a. a -> a) -> x) (y (/\a -> \(x : a) -> x))) - (x (/\a -> \(x : a) -> x))) - (tup - {(all a. a -> a) -> (all a. a -> a)} - (\(arg_0 : (all a. a -> a) -> (all a. a -> a)) - (arg_1 : (all a. a -> a) -> (all a. a -> a)) -> - arg_1))) - (tup - {(all a. a -> a) -> (all a. a -> a)} - (\(arg_0 : (all a. a -> a) -> (all a. a -> a)) - (arg_1 : (all a. a -> a) -> (all a. a -> a)) -> - arg_0))) - ((/\a b a b -> - \(f : - all Q. ((a -> b) -> (a -> b) -> Q) -> (a -> b) -> (a -> b) -> Q) -> - (/\(F :: * -> *) -> - \(by : (all Q. F Q -> Q) -> (all Q. F Q -> Q)) -> - (/\a b -> - \(f : (a -> b) -> a -> b) -> - (\(s : - (\a -> ifix (\(self :: * -> *) a -> self a -> a) a) - (a -> b)) -> - unwrap s s) - (iwrap - (\(self :: * -> *) a -> self a -> a) - (a -> b) - (\(s : - (\a -> - ifix (\(self :: * -> *) a -> self a -> a) a) - (a -> b)) -> - f (\(x : a) -> unwrap s s x)))) - {all Q. F Q -> F Q} - {all Q. F Q -> Q} - (\(rec : (all Q. F Q -> F Q) -> (all Q. F Q -> Q)) - (h : all Q. F Q -> F Q) -> - /\R -> - \(fr : F R) -> - by - (/\Q -> \(fq : F Q) -> rec h {Q} (h {Q} fq)) - {R} - fr)) - {\X -> (a -> b) -> (a -> b) -> X} - (\(k : all Q. ((a -> b) -> (a -> b) -> Q) -> Q) -> - /\S -> - \(h : (a -> b) -> (a -> b) -> S) -> - h - (\(x : a) -> - k {b} (\(f_0 : a -> b) (f_1 : a -> b) -> f_0 x)) - (\(x : a) -> - k {b} (\(f_0 : a -> b) (f_1 : a -> b) -> f_1 x))) - f) - {all a. a -> a} - {all a. a -> a} - {all a. a -> a} - {all a. a -> a} - (/\Q -> - \(choose : - ((all a. a -> a) -> (all a. a -> a)) -> - ((all a. a -> a) -> (all a. a -> a)) -> - Q) - (x : (all a. a -> a) -> (all a. a -> a)) - (y : (all a. a -> a) -> (all a. a -> a)) -> - choose - (\(arg : all a. a -> a) -> y (/\a -> \(x : a) -> x)) - (\(arg : all a. a -> a) -> - /\a -> \(z : a) -> x (/\a -> \(x : a) -> x) {a} z)))) \ No newline at end of file + ((/\a b -> + \(f : (a -> b) -> a -> b) -> + (\(s : (\a -> ifix (\(self :: * -> *) a -> self a -> a) a) (a -> b)) -> + unwrap s s) + (iwrap + (\(self :: * -> *) a -> self a -> a) + (a -> b) + (\(s : + (\a -> ifix (\(self :: * -> *) a -> self a -> a) a) + (a -> b)) -> + f (\(x : a) -> unwrap s s x)))) + {all a. a -> a} + {all a. a -> a} + (\(x : (all a. a -> a) -> (all a. a -> a)) (arg : all a. a -> a) -> + /\a -> \(z : a) -> x (/\a -> \(x : a) -> x) {a} z) + (/\a -> \(x : a) -> x)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/Tests.hs new file mode 100644 index 00000000000..52f2c8db746 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/Tests.hs @@ -0,0 +1,41 @@ +module PlutusIR.Transform.RecInline.Tests where + +import Test.Tasty +import Test.Tasty.Extras + +import PlutusCore.Default.Builtins () +import PlutusCore.Quote +import PlutusIR.Analysis.Builtins () +import PlutusIR.Parser +import PlutusIR.Pass.Test +import PlutusIR.Test +import PlutusIR.Transform.RecInline +import PlutusPrelude +import Test.Tasty.QuickCheck + +test_recInline :: TestTree +test_recInline = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "RecInline"] $ + map + (goldenPir (runQuote . runTestPass (\tc -> recInlinePassSC def True tc)) pTerm) + [ "evenOddCollapse" + , "threeCycleCollapse" + , "helperStrictAlias" + , "helperAliasOverApplied" + , "helperUnderApplied" + , "bodyUsesBoth" + , "helperUsedTwice" + , "pureHelperUsedTwice" + , "helperSelfRecursive" + , "sharedHelper" + , "twoIndependentCycles" + , "twoIndependentCyclesPartial" + , "mixedValueBinding" + , "valueBindingPreventsInlining" + ] + +prop_recInline :: Property +prop_recInline = + withNumTests numTestsForPassProp $ + testPassProp runQuote $ + \tc -> recInlinePassSC def True tc diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/bodyUsesBoth b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/bodyUsesBoth new file mode 100644 index 00000000000..3f7712e34c0 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/bodyUsesBoth @@ -0,0 +1,23 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl odd (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + (let (nonrec) + (termbind (strict) (vardecl x (fun (con integer) (con bool))) + even) + odd)) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/bodyUsesBoth.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/bodyUsesBoth.golden new file mode 100644 index 00000000000..42952c4986f --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/bodyUsesBoth.golden @@ -0,0 +1,22 @@ +letrec + !even : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> odd (subtractInteger n 1)) + () + !odd : integer -> bool + = \(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> even (subtractInteger m 1)) + () +in +let + !x : integer -> bool = even +in +odd \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/evenOddCollapse b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/evenOddCollapse new file mode 100644 index 00000000000..4f93424333c --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/evenOddCollapse @@ -0,0 +1,20 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl odd (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + even) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/evenOddCollapse.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/evenOddCollapse.golden new file mode 100644 index 00000000000..ee6966056a4 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/evenOddCollapse.golden @@ -0,0 +1,19 @@ +letrec + !even : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> + (\(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> even (subtractInteger m 1)) + ()) + (subtractInteger n 1)) + () +in +even \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperAliasOverApplied b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperAliasOverApplied new file mode 100644 index 00000000000..492f41ecd87 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperAliasOverApplied @@ -0,0 +1,12 @@ +(let (rec) + (termbind (strict) (vardecl f (fun (con integer) (fun (con integer) (con integer)))) + (lam x (con integer) + (lam y (con integer) + [g x y]))) + (termbind (strict) (vardecl g (fun (con integer) (fun (con integer) (con integer)))) + h) + (termbind (strict) (vardecl h (fun (con integer) (fun (con integer) (con integer)))) + (lam x (con integer) + (lam y (con integer) + [f x y]))) + f) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperAliasOverApplied.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperAliasOverApplied.golden new file mode 100644 index 00000000000..3a22e483935 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperAliasOverApplied.golden @@ -0,0 +1,6 @@ +letrec + !f : integer -> integer -> integer + = \(x : integer) (y : integer) -> + (\(x : integer) (y : integer) -> f x y) x y +in +f \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperSelfRecursive b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperSelfRecursive new file mode 100644 index 00000000000..283a7cb2d56 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperSelfRecursive @@ -0,0 +1,20 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl odd (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [odd [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + even) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperSelfRecursive.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperSelfRecursive.golden new file mode 100644 index 00000000000..f64433d67f5 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperSelfRecursive.golden @@ -0,0 +1,19 @@ +letrec + !even : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> odd (subtractInteger n 1)) + () + !odd : integer -> bool + = \(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> odd (subtractInteger m 1)) + () +in +even \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperStrictAlias b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperStrictAlias new file mode 100644 index 00000000000..6f203719ea2 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperStrictAlias @@ -0,0 +1,24 @@ +(let (rec) + (termbind (nonstrict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + (let (nonrec) + (termbind (strict) (vardecl n' (con integer)) n) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n' (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [odd [(builtin subtractInteger) n' (con integer 1)]]) + (con unit ()) + ]))) + (termbind (nonstrict) (vardecl odd (fun (con integer) (con bool))) + (lam m (con integer) + (let (nonrec) + (termbind (strict) (vardecl m' (con integer)) m) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m' (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) m' (con integer 1)]]) + (con unit ()) + ]))) + even) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperStrictAlias.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperStrictAlias.golden new file mode 100644 index 00000000000..b3958c87406 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperStrictAlias.golden @@ -0,0 +1,25 @@ +letrec + ~even : integer -> bool + = \(n : integer) -> + let + !n' : integer = n + in + ifThenElse + {unit -> bool} + (equalsInteger n' 0) + (\(u : unit) -> True) + (\(u : unit) -> + (\(m : integer) -> + let + !m' : integer = m + in + ifThenElse + {unit -> bool} + (equalsInteger m' 0) + (\(u : unit) -> False) + (\(u : unit) -> even (subtractInteger m' 1)) + ()) + (subtractInteger n' 1)) + () +in +even \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUnderApplied b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUnderApplied new file mode 100644 index 00000000000..4153cb2b783 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUnderApplied @@ -0,0 +1,9 @@ +(let (rec) + (termbind (strict) (vardecl f (fun (con integer) (fun (con integer) (con integer)))) + (lam x (con integer) + [g x])) + (termbind (strict) (vardecl g (fun (con integer) (fun (con integer) (con integer)))) + (lam y (con integer) + (lam z (con integer) + [f y z]))) + f) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUnderApplied.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUnderApplied.golden new file mode 100644 index 00000000000..1aea37fa573 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUnderApplied.golden @@ -0,0 +1,5 @@ +letrec + !f : integer -> integer -> integer + = \(x : integer) -> (\(y : integer) (z : integer) -> f y z) x +in +f \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUsedTwice b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUsedTwice new file mode 100644 index 00000000000..a73e31bba18 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUsedTwice @@ -0,0 +1,21 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 1)]]) + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 2)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl odd (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + even) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUsedTwice.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUsedTwice.golden new file mode 100644 index 00000000000..479d3d9ca3a --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/helperUsedTwice.golden @@ -0,0 +1,19 @@ +letrec + !even : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> odd (subtractInteger n 1)) + (\(u : unit) -> odd (subtractInteger n 2)) + () + !odd : integer -> bool + = \(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> even (subtractInteger m 1)) + () +in +even \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/mixedValueBinding b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/mixedValueBinding new file mode 100644 index 00000000000..7c6551955f6 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/mixedValueBinding @@ -0,0 +1,22 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl odd (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl val (con bool)) + [even (con integer 42)]) + val) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/mixedValueBinding.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/mixedValueBinding.golden new file mode 100644 index 00000000000..5eaccfc58a5 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/mixedValueBinding.golden @@ -0,0 +1,20 @@ +letrec + !even : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> + (\(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> even (subtractInteger m 1)) + ()) + (subtractInteger n 1)) + () + !val : bool = even 42 +in +val \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/pureHelperUsedTwice b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/pureHelperUsedTwice new file mode 100644 index 00000000000..4308374a3e0 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/pureHelperUsedTwice @@ -0,0 +1,7 @@ +(let (rec) + (termbind (strict) (vardecl f (fun (con integer) (con integer))) + (lam n (con integer) + [(builtin addInteger) g g])) + (termbind (strict) (vardecl g (con integer)) + (con integer 1)) + f) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/pureHelperUsedTwice.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/pureHelperUsedTwice.golden new file mode 100644 index 00000000000..177341e4b8b --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/pureHelperUsedTwice.golden @@ -0,0 +1,4 @@ +letrec + !f : integer -> integer = \(n : integer) -> addInteger 1 1 +in +f \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/sharedHelper b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/sharedHelper new file mode 100644 index 00000000000..54cb1135a4a --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/sharedHelper @@ -0,0 +1,43 @@ +(let (rec) + (termbind (strict) (vardecl f (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 1)] + (lam u (con unit) + [g [(builtin subtractInteger) n (con integer 1)]]) + (lam u (con unit) + [h [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ]) + (con unit ()) + ])) + (termbind (strict) (vardecl g (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [h [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl h (fun (con integer) (con bool))) + (lam k (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) k (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) k (con integer 1)] + (lam u (con unit) + [f [(builtin subtractInteger) k (con integer 1)]]) + (lam u (con unit) + [g [(builtin subtractInteger) k (con integer 1)]]) + (con unit ()) + ]) + (con unit ()) + ])) + f) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/sharedHelper.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/sharedHelper.golden new file mode 100644 index 00000000000..ab904bc82e0 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/sharedHelper.golden @@ -0,0 +1,39 @@ +letrec + !f : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> + ifThenElse + {unit -> bool} + (equalsInteger n 1) + (\(u : unit) -> g (subtractInteger n 1)) + (\(u : unit) -> h (subtractInteger n 1)) + ()) + () + !g : integer -> bool + = \(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> h (subtractInteger m 1)) + () + !h : integer -> bool + = \(k : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger k 0) + (\(u : unit) -> False) + (\(u : unit) -> + ifThenElse + {unit -> bool} + (equalsInteger k 1) + (\(u : unit) -> f (subtractInteger k 1)) + (\(u : unit) -> g (subtractInteger k 1)) + ()) + () +in +f \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/threeCycleCollapse b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/threeCycleCollapse new file mode 100644 index 00000000000..a012417eced --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/threeCycleCollapse @@ -0,0 +1,29 @@ +(let (rec) + (termbind (strict) (vardecl f (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [g [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl g (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [h [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl h (fun (con integer) (con bool))) + (lam k (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) k (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [f [(builtin subtractInteger) k (con integer 1)]]) + (con unit ()) + ])) + f) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/threeCycleCollapse.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/threeCycleCollapse.golden new file mode 100644 index 00000000000..12402165e29 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/threeCycleCollapse.golden @@ -0,0 +1,27 @@ +letrec + !f : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> + (\(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> + (\(k : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger k 0) + (\(u : unit) -> False) + (\(u : unit) -> f (subtractInteger k 1)) + ()) + (subtractInteger m 1)) + ()) + (subtractInteger n 1)) + () +in +f \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCycles b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCycles new file mode 100644 index 00000000000..69a820acb8f --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCycles @@ -0,0 +1,41 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl odd (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl f (fun (con integer) (con bool))) + (lam x (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) x (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [g [(builtin subtractInteger) x (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl g (fun (con integer) (con bool))) + (lam y (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) y (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [f [(builtin subtractInteger) y (con integer 1)]]) + (con unit ()) + ])) + (let (nonrec) + (termbind (strict) (vardecl a (con bool)) + [even (con integer 10)]) + [f (con integer 5)])) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCycles.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCycles.golden new file mode 100644 index 00000000000..736b76ff658 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCycles.golden @@ -0,0 +1,38 @@ +letrec + !even : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> + (\(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> even (subtractInteger m 1)) + ()) + (subtractInteger n 1)) + () + !f : integer -> bool + = \(x : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger x 0) + (\(u : unit) -> True) + (\(u : unit) -> + (\(y : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger y 0) + (\(u : unit) -> False) + (\(u : unit) -> f (subtractInteger y 1)) + ()) + (subtractInteger x 1)) + () +in +let + !a : bool = even 10 +in +f 5 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCyclesPartial b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCyclesPartial new file mode 100644 index 00000000000..7b25afb73d2 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCyclesPartial @@ -0,0 +1,44 @@ +(let (rec) + (termbind (strict) (vardecl even (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [odd [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl odd (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [even [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl f (fun (con integer) (con bool))) + (lam x (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) x (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [g [(builtin subtractInteger) x (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl g (fun (con integer) (con bool))) + (lam y (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) y (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [f [(builtin subtractInteger) y (con integer 1)]]) + (con unit ()) + ])) + (let (nonrec) + (termbind (strict) (vardecl a (con bool)) + [even (con integer 10)]) + (let (nonrec) + (termbind (strict) (vardecl b (con bool)) + [f (con integer 5)]) + [g (con integer 3)]))) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCyclesPartial.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCyclesPartial.golden new file mode 100644 index 00000000000..bc0d5460ea4 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/twoIndependentCyclesPartial.golden @@ -0,0 +1,41 @@ +letrec + !even : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> + (\(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> even (subtractInteger m 1)) + ()) + (subtractInteger n 1)) + () + !f : integer -> bool + = \(x : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger x 0) + (\(u : unit) -> True) + (\(u : unit) -> g (subtractInteger x 1)) + () + !g : integer -> bool + = \(y : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger y 0) + (\(u : unit) -> False) + (\(u : unit) -> f (subtractInteger y 1)) + () +in +let + !a : bool = even 10 +in +let + !b : bool = f 5 +in +g 3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/valueBindingPreventsInlining b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/valueBindingPreventsInlining new file mode 100644 index 00000000000..51561239fbc --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/valueBindingPreventsInlining @@ -0,0 +1,22 @@ +(let (rec) + (termbind (strict) (vardecl f (fun (con integer) (con bool))) + (lam n (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) n (con integer 0)] + (lam u (con unit) (con bool True)) + (lam u (con unit) + [g [(builtin subtractInteger) n (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl g (fun (con integer) (con bool))) + (lam m (con integer) + [ {(builtin ifThenElse) (fun (con unit) (con bool))} + [(builtin equalsInteger) m (con integer 0)] + (lam u (con unit) (con bool False)) + (lam u (con unit) + [f [(builtin subtractInteger) m (con integer 1)]]) + (con unit ()) + ])) + (termbind (strict) (vardecl val (con bool)) + [g (con integer 42)]) + [f (con integer 10)]) diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/valueBindingPreventsInlining.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/valueBindingPreventsInlining.golden new file mode 100644 index 00000000000..547d579c651 --- /dev/null +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecInline/valueBindingPreventsInlining.golden @@ -0,0 +1,20 @@ +letrec + !f : integer -> bool + = \(n : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger n 0) + (\(u : unit) -> True) + (\(u : unit) -> g (subtractInteger n 1)) + () + !g : integer -> bool + = \(m : integer) -> + ifThenElse + {unit -> bool} + (equalsInteger m 0) + (\(u : unit) -> False) + (\(u : unit) -> f (subtractInteger m 1)) + () + !val : bool = g 42 +in +f 10 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.12/recursive/sameEmptyRose.golden.uplc b/plutus-tx-plugin/test/Plugin/Data/9.12/recursive/sameEmptyRose.golden.uplc index c5b42408276..f6688675096 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.12/recursive/sameEmptyRose.golden.uplc +++ b/plutus-tx-plugin/test/Plugin/Data/9.12/recursive/sameEmptyRose.golden.uplc @@ -1,206 +1,110 @@ program 1.1.0 - ((\fixBy -> - (\fix3 -> - (\fix1 -> - case - (constr 0 - [ (delay (constr 0 [])) - , (delay (\arg_0 arg_1 -> constr 1 [arg_0, arg_1])) - , (delay - (\x -> - delay - (\case_Nil case_Cons -> - case x [case_Nil, case_Cons]))) ]) - [ (force - (delay - (\Nil - Cons - List_match -> - force - (delay - (\EmptyRose - EmptyRose_match -> - (\g -> - (\f -> - (\tup -> - (\map -> - (\map -> - (\tup -> - (\go -> - (\g -> - (\f -> - (\go -> - (\g -> - (\f -> - force go) - (f - (delay - (\x -> - x)))) - (g - (delay - (\x -> - x)))) - (go - (delay - (\x -> x)))) - (force tup - (\arg_0 - arg_1 - arg_2 -> - arg_2))) - (force tup - (\arg_0 - arg_1 - arg_2 -> - arg_1))) - (force tup - (\arg_0 arg_1 arg_2 -> - arg_0))) - (force - (force - (force - (force - (force - (force - fix3))))) - (delay - (\choose - go - g - f -> - case - (constr 0 - [ (\arg -> - delay - (\x -> - (\x -> - force - g - (force - (f - (delay - (\x -> - x))) - x)) - x)) - , (\arg -> - delay - (force - map - (force - (go - (delay - (\x -> - x)))))) - , (\arg -> - delay - (\x -> - (\x -> - force - (g - (delay - (\x -> - x))) - (force - f - x)) - x)) ]) - [choose])))) - (map (delay (\x -> x)))) - (force tup (\arg_0 -> arg_0))) - (delay - (\f -> - f - (force - (force fix1) - (\map - arg -> - delay - (\ds -> - (\ds - ds -> - force - (force - (force - List_match - ds) - (delay - (force - Nil)) - (\x - xs -> - delay - (force - Cons - (ds - x) - (force - (map - (delay - (\x -> - x))) - ds - xs))))) - ds)))))) - (delay - (\ds -> - force (EmptyRose_match ds) - (\x -> x)))) + ((\fix1 -> + case + (constr 0 + [ (delay (constr 0 [])) + , (delay (\arg_0 arg_1 -> constr 1 [arg_0, arg_1])) + , (delay + (\x -> + delay + (\case_Nil case_Cons -> case x [case_Nil, case_Cons]))) ]) + [ (force + (delay + (\Nil + Cons + List_match -> + force + (delay + (\EmptyRose + EmptyRose_match -> + (\g -> + (\f -> + (\tup -> + (\map -> + (\map -> + (\tup -> + (\go -> + (\go -> force go) + (go (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) + (delay + (\f -> + f + (force + (force fix1) + (\go + arg -> + delay + (\x -> + (\x -> + force + g + ((\x -> + (\x -> + force + map + (force + (go + (delay + (\x -> + x)))) + (force + f + x)) + x) + x)) + x)))))) + (map (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) (delay - (\ds -> - (\`$WEmptyRose` -> force `$WEmptyRose`) - (delay - (\conrep -> - (\conrep -> EmptyRose conrep) - conrep)) - ds)))) - (\arg_0 -> constr 0 [arg_0]) - (\x -> - delay - (\case_EmptyRose -> - case x [case_EmptyRose]))))) ]) - (delay - (delay - (\f -> - force (delay (\s -> s s)) - (\s -> f (\x -> force (delay (\s -> s s)) s x)))))) - (delay - (delay - (delay - (delay - (delay - (delay - (\f -> - force fixBy - (\k -> - delay - (\h -> - case - (constr 0 - [ (\x -> - force k - (\f_0 f_1 f_2 -> f_0 x)) - , (\x -> - force k - (\f_0 f_1 f_2 -> f_1 x)) - , (\x -> - force k - (\f_0 f_1 f_2 -> f_2 x)) ]) - [h])) - f)))))))) + (\f -> + f + (force + (force fix1) + (\map + arg -> + delay + (\ds -> + (\ds + ds -> + force + (force + (force List_match + ds) + (delay + (force Nil)) + (\x + xs -> + delay + (force + Cons + (ds x) + (force + (map + (delay + (\x -> + x))) + ds + xs))))) + ds)))))) + (delay + (\ds -> + force (EmptyRose_match ds) (\x -> x)))) + (delay + (\ds -> + (\`$WEmptyRose` -> force `$WEmptyRose`) + (delay + (\conrep -> + (\conrep -> EmptyRose conrep) + conrep)) + ds)))) + (\arg_0 -> constr 0 [arg_0]) + (\x -> + delay + (\case_EmptyRose -> case x [case_EmptyRose]))))) ]) (delay - (\by -> - force - (force - (delay - (delay - (\f -> - force (delay (\s -> s s)) - (\s -> f (\x -> force (delay (\s -> s s)) s x)))))) - (\rec h -> - delay - (\fr -> - force (by (delay (\fq -> force (rec h) (force h fq)))) - fr))))) \ No newline at end of file + (delay + (\f -> + force (delay (\s -> s s)) + (\s -> f (\x -> force (delay (\s -> s s)) s x)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRose.golden.uplc b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRose.golden.uplc index c5b42408276..f6688675096 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRose.golden.uplc +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRose.golden.uplc @@ -1,206 +1,110 @@ program 1.1.0 - ((\fixBy -> - (\fix3 -> - (\fix1 -> - case - (constr 0 - [ (delay (constr 0 [])) - , (delay (\arg_0 arg_1 -> constr 1 [arg_0, arg_1])) - , (delay - (\x -> - delay - (\case_Nil case_Cons -> - case x [case_Nil, case_Cons]))) ]) - [ (force - (delay - (\Nil - Cons - List_match -> - force - (delay - (\EmptyRose - EmptyRose_match -> - (\g -> - (\f -> - (\tup -> - (\map -> - (\map -> - (\tup -> - (\go -> - (\g -> - (\f -> - (\go -> - (\g -> - (\f -> - force go) - (f - (delay - (\x -> - x)))) - (g - (delay - (\x -> - x)))) - (go - (delay - (\x -> x)))) - (force tup - (\arg_0 - arg_1 - arg_2 -> - arg_2))) - (force tup - (\arg_0 - arg_1 - arg_2 -> - arg_1))) - (force tup - (\arg_0 arg_1 arg_2 -> - arg_0))) - (force - (force - (force - (force - (force - (force - fix3))))) - (delay - (\choose - go - g - f -> - case - (constr 0 - [ (\arg -> - delay - (\x -> - (\x -> - force - g - (force - (f - (delay - (\x -> - x))) - x)) - x)) - , (\arg -> - delay - (force - map - (force - (go - (delay - (\x -> - x)))))) - , (\arg -> - delay - (\x -> - (\x -> - force - (g - (delay - (\x -> - x))) - (force - f - x)) - x)) ]) - [choose])))) - (map (delay (\x -> x)))) - (force tup (\arg_0 -> arg_0))) - (delay - (\f -> - f - (force - (force fix1) - (\map - arg -> - delay - (\ds -> - (\ds - ds -> - force - (force - (force - List_match - ds) - (delay - (force - Nil)) - (\x - xs -> - delay - (force - Cons - (ds - x) - (force - (map - (delay - (\x -> - x))) - ds - xs))))) - ds)))))) - (delay - (\ds -> - force (EmptyRose_match ds) - (\x -> x)))) + ((\fix1 -> + case + (constr 0 + [ (delay (constr 0 [])) + , (delay (\arg_0 arg_1 -> constr 1 [arg_0, arg_1])) + , (delay + (\x -> + delay + (\case_Nil case_Cons -> case x [case_Nil, case_Cons]))) ]) + [ (force + (delay + (\Nil + Cons + List_match -> + force + (delay + (\EmptyRose + EmptyRose_match -> + (\g -> + (\f -> + (\tup -> + (\map -> + (\map -> + (\tup -> + (\go -> + (\go -> force go) + (go (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) + (delay + (\f -> + f + (force + (force fix1) + (\go + arg -> + delay + (\x -> + (\x -> + force + g + ((\x -> + (\x -> + force + map + (force + (go + (delay + (\x -> + x)))) + (force + f + x)) + x) + x)) + x)))))) + (map (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) (delay - (\ds -> - (\`$WEmptyRose` -> force `$WEmptyRose`) - (delay - (\conrep -> - (\conrep -> EmptyRose conrep) - conrep)) - ds)))) - (\arg_0 -> constr 0 [arg_0]) - (\x -> - delay - (\case_EmptyRose -> - case x [case_EmptyRose]))))) ]) - (delay - (delay - (\f -> - force (delay (\s -> s s)) - (\s -> f (\x -> force (delay (\s -> s s)) s x)))))) - (delay - (delay - (delay - (delay - (delay - (delay - (\f -> - force fixBy - (\k -> - delay - (\h -> - case - (constr 0 - [ (\x -> - force k - (\f_0 f_1 f_2 -> f_0 x)) - , (\x -> - force k - (\f_0 f_1 f_2 -> f_1 x)) - , (\x -> - force k - (\f_0 f_1 f_2 -> f_2 x)) ]) - [h])) - f)))))))) + (\f -> + f + (force + (force fix1) + (\map + arg -> + delay + (\ds -> + (\ds + ds -> + force + (force + (force List_match + ds) + (delay + (force Nil)) + (\x + xs -> + delay + (force + Cons + (ds x) + (force + (map + (delay + (\x -> + x))) + ds + xs))))) + ds)))))) + (delay + (\ds -> + force (EmptyRose_match ds) (\x -> x)))) + (delay + (\ds -> + (\`$WEmptyRose` -> force `$WEmptyRose`) + (delay + (\conrep -> + (\conrep -> EmptyRose conrep) + conrep)) + ds)))) + (\arg_0 -> constr 0 [arg_0]) + (\x -> + delay + (\case_EmptyRose -> case x [case_EmptyRose]))))) ]) (delay - (\by -> - force - (force - (delay - (delay - (\f -> - force (delay (\s -> s s)) - (\s -> f (\x -> force (delay (\s -> s s)) s x)))))) - (\rec h -> - delay - (\fr -> - force (by (delay (\fq -> force (rec h) (force h fq)))) - fr))))) \ No newline at end of file + (delay + (\f -> + force (delay (\s -> s s)) + (\s -> f (\x -> force (delay (\s -> s s)) s x)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.12/unfoldings/mutualRecursionUnfoldings.golden.pir b/plutus-tx-plugin/test/Plugin/Functions/9.12/unfoldings/mutualRecursionUnfoldings.golden.pir index 8c6f724ff53..163e2d731f5 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.12/unfoldings/mutualRecursionUnfoldings.golden.pir +++ b/plutus-tx-plugin/test/Plugin/Functions/9.12/unfoldings/mutualRecursionUnfoldings.golden.pir @@ -11,17 +11,19 @@ letrec case (all dead. bool) (equalsInteger n 0) - [(/\dead -> oddDirect (subtractInteger n 1)), (/\dead -> True)] - {all dead. dead} - ~oddDirect : integer -> bool - = \(n : integer) -> - let - !n : integer = n - in - case - (all dead. bool) - (equalsInteger n 0) - [(/\dead -> evenDirect (subtractInteger n 1)), (/\dead -> False)] + [ (/\dead -> + (\(n : integer) -> + let + !n : integer = n + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> evenDirect (subtractInteger n 1)) + , (/\dead -> False) ] + {all dead. dead}) + (subtractInteger n 1)) + , (/\dead -> True) ] {all dead. dead} in evenDirect 4 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree.golden.pir b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree.golden.pir new file mode 100644 index 00000000000..906d97b3bc9 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree.golden.pir @@ -0,0 +1,48 @@ +let + !equalsInteger : integer -> integer -> bool = equalsInteger + ~equalsInteger : integer -> integer -> bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in equalsInteger x y + !subtractInteger : integer -> integer -> integer = subtractInteger + ~subtractInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in subtractInteger x y +in +letrec + ~divisibleByThree : integer -> bool + = \(n : integer) -> + let + !n : integer = n + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> + let + !n : integer = subtractInteger n 1 + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> + let + !n : integer = subtractInteger n 1 + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> divisibleByThree (subtractInteger n 1)) + , (/\dead -> False) ] + {all dead. dead}) + , (/\dead -> False) ] + {all dead. dead}) + , (/\dead -> True) ] + {all dead. dead} +in +divisibleByThree \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree.golden.uplc b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree.golden.uplc new file mode 100644 index 00000000000..35763ab6485 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree.golden.uplc @@ -0,0 +1,73 @@ +(program + 1.1.0 + ((\fix1 -> + (\subtractInteger -> + (\subtractInteger -> + (\equalsInteger -> + (\equalsInteger -> + (\tup -> + (\divisibleByThree -> + (\divisibleByThree -> force divisibleByThree) + (divisibleByThree (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) + (delay + (\f -> + f + (force + (force fix1) + (\divisibleByThree + arg -> + delay + (\n -> + (\n -> + force + (case + (force equalsInteger n 0) + [ (delay + ((\n -> + force + (case + (force + equalsInteger + n + 0) + [ (delay + ((\n -> + force + (case + (force + equalsInteger + n + 0) + [ (delay + (force + (divisibleByThree + (delay + (\x -> + x))) + (force + subtractInteger + n + 1))) + , (delay + False) ])) + (force + subtractInteger + n + 1))) + , (delay + False) ])) + (force subtractInteger + n + 1))) + , (delay True) ])) + n)))))) + (delay (\x -> (\x y -> (\y -> equalsInteger x y) y) x))) + equalsInteger) + (delay (\x -> (\x y -> (\y -> subtractInteger x y) y) x))) + subtractInteger) + (delay + (delay + (\f -> + force (delay (\s -> s s)) + (\s -> f (\x -> force (delay (\s -> s s)) s x))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree10.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree10.golden.eval new file mode 100644 index 00000000000..c1f22fbc23b --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree10.golden.eval @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree300.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree300.golden.eval new file mode 100644 index 00000000000..7b4b5569831 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree300.golden.eval @@ -0,0 +1,6 @@ +CPU: 289_058_733 +Memory: 1_519_401 +AST Size: 161 +Flat Size: 144 + +(con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree9.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree9.golden.eval new file mode 100644 index 00000000000..4791ed5559b --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/divisibleByThree9.golden.eval @@ -0,0 +1 @@ +True \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.golden.uplc b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.golden.uplc new file mode 100644 index 00000000000..f24b38e7d97 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.golden.uplc @@ -0,0 +1,57 @@ +(program + 1.1.0 + ((\fix1 -> + (\subtractInteger -> + (\subtractInteger -> + (\equalsInteger -> + (\equalsInteger -> + (\tup -> + (\even -> (\even -> force even) (even (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) + (delay + (\f -> + f + (force + (force fix1) + (\even + arg -> + delay + (\n -> + (\n -> + force + (case + (force equalsInteger n 0) + [ (delay + ((\n -> + force + (case + (force + equalsInteger + n + 0) + [ (delay + (force + (even + (delay + (\x -> + x))) + (force + subtractInteger + n + 1))) + , (delay + False) ])) + (force subtractInteger + n + 1))) + , (delay True) ])) + n)))))) + (delay (\x -> (\x y -> (\y -> equalsInteger x y) y) x))) + equalsInteger) + (delay (\x -> (\x y -> (\y -> subtractInteger x y) y) x))) + subtractInteger) + (delay + (delay + (\f -> + force (delay (\s -> s s)) + (\s -> f (\x -> force (delay (\s -> s s)) s x))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even200.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even200.golden.eval new file mode 100644 index 00000000000..17f3ea4f619 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even200.golden.eval @@ -0,0 +1,6 @@ +CPU: 204_904_633 +Memory: 1_089_101 +AST Size: 142 +Flat Size: 126 + +(con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal10.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal10.golden.eval new file mode 100644 index 00000000000..c1f22fbc23b --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal10.golden.eval @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal300.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal300.golden.eval new file mode 100644 index 00000000000..d14b071a4b2 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal300.golden.eval @@ -0,0 +1,6 @@ +CPU: 163_938_733 +Memory: 737_401 +AST Size: 129 +Flat Size: 120 + +(con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal9.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal9.golden.eval new file mode 100644 index 00000000000..4791ed5559b --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternal9.golden.eval @@ -0,0 +1 @@ +True \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternalMutual.golden.pir b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternalMutual.golden.pir new file mode 100644 index 00000000000..fe8e25e4b51 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternalMutual.golden.pir @@ -0,0 +1,41 @@ +let + !equalsInteger : integer -> integer -> bool = equalsInteger + !subtractInteger : integer -> integer -> integer = subtractInteger +in +letrec + ~divisibleByThreeDirect : integer -> bool + = \(n : integer) -> + let + !n : integer = n + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> + (\(n : integer) -> + let + !n : integer = n + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> + (\(n : integer) -> + let + !n : integer = n + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> + divisibleByThreeDirect (subtractInteger n 1)) + , (/\dead -> False) ] + {all dead. dead}) + (subtractInteger n 1)) + , (/\dead -> False) ] + {all dead. dead}) + (subtractInteger n 1)) + , (/\dead -> True) ] + {all dead. dead} +in +divisibleByThreeDirect \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternalMutual.golden.uplc b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternalMutual.golden.uplc new file mode 100644 index 00000000000..a270bf4e520 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/divisibleByThreeExternalMutual.golden.uplc @@ -0,0 +1,64 @@ +(program + 1.1.0 + ((\fix1 -> + (\subtractInteger -> + (\equalsInteger -> + (\tup -> + (\divisibleByThreeDirect -> + (\divisibleByThreeDirect -> force divisibleByThreeDirect) + (divisibleByThreeDirect (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) + (delay + (\f -> + f + (force + (force fix1) + (\divisibleByThreeDirect + arg -> + delay + (\n -> + (\n -> + force + (case + (equalsInteger n 0) + [ (delay + ((\n -> + (\n -> + force + (case + (equalsInteger n 0) + [ (delay + ((\n -> + (\n -> + force + (case + (equalsInteger + n + 0) + [ (delay + (force + (divisibleByThreeDirect + (delay + (\x -> + x))) + (subtractInteger + n + 1))) + , (delay + False) ])) + n) + (subtractInteger + n + 1))) + , (delay False) ])) + n) + (subtractInteger n 1))) + , (delay True) ])) + n)))))) + equalsInteger) + subtractInteger) + (delay + (delay + (\f -> + force (delay (\s -> s s)) + (\s -> f (\x -> force (delay (\s -> s s)) s x))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal200.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal200.golden.eval new file mode 100644 index 00000000000..eb182b55cac --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal200.golden.eval @@ -0,0 +1,6 @@ +CPU: 119_784_633 +Memory: 557_101 +AST Size: 109 +Flat Size: 100 + +(con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal3.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal3.golden.eval new file mode 100644 index 00000000000..c1f22fbc23b --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal3.golden.eval @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal4.golden.eval b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal4.golden.eval new file mode 100644 index 00000000000..4791ed5559b --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternal4.golden.eval @@ -0,0 +1 @@ +True \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternalMutual.golden.pir b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternalMutual.golden.pir new file mode 100644 index 00000000000..9c10b82c38d --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternalMutual.golden.pir @@ -0,0 +1,29 @@ +let + !equalsInteger : integer -> integer -> bool = equalsInteger + !subtractInteger : integer -> integer -> integer = subtractInteger +in +letrec + ~evenDirect : integer -> bool + = \(n : integer) -> + let + !n : integer = n + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> + (\(n : integer) -> + let + !n : integer = n + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> evenDirect (subtractInteger n 1)) + , (/\dead -> False) ] + {all dead. dead}) + (subtractInteger n 1)) + , (/\dead -> True) ] + {all dead. dead} +in +evenDirect \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternalMutual.golden.uplc b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternalMutual.golden.uplc new file mode 100644 index 00000000000..dda71813b5a --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/evenExternalMutual.golden.uplc @@ -0,0 +1,50 @@ +(program + 1.1.0 + ((\fix1 -> + (\subtractInteger -> + (\equalsInteger -> + (\tup -> + (\evenDirect -> + (\evenDirect -> force evenDirect) + (evenDirect (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) + (delay + (\f -> + f + (force + (force fix1) + (\evenDirect + arg -> + delay + (\n -> + (\n -> + force + (case + (equalsInteger n 0) + [ (delay + ((\n -> + (\n -> + force + (case + (equalsInteger n 0) + [ (delay + (force + (evenDirect + (delay + (\x -> + x))) + (subtractInteger + n + 1))) + , (delay False) ])) + n) + (subtractInteger n 1))) + , (delay True) ])) + n)))))) + equalsInteger) + subtractInteger) + (delay + (delay + (\f -> + force (delay (\s -> s s)) + (\s -> f (\x -> force (delay (\s -> s s)) s x))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.golden.pir b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.golden.pir index 8c6f724ff53..163e2d731f5 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.golden.pir +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.golden.pir @@ -11,17 +11,19 @@ letrec case (all dead. bool) (equalsInteger n 0) - [(/\dead -> oddDirect (subtractInteger n 1)), (/\dead -> True)] - {all dead. dead} - ~oddDirect : integer -> bool - = \(n : integer) -> - let - !n : integer = n - in - case - (all dead. bool) - (equalsInteger n 0) - [(/\dead -> evenDirect (subtractInteger n 1)), (/\dead -> False)] + [ (/\dead -> + (\(n : integer) -> + let + !n : integer = n + in + case + (all dead. bool) + (equalsInteger n 0) + [ (/\dead -> evenDirect (subtractInteger n 1)) + , (/\dead -> False) ] + {all dead. dead}) + (subtractInteger n 1)) + , (/\dead -> True) ] {all dead. dead} in evenDirect 4 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Lib.hs b/plutus-tx-plugin/test/Plugin/Lib.hs index 7680512dbf9..b85cf45bb87 100644 --- a/plutus-tx-plugin/test/Plugin/Lib.hs +++ b/plutus-tx-plugin/test/Plugin/Lib.hs @@ -27,6 +27,25 @@ oddDirect :: Integer -> Bool oddDirect n = if Builtins.equalsInteger n 0 then False else evenDirect (Builtins.subtractInteger n 1) {-# INLINEABLE oddDirect #-} +divisibleByThreeDirect :: Integer -> Bool +divisibleByThreeDirect n = + if Builtins.equalsInteger n 0 + then True + else divisibleByThreeStep1Direct (Builtins.subtractInteger n 1) +{-# INLINEABLE divisibleByThreeDirect #-} + +divisibleByThreeStep1Direct :: Integer -> Bool +divisibleByThreeStep1Direct n = + if Builtins.equalsInteger n 0 + then False + else divisibleByThreeStep2Direct (Builtins.subtractInteger n 1) +{-# INLINEABLE divisibleByThreeStep1Direct #-} + +divisibleByThreeStep2Direct :: Integer -> Bool +divisibleByThreeStep2Direct n = + if Builtins.equalsInteger n 0 then False else divisibleByThreeDirect (Builtins.subtractInteger n 1) +{-# INLINEABLE divisibleByThreeStep2Direct #-} + -- GHC will lift out the error call to the top level, which is unsafe unless we bind it lazily. -- This is in Lib so we get the fully optimized unfolding with awkward top-level binds and everything. joinError :: Bool -> Bool -> () diff --git a/plutus-tx/src/PlutusTx/Data/List.hs b/plutus-tx/src/PlutusTx/Data/List.hs index 28d15558612..b536d6c152e 100644 --- a/plutus-tx/src/PlutusTx/Data/List.hs +++ b/plutus-tx/src/PlutusTx/Data/List.hs @@ -146,9 +146,11 @@ However, it does affect how GHC compiles the function's callsites to GHC Core. In the instance of `caseList`/`caseList'`, if `c` is strict, and is passed a function that calls `caseList`/`caseList'`, GHC will end up creating two mutually recursive -bindings for the application of `caseList`/`caseList'`. Since our inliner currently -does not inline recursive bindings, the additional binding will end up not being -inlined, which can lead to significant performance penalty. +bindings for the application of `caseList`/`caseList'`. The recursive inliner can +remove these additional bindings in optimized builds when they satisfy its +single-use/small-helper criteria, but making these parameters non-strict avoids +creating the extra bindings in the first place and keeps the unoptimized output +small. -} -- | Matching on the given `List`.