diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index 8b00accf204..d0a1bcc7689 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -140,6 +140,7 @@ test-suite plutus-tx-plugin-tests Budget.Spec Budget.WithGHCOptimisations Budget.WithoutGHCOptimisations + BuiltinCasing.Lib BuiltinCasing.Spec BuiltinList.Budget.Spec BuiltinList.NoCasing.Spec diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs index 7ba8793f0e5..474e09c5669 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs @@ -1257,11 +1257,24 @@ compileExpr mloc e = do -- The "unfolding template" includes things with normal unfoldings and also dictionary functions Just unfolding -> hoistExpr n unfolding Nothing -> - throwSd FreeVariableError $ - "Variable" + throwSd + (if GHC.isLocalId n then UnsupportedError else FreeVariableError) + $ "Variable" GHC.<+> GHC.ppr n GHC.$+$ (GHC.ppr $ GHC.idDetails n) GHC.$+$ (GHC.ppr $ GHC.realIdUnfolding n) + GHC.$+$ if GHC.isLocalId n + then + "" + GHC.$+$ "This error often indicates a stage violation in Plinth compilation." + GHC.$+$ "Variables inside compile quotations must be either:" + GHC.$+$ " • Top-level variables, or" + GHC.$+$ " • Bound inside the quotation itself" + GHC.$+$ "" + GHC.$+$ "Common causes:" + GHC.$+$ " • Using a function defined in a 'where' clause: move it to the top level" + GHC.$+$ " • Referencing local variables from outside the quotation" + else "" -- arg can be a type here, in which case it's a type instantiation l `GHC.App` GHC.Type t -> do l' <- compileExpr Nothing l diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq1.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq1.golden.eval index 305c4bb9f8e..e704fbf105a 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq1.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq1.golden.eval @@ -1,6 +1,6 @@ -CPU: 337_547_895 -Memory: 988_745 -AST Size: 639 -Flat Size: 949 +CPU: 341_387_895 +Memory: 1_012_745 +AST Size: 629 +Flat Size: 939 (con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq2.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq2.golden.eval index 7df13110969..cc372b0bc3b 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq2.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq2.golden.eval @@ -1,6 +1,6 @@ -CPU: 355_097_594 -Memory: 1_055_015 -AST Size: 639 -Flat Size: 1_000 +CPU: 359_033_594 +Memory: 1_079_615 +AST Size: 629 +Flat Size: 990 (con bool False) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq3.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq3.golden.eval index d7e1cb55530..0d802492131 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq3.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq3.golden.eval @@ -1,6 +1,6 @@ -CPU: 368_720_887 -Memory: 1_100_329 -AST Size: 639 -Flat Size: 1_000 +CPU: 372_656_887 +Memory: 1_124_929 +AST Size: 629 +Flat Size: 990 (con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq4.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq4.golden.eval index 92bd54c53ab..683e1c2e606 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq4.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq4.golden.eval @@ -1,6 +1,6 @@ -CPU: 331_212_553 -Memory: 946_336 -AST Size: 639 -Flat Size: 956 +CPU: 335_148_553 +Memory: 970_936 +AST Size: 629 +Flat Size: 946 (con bool False) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq5.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq5.golden.eval index 5747005a96f..1c0d1874041 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq5.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/geq5.golden.eval @@ -1,6 +1,6 @@ -CPU: 349_612_383 -Memory: 1_021_500 -AST Size: 639 -Flat Size: 956 +CPU: 353_548_383 +Memory: 1_046_100 +AST Size: 629 +Flat Size: 946 (con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt.golden.pir b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt.golden.pir index ee74ddedcc5..00a2808b998 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt.golden.pir +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt.golden.pir @@ -268,6 +268,12 @@ let = case data hd [(\(l : data) (r : data) -> r)] !k : data = case data hd [(\(l : data) (r : data) -> l)] + !`$j` : data -> list (pair data data) + = \(v' : data) -> + mkCons + {pair data data} + (mkPairData k v') + (goRight tl) in Maybe_match {data} @@ -275,33 +281,25 @@ let {all dead. list (pair data data)} (\(r : data) -> /\dead -> - mkCons - {pair data data} - (mkPairData - k - (`$fToDataThese_$ctoBuiltinData` + `$j` + (`$fToDataThese_$ctoBuiltinData` + {a} + {b} + `$dToData` + `$dToData` + (These {a} {b} - `$dToData` - `$dToData` - (These - {a} - {b} - (`$dUnsafeFromData` v) - (`$dUnsafeFromData` r)))) - (goRight tl)) + (`$dUnsafeFromData` v) + (`$dUnsafeFromData` r)))) (/\dead -> - mkCons - {pair data data} - (mkPairData - k - (`$fToDataThese_$ctoBuiltinData` - {a} - {b} - `$dToData` - `$dToData` - (That {a} {b} (`$dUnsafeFromData` v)))) - (goRight tl)) + `$j` + (`$fToDataThese_$ctoBuiltinData` + {a} + {b} + `$dToData` + `$dToData` + (That {a} {b} (`$dUnsafeFromData` v)))) {all dead. dead}) , [] ] in @@ -318,6 +316,12 @@ let = case data hd [(\(l : data) (r : data) -> r)] !k : data = case data hd [(\(l : data) (r : data) -> l)] + !`$j` : data -> list (pair data data) + = \(v' : data) -> + mkCons + {pair data data} + (mkPairData k v') + (goLeft tl) in Maybe_match {data} @@ -325,33 +329,25 @@ let {all dead. list (pair data data)} (\(r : data) -> /\dead -> - mkCons - {pair data data} - (mkPairData - k - (`$fToDataThese_$ctoBuiltinData` + `$j` + (`$fToDataThese_$ctoBuiltinData` + {a} + {b} + `$dToData` + `$dToData` + (These {a} {b} - `$dToData` - `$dToData` - (These - {a} - {b} - (`$dUnsafeFromData` v) - (`$dUnsafeFromData` r)))) - (goLeft tl)) + (`$dUnsafeFromData` v) + (`$dUnsafeFromData` r)))) (/\dead -> - mkCons - {pair data data} - (mkPairData - k - (`$fToDataThese_$ctoBuiltinData` - {a} - {b} - `$dToData` - `$dToData` - (This {a} {b} (`$dUnsafeFromData` v)))) - (goLeft tl)) + `$j` + (`$fToDataThese_$ctoBuiltinData` + {a} + {b} + `$dToData` + `$dToData` + (This {a} {b} (`$dUnsafeFromData` v)))) {all dead. dead}) , [] ] in diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt1.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt1.golden.eval index d5495f9b829..ef19118eefe 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt1.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt1.golden.eval @@ -1,6 +1,6 @@ -CPU: 388_148_300 -Memory: 1_166_660 -AST Size: 1_023 -Flat Size: 1_324 +CPU: 391_988_300 +Memory: 1_190_660 +AST Size: 1_013 +Flat Size: 1_314 (con bool False) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt2.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt2.golden.eval index eaef2037302..637845b642f 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt2.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt2.golden.eval @@ -1,6 +1,6 @@ -CPU: 355_465_594 -Memory: 1_057_315 -AST Size: 1_023 -Flat Size: 1_375 +CPU: 359_401_594 +Memory: 1_081_915 +AST Size: 1_013 +Flat Size: 1_365 (con bool False) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt3.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt3.golden.eval index 5bbeabe17a0..790c04fb66f 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt3.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt3.golden.eval @@ -1,6 +1,6 @@ -CPU: 420_042_992 -Memory: 1_282_209 -AST Size: 1_023 -Flat Size: 1_375 +CPU: 423_978_992 +Memory: 1_306_809 +AST Size: 1_013 +Flat Size: 1_365 (con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt4.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt4.golden.eval index e1d6a166af4..887b462be70 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt4.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt4.golden.eval @@ -1,6 +1,6 @@ -CPU: 331_580_553 -Memory: 948_636 -AST Size: 1_023 -Flat Size: 1_331 +CPU: 335_516_553 +Memory: 973_236 +AST Size: 1_013 +Flat Size: 1_321 (con bool False) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt5.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt5.golden.eval index 45be5fc853e..a38e06c8557 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt5.golden.eval +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.12/gt5.golden.eval @@ -1,6 +1,6 @@ -CPU: 373_819_011 -Memory: 1_110_324 -AST Size: 1_023 -Flat Size: 1_331 +CPU: 377_755_011 +Memory: 1_134_924 +AST Size: 1_013 +Flat Size: 1_321 (con bool True) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.12/map2.golden.eval b/plutus-tx-plugin/test/Budget/9.12/map2.golden.eval index 7efa7cc75ef..315ade87985 100644 --- a/plutus-tx-plugin/test/Budget/9.12/map2.golden.eval +++ b/plutus-tx-plugin/test/Budget/9.12/map2.golden.eval @@ -1,7 +1,7 @@ -CPU: 67_827_382 -Memory: 197_790 -AST Size: 423 -Flat Size: 458 +CPU: 68_307_382 +Memory: 200_790 +AST Size: 418 +Flat Size: 453 (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.12/map2.golden.pir b/plutus-tx-plugin/test/Budget/9.12/map2.golden.pir index 07b4448c160..c302a5fa58f 100644 --- a/plutus-tx-plugin/test/Budget/9.12/map2.golden.pir +++ b/plutus-tx-plugin/test/Budget/9.12/map2.golden.pir @@ -159,20 +159,19 @@ in {all dead. dead}) , (Nothing {data}) ] in + let + !`$j` : data -> list (pair data data) + = \(v'' : data) -> + mkCons {pair data data} (mkPairData k' v'') (go tl) + in Maybe_match {data} (go nt) {all dead. list (pair data data)} (\(r : data) -> /\dead -> - mkCons - {pair data data} - (mkPairData - k' - (iData (addInteger (unIData v') (unIData r)))) - (go tl)) - (/\dead -> - mkCons {pair data data} (mkPairData k' v') (go tl)) + `$j` (iData (addInteger (unIData v') (unIData r)))) + (/\dead -> `$j` v') {all dead. dead}) , [] ] in diff --git a/plutus-tx-plugin/test/Budget/9.12/map2.golden.uplc b/plutus-tx-plugin/test/Budget/9.12/map2.golden.uplc index a3fe621186f..39598866676 100644 --- a/plutus-tx-plugin/test/Budget/9.12/map2.golden.uplc +++ b/plutus-tx-plugin/test/Budget/9.12/map2.golden.uplc @@ -70,41 +70,41 @@ tl -> (\v' -> (\k' -> - (\s -> - case - (s s nt) - [ (\r -> - force mkCons - (mkPairData - k' + (\`$j` -> + (\s -> + case + (s s nt) + [ (\r -> + `$j` (iData (addInteger (unIData v') (unIData r)))) - (s s tl)) - , (force mkCons - (mkPairData k' v') - (s s tl)) ]) - (\s - xs -> - case - xs - [ (\hd -> - case - (equalsData - k' - (case - hd - [(\l r -> l)])) - [ (\x -> s s x) - , (\ds -> - constr 0 - [ (case - hd - [ (\l - r -> - r) ]) ]) ]) - , (constr 1 []) ])) + , (`$j` v') ]) + (\s + xs -> + case + xs + [ (\hd -> + case + (equalsData + k' + (case + hd + [(\l r -> l)])) + [ (\x -> s s x) + , (\ds -> + constr 0 + [ (case + hd + [ (\l + r -> + r) ]) ]) ]) + , (constr 1 []) ])) + (\v'' -> + force mkCons + (mkPairData k' v'') + (s s tl))) (case hd [(\l r -> l)])) (case hd [(\l r -> r)])) , [] ]))) diff --git a/plutus-tx-plugin/test/Budget/9.12/map3.golden.eval b/plutus-tx-plugin/test/Budget/9.12/map3.golden.eval index 706b9483d42..da011ae4937 100644 --- a/plutus-tx-plugin/test/Budget/9.12/map3.golden.eval +++ b/plutus-tx-plugin/test/Budget/9.12/map3.golden.eval @@ -1,7 +1,7 @@ -CPU: 111_907_732 -Memory: 333_684 -AST Size: 664 -Flat Size: 705 +CPU: 112_771_732 +Memory: 339_084 +AST Size: 654 +Flat Size: 695 (constr 1 diff --git a/plutus-tx-plugin/test/Budget/9.12/map3.golden.pir b/plutus-tx-plugin/test/Budget/9.12/map3.golden.pir index ea60b2b264d..308022a9f2a 100644 --- a/plutus-tx-plugin/test/Budget/9.12/map3.golden.pir +++ b/plutus-tx-plugin/test/Budget/9.12/map3.golden.pir @@ -200,6 +200,9 @@ in let !v : data = case data hd [(\(l : data) (r : data) -> r)] !k : data = case data hd [(\(l : data) (r : data) -> l)] + !`$j` : data -> list (pair data data) + = \(v' : data) -> + mkCons {pair data data} (mkPairData k v') (goLeft tl) in Maybe_match {data} @@ -207,33 +210,25 @@ in {all dead. list (pair data data)} (\(r : data) -> /\dead -> - mkCons - {pair data data} - (mkPairData - k - (`$fToDataThese_$ctoBuiltinData` + `$j` + (`$fToDataThese_$ctoBuiltinData` + {integer} + {integer} + `$dToData` + `$dToData` + (These {integer} {integer} - `$dToData` - `$dToData` - (These - {integer} - {integer} - (unIData v) - (unIData r)))) - (goLeft tl)) + (unIData v) + (unIData r)))) (/\dead -> - mkCons - {pair data data} - (mkPairData - k - (`$fToDataThese_$ctoBuiltinData` - {integer} - {integer} - `$dToData` - `$dToData` - (This {integer} {integer} (unIData v)))) - (goLeft tl)) + `$j` + (`$fToDataThese_$ctoBuiltinData` + {integer} + {integer} + `$dToData` + `$dToData` + (This {integer} {integer} (unIData v)))) {all dead. dead}) , [] ] in @@ -273,6 +268,9 @@ in let !v : data = case data hd [(\(l : data) (r : data) -> r)] !k : data = case data hd [(\(l : data) (r : data) -> l)] + !`$j` : data -> list (pair data data) + = \(v' : data) -> + mkCons {pair data data} (mkPairData k v') (goRight tl) in Maybe_match {data} @@ -280,33 +278,25 @@ in {all dead. list (pair data data)} (\(r : data) -> /\dead -> - mkCons - {pair data data} - (mkPairData - k - (`$fToDataThese_$ctoBuiltinData` + `$j` + (`$fToDataThese_$ctoBuiltinData` + {integer} + {integer} + `$dToData` + `$dToData` + (These {integer} {integer} - `$dToData` - `$dToData` - (These - {integer} - {integer} - (unIData v) - (unIData r)))) - (goRight tl)) + (unIData v) + (unIData r)))) (/\dead -> - mkCons - {pair data data} - (mkPairData - k - (`$fToDataThese_$ctoBuiltinData` - {integer} - {integer} - `$dToData` - `$dToData` - (That {integer} {integer} (unIData v)))) - (goRight tl)) + `$j` + (`$fToDataThese_$ctoBuiltinData` + {integer} + {integer} + `$dToData` + `$dToData` + (That {integer} {integer} (unIData v)))) {all dead. dead}) , [] ] in diff --git a/plutus-tx-plugin/test/Budget/9.12/map3.golden.uplc b/plutus-tx-plugin/test/Budget/9.12/map3.golden.uplc index 56d7e41ebe4..73aba1edfbc 100644 --- a/plutus-tx-plugin/test/Budget/9.12/map3.golden.uplc +++ b/plutus-tx-plugin/test/Budget/9.12/map3.golden.uplc @@ -107,13 +107,11 @@ tl -> (\v -> (\k -> - case - (lookup' k nt) - [ (\r -> - force - mkCons - (mkPairData - k + (\`$j` -> + case + (lookup' k nt) + [ (\r -> + `$j` (case (constr 0 [ `$dToData` @@ -124,11 +122,7 @@ , (unIData r) ]) ]) [ `$fToDataThese_$ctoBuiltinData` ])) - (s s tl)) - , (force - mkCons - (mkPairData - k + , (`$j` (case (constr 0 [ `$dToData` @@ -136,8 +130,11 @@ , (constr 0 [ (unIData v) ]) ]) - [ `$fToDataThese_$ctoBuiltinData` ])) - (s s tl)) ]) + [ `$fToDataThese_$ctoBuiltinData` ])) ]) + (\v' -> + force mkCons + (mkPairData k v') + (s s tl))) (case hd [(\l r -> l)])) (case hd [(\l r -> r)])) , [] ]))) @@ -179,13 +176,11 @@ tl -> (\v -> (\k -> - case - (lookup' k nt) - [ (\r -> - force - mkCons - (mkPairData - k + (\`$j` -> + case + (lookup' k nt) + [ (\r -> + `$j` (case (constr 0 [ `$dToData` @@ -196,11 +191,7 @@ , (unIData r) ]) ]) [ `$fToDataThese_$ctoBuiltinData` ])) - (s s tl)) - , (force - mkCons - (mkPairData - k + , (`$j` (case (constr 0 [ `$dToData` @@ -208,8 +199,11 @@ , (constr 2 [ (unIData v) ]) ]) - [ `$fToDataThese_$ctoBuiltinData` ])) - (s s tl)) ]) + [ `$fToDataThese_$ctoBuiltinData` ])) ]) + (\v' -> + force mkCons + (mkPairData k v') + (s s tl))) (case hd [(\l r -> l)])) (case hd [(\l r -> r)])) , [] ]))) diff --git a/plutus-tx-plugin/test/BuiltinCasing/9.12/head.golden.uplc b/plutus-tx-plugin/test/BuiltinCasing/9.12/head.golden.uplc index d4a7a6050e5..e65a842ea71 100644 --- a/plutus-tx-plugin/test/BuiltinCasing/9.12/head.golden.uplc +++ b/plutus-tx-plugin/test/BuiltinCasing/9.12/head.golden.uplc @@ -1 +1 @@ -(program 1.1.0 (\xs -> case xs [(\x xs ds -> x), (\ds -> error)] (constr 0 []))) \ No newline at end of file +(program 1.1.0 (\l -> case l [(\x xs ds -> x), (\ds -> error)] (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceByteString.golden.uplc b/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceByteString.golden.uplc new file mode 100644 index 00000000000..a34c3c8d93b --- /dev/null +++ b/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceByteString.golden.uplc @@ -0,0 +1 @@ +(program 1.1.0 (\bs -> (\cse -> ()) (appendByteString bs bs))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceData.golden.uplc b/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceData.golden.uplc new file mode 100644 index 00000000000..262ae1ede39 --- /dev/null +++ b/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceData.golden.uplc @@ -0,0 +1,16 @@ +(program + 1.1.0 + (\bd -> + (\nt -> + (\`$j` -> + case + (case nt [(\x eta -> constr 0 [x]), (constr 1 [])]) + [ (\arg -> + (\ds -> force `$j`) (constrData 0 (force mkCons arg []))) + , (force `$j`) ]) + (delay + (case + (case nt [(\x eta -> constr 0 [x]), (constr 1 [])]) + [ (\arg -> (\ds -> ()) (constrData 0 (force mkCons arg []))) + , () ]))) + (unListData bd))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceString.golden.uplc b/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceString.golden.uplc new file mode 100644 index 00000000000..8edcd9fff96 --- /dev/null +++ b/plutus-tx-plugin/test/BuiltinCasing/9.12/useTwiceString.golden.uplc @@ -0,0 +1 @@ +(program 1.1.0 (\s -> (\cse -> ()) (appendString s s))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinCasing/9.6/head.golden.uplc b/plutus-tx-plugin/test/BuiltinCasing/9.6/head.golden.uplc index d4a7a6050e5..e65a842ea71 100644 --- a/plutus-tx-plugin/test/BuiltinCasing/9.6/head.golden.uplc +++ b/plutus-tx-plugin/test/BuiltinCasing/9.6/head.golden.uplc @@ -1 +1 @@ -(program 1.1.0 (\xs -> case xs [(\x xs ds -> x), (\ds -> error)] (constr 0 []))) \ No newline at end of file +(program 1.1.0 (\l -> case l [(\x xs ds -> x), (\ds -> error)] (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceByteString.golden.uplc b/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceByteString.golden.uplc new file mode 100644 index 00000000000..a34c3c8d93b --- /dev/null +++ b/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceByteString.golden.uplc @@ -0,0 +1 @@ +(program 1.1.0 (\bs -> (\cse -> ()) (appendByteString bs bs))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceData.golden.uplc b/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceData.golden.uplc new file mode 100644 index 00000000000..262ae1ede39 --- /dev/null +++ b/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceData.golden.uplc @@ -0,0 +1,16 @@ +(program + 1.1.0 + (\bd -> + (\nt -> + (\`$j` -> + case + (case nt [(\x eta -> constr 0 [x]), (constr 1 [])]) + [ (\arg -> + (\ds -> force `$j`) (constrData 0 (force mkCons arg []))) + , (force `$j`) ]) + (delay + (case + (case nt [(\x eta -> constr 0 [x]), (constr 1 [])]) + [ (\arg -> (\ds -> ()) (constrData 0 (force mkCons arg []))) + , () ]))) + (unListData bd))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceString.golden.uplc b/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceString.golden.uplc new file mode 100644 index 00000000000..8edcd9fff96 --- /dev/null +++ b/plutus-tx-plugin/test/BuiltinCasing/9.6/useTwiceString.golden.uplc @@ -0,0 +1 @@ +(program 1.1.0 (\s -> (\cse -> ()) (appendString s s))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/BuiltinCasing/Lib.hs b/plutus-tx-plugin/test/BuiltinCasing/Lib.hs new file mode 100644 index 00000000000..ca48bb09949 --- /dev/null +++ b/plutus-tx-plugin/test/BuiltinCasing/Lib.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.1.0 #-} + +{-# HLINT ignore #-} + +module BuiltinCasing.Lib + ( useTwiceData + , useTwiceByteString + , useTwiceString + ) where + +import PlutusTx +import PlutusTx.Builtins.Internal (unitval) +import PlutusTx.Builtins.Internal qualified as BI +import PlutusTx.Data.List qualified as Data.List +import PlutusTx.Prelude + +{-| Regression tests for #7716. The simplifier unwraps single-constructor +opaque types via case-of-known-constructor, potentially exposing inner types +(Data, ByteString, Text) in join point type signatures. Without the second +constructor (see Note [Opaque builtin types]), the plugin with BuiltinCasing +would try to compile the inner type as a regular ADT and crash. + +Each test targets a different opaque builtin type: + - useTwiceData: BuiltinData (wraps PlutusCore.Data.Data) + - useTwiceByteString: BuiltinByteString (wraps ByteString -> BS Addr#) + - useTwiceString: BuiltinString (wraps Text -> Array# Char#) -} +useTwiceData :: BuiltinData -> BuiltinUnit +useTwiceData bd = + case toBuiltinData (firstOf items) of + _ -> case toBuiltinData (firstOf items) of + _ -> unitval + where + items = unsafeFromBuiltinData bd + firstOf = Data.List.caseList' Nothing (\(h :: BuiltinData) _t -> Just h) + +useTwiceByteString :: BuiltinByteString -> BuiltinUnit +useTwiceByteString bs = + case BI.appendByteString bs bs of + _ -> case BI.appendByteString bs bs of + _ -> unitval + +useTwiceString :: BuiltinString -> BuiltinUnit +useTwiceString s = + case BI.appendString s s of + _ -> case BI.appendString s s of + _ -> unitval diff --git a/plutus-tx-plugin/test/BuiltinCasing/Spec.hs b/plutus-tx-plugin/test/BuiltinCasing/Spec.hs index 798e207fc6c..756dc75e0ef 100644 --- a/plutus-tx-plugin/test/BuiltinCasing/Spec.hs +++ b/plutus-tx-plugin/test/BuiltinCasing/Spec.hs @@ -10,6 +10,7 @@ module BuiltinCasing.Spec where import Test.Tasty.Extras +import BuiltinCasing.Lib qualified as Lib import PlutusTx (compile) import PlutusTx.Builtins (caseInteger, caseList, casePair) import PlutusTx.Builtins.Internal (chooseUnit, unitval) @@ -30,7 +31,7 @@ integerABC :: Integer -> BuiltinString integerABC i = caseInteger i ["a", "b", "c"] head :: BuiltinList Bool -> Bool -head xs = caseList (\_ -> error ()) (\x _ -> x) xs +head = caseList (\_ -> error ()) (\x _ -> x) tests :: TestNested tests = @@ -42,4 +43,7 @@ tests = , goldenUPlcReadable "addPair" $$(compile [||addPair||]) , goldenUPlcReadable "integerABC" $$(compile [||integerABC||]) , goldenUPlcReadable "head" $$(compile [||head||]) + , goldenUPlcReadable "useTwiceData" $$(compile [||Lib.useTwiceData||]) + , goldenUPlcReadable "useTwiceByteString" $$(compile [||Lib.useTwiceByteString||]) + , goldenUPlcReadable "useTwiceString" $$(compile [||Lib.useTwiceString||]) ] diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.12/mutualRecursionUnfoldingsLocal.golden.uplc b/plutus-tx-plugin/test/Plugin/Errors/9.12/mutualRecursionUnfoldingsLocal.golden.uplc index 8e0ade0637f..aeeee0b2961 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/9.12/mutualRecursionUnfoldingsLocal.golden.uplc +++ b/plutus-tx-plugin/test/Plugin/Errors/9.12/mutualRecursionUnfoldingsLocal.golden.uplc @@ -1,2 +1,11 @@ -Error: Reference to a name which is not a local, a builtin, or an external INLINABLE function: Variable Plugin.Errors.Spec.oddDirectLocal - OtherCon [] \ No newline at end of file +Error: Unsupported feature: Variable Plugin.Errors.Spec.oddDirectLocal + OtherCon [] + + This error often indicates a stage violation in Plinth compilation. + Variables inside compile quotations must be either: + • Top-level variables, or + • Bound inside the quotation itself + + Common causes: + • Using a function defined in a 'where' clause: move it to the top level + • Referencing local variables from outside the quotation \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.12/rangeEnumFrom.golden.uplc b/plutus-tx-plugin/test/Plugin/Errors/9.12/rangeEnumFrom.golden.uplc index ccfe1880ce9..fffee266f68 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/9.12/rangeEnumFrom.golden.uplc +++ b/plutus-tx-plugin/test/Plugin/Errors/9.12/rangeEnumFrom.golden.uplc @@ -1,2 +1,2 @@ Error: Reference to a name which is not a local, a builtin, or an external INLINABLE function: Variable GHC.Num.Integer.integerAdd - No unfolding \ No newline at end of file + No unfolding diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.12/rangeEnumFromThen.golden.uplc b/plutus-tx-plugin/test/Plugin/Errors/9.12/rangeEnumFromThen.golden.uplc index ccfe1880ce9..fffee266f68 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/9.12/rangeEnumFromThen.golden.uplc +++ b/plutus-tx-plugin/test/Plugin/Errors/9.12/rangeEnumFromThen.golden.uplc @@ -1,2 +1,2 @@ Error: Reference to a name which is not a local, a builtin, or an external INLINABLE function: Variable GHC.Num.Integer.integerAdd - No unfolding \ No newline at end of file + No unfolding diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.6/mutualRecursionUnfoldingsLocal.golden.uplc b/plutus-tx-plugin/test/Plugin/Errors/9.6/mutualRecursionUnfoldingsLocal.golden.uplc index 8e0ade0637f..aeeee0b2961 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/9.6/mutualRecursionUnfoldingsLocal.golden.uplc +++ b/plutus-tx-plugin/test/Plugin/Errors/9.6/mutualRecursionUnfoldingsLocal.golden.uplc @@ -1,2 +1,11 @@ -Error: Reference to a name which is not a local, a builtin, or an external INLINABLE function: Variable Plugin.Errors.Spec.oddDirectLocal - OtherCon [] \ No newline at end of file +Error: Unsupported feature: Variable Plugin.Errors.Spec.oddDirectLocal + OtherCon [] + + This error often indicates a stage violation in Plinth compilation. + Variables inside compile quotations must be either: + • Top-level variables, or + • Bound inside the quotation itself + + Common causes: + • Using a function defined in a 'where' clause: move it to the top level + • Referencing local variables from outside the quotation \ No newline at end of file diff --git a/plutus-tx-plugin/test/StageViolation/9.12/builtinData.golden.uplc b/plutus-tx-plugin/test/StageViolation/9.12/builtinData.golden.uplc index 8f8725dda3d..9bc7309e5e0 100644 --- a/plutus-tx-plugin/test/StageViolation/9.12/builtinData.golden.uplc +++ b/plutus-tx-plugin/test/StageViolation/9.12/builtinData.golden.uplc @@ -1,4 +1,5 @@ -Error: Unsupported feature: Cannot construct a value of type: PlutusTx.Builtins.Internal.BuiltinData +Error: Unsupported feature: Variable validator + OtherCon [] This error often indicates a stage violation in Plinth compilation. Variables inside compile quotations must be either: @@ -7,6 +8,4 @@ Error: Unsupported feature: Cannot construct a value of type: PlutusTx.Builtins. Common causes: • Using a function defined in a 'where' clause: move it to the top level - • Referencing local variables from outside the quotation - - Note: GHC can generate these unexpectedly, you may need '-fno-strictness', '-fno-specialise', '-fno-spec-constr', '-fno-unbox-strict-fields', or '-fno-unbox-small-strict-fields'. \ No newline at end of file + • Referencing local variables from outside the quotation \ No newline at end of file diff --git a/plutus-tx-plugin/test/StageViolation/9.6/builtinData.golden.uplc b/plutus-tx-plugin/test/StageViolation/9.6/builtinData.golden.uplc index 8f8725dda3d..9bc7309e5e0 100644 --- a/plutus-tx-plugin/test/StageViolation/9.6/builtinData.golden.uplc +++ b/plutus-tx-plugin/test/StageViolation/9.6/builtinData.golden.uplc @@ -1,4 +1,5 @@ -Error: Unsupported feature: Cannot construct a value of type: PlutusTx.Builtins.Internal.BuiltinData +Error: Unsupported feature: Variable validator + OtherCon [] This error often indicates a stage violation in Plinth compilation. Variables inside compile quotations must be either: @@ -7,6 +8,4 @@ Error: Unsupported feature: Cannot construct a value of type: PlutusTx.Builtins. Common causes: • Using a function defined in a 'where' clause: move it to the top level - • Referencing local variables from outside the quotation - - Note: GHC can generate these unexpectedly, you may need '-fno-strictness', '-fno-specialise', '-fno-spec-constr', '-fno-unbox-strict-fields', or '-fno-unbox-small-strict-fields'. \ No newline at end of file + • Referencing local variables from outside the quotation \ No newline at end of file diff --git a/plutus-tx/changelog.d/20260416_092502_yuriy.lazaryev_fix_builtin_casing_addr_joinpoint.md b/plutus-tx/changelog.d/20260416_092502_yuriy.lazaryev_fix_builtin_casing_addr_joinpoint.md new file mode 100644 index 00000000000..d8fc5a5a243 --- /dev/null +++ b/plutus-tx/changelog.d/20260416_092502_yuriy.lazaryev_fix_builtin_casing_addr_joinpoint.md @@ -0,0 +1,6 @@ +### Fixed + +- Added second constructor to `BuiltinData` to prevent GHC's simplifier from + exposing `PlutusCore.Data.Data` in join point types, which caused the plugin + to crash with `Unsupported feature: Type constructor: GHC.Prim.Addr#` when + using `datatypes=BuiltinCasing`. diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs index 4a6993ae2e7..46e41a7e2f0 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Internal.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Internal.hs @@ -104,6 +104,17 @@ we can't handle, but also so that GHC doesn't look inside and try and get clever In particular, we need to use 'data' rather than 'newtype' even for simple wrappers, otherwise GHC gets very keen to optimize through the newtype and e.g. our users see 'Addr#' popping up everywhere. + +Additionally, single-constructor types must have a second (unreachable) constructor. +GHC's simplifier unconditionally unwraps single-constructor types via +case-of-known-constructor, which can expose the inner type (e.g. PLC.Data inside +BuiltinData) in join point type signatures. The plugin with BuiltinCasing then +tries to compile the inner type as a regular ADT, potentially reaching unsupported +primitives like Addr# (#7716). + +A second constructor prevents this — GHC cannot case-simplify multi-constructor +types. The extra constructor is never constructed; COMPLETE pragmas tell GHC +that matching on the real constructor alone is exhaustive. -} error :: BuiltinUnit -> a @@ -531,9 +542,13 @@ that you want to be representable on-chain. For off-chain usage, there are conversion functions 'builtinDataToData' and 'dataToBuiltinData', but note that these will not work on-chain. -} -data BuiltinData = BuiltinData ~PLC.Data + +-- See Note [Opaque builtin types] +data BuiltinData = BuiltinData ~PLC.Data | BuiltinDataUnreachable deriving stock (Data, Generic) +{-# COMPLETE BuiltinData #-} + instance Haskell.Show BuiltinData where show (BuiltinData d) = show d instance Haskell.Eq BuiltinData where