Plutonomicon · kozross · Dec 19, 2024 · Dec 19, 2024 · Dec 19, 2024 · Dec 19, 2024
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -63,6 +63,7 @@
 * `#<`, `#<=`, `#>=`, `#>` are now part of `POrd`
 * `PPositive` (and `Positive`) are now exported from the prelude, along with
   some functionality
+* `PEither`, `PPair` and `PList` use SOP encoding instead of Scott
 
 ## Removed
 

diff --git a/Plutarch/Either.hs b/Plutarch/Either.hs
@@ -25,9 +25,7 @@ module Plutarch.Either (
 
 import Data.Kind (Type)
 import GHC.Generics (Generic)
-
--- TODO: Kill this, this is for PShow (PAsData a)
-
+import Generics.SOP qualified as SOP
 import Plutarch.Builtin.Bool (
   PBool (PFalse, PTrue),
   pif,
@@ -66,12 +64,10 @@ import Plutarch.Internal.Ord (POrd (pmax, pmin, (#<), (#<=)))
 import Plutarch.Internal.Other (pto)
 import Plutarch.Internal.PLam (plam)
 import Plutarch.Internal.PlutusType (
-  DerivePlutusType (DPTStrat),
   PlutusType (PInner, pcon', pmatch'),
   pcon,
   pmatch,
  )
-import Plutarch.Internal.ScottEncoding (PlutusTypeScott)
 import Plutarch.Internal.Show (PShow)
 import Plutarch.Internal.Term (
   S,
@@ -84,19 +80,36 @@ import Plutarch.Internal.Term (
   (:-->),
  )
 import Plutarch.Internal.TryFrom (PTryFrom)
+import Plutarch.Repr.SOP (DeriveAsSOPStruct (DeriveAsSOPStruct))
 import Plutarch.Trace (ptraceInfoError)
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V3 qualified as Plutus
 
--- | Scott-encoded 'Either'.
+{- | SOP-encoded 'Either'.
+
+@since WIP
+-}
 data PEither (a :: S -> Type) (b :: S -> Type) (s :: S)
   = PLeft (Term s a)
   | PRight (Term s b)
-  deriving stock (Generic)
-  deriving anyclass (PlutusType, PEq, PShow)
+  deriving stock
+    ( -- | @since WIP
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since WIP
+      SOP.Generic
+    , -- | @since WIP
+      PEq
+    , -- | @since WIP
+      PShow
+    )
 
-instance DerivePlutusType (PEither a b) where
-  type DPTStrat _ = PlutusTypeScott
+-- | @since WIP
+deriving via
+  DeriveAsSOPStruct (PEither a b)
+  instance
+    PlutusType (PEither a b)
 
 -- | @since WIP
 instance (PLiftable a, PLiftable b) => PLiftable (PEither a b) where

diff --git a/Plutarch/List.hs b/Plutarch/List.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 -- | Scott-encoded lists and ListLike typeclass
 module Plutarch.List (
   PList (PSCons, PSNil),
@@ -16,6 +18,7 @@ module Plutarch.List (
 
 import Data.Kind (Type)
 import GHC.Generics (Generic)
+import Generics.SOP qualified as SOP
 import Plutarch.Builtin.Bool (PBool (PFalse, PTrue), pif, ptrue, (#&&))
 import Plutarch.Builtin.Integer (PInteger)
 import Plutarch.Internal.Eq (PEq ((#==)))
@@ -37,14 +40,10 @@ import Plutarch.Internal.ListLike (
 import Plutarch.Internal.Ord (POrd ((#<), (#<=)))
 import Plutarch.Internal.PLam (plam)
 import Plutarch.Internal.PlutusType (
-  DerivePlutusType (DPTStrat),
   PlutusType,
   pcon,
   pmatch,
  )
-import Plutarch.Internal.ScottEncoding (
-  PlutusTypeScott,
- )
 import Plutarch.Internal.Show (PShow (pshow'), pshowList)
 import Plutarch.Internal.Term (
   S,
@@ -58,15 +57,34 @@ import Plutarch.Internal.Term (
 import Plutarch.Internal.Trace (ptraceInfo)
 import Plutarch.Maybe (PMaybe (PJust, PNothing))
 import Plutarch.Pair (PPair (PPair))
+import Plutarch.Repr.SOP (DeriveAsSOPStruct (DeriveAsSOPStruct))
 
+{- | SOP-encoded list.
+
+@since WIP
+-}
 data PList (a :: S -> Type) (s :: S)
   = PSCons (Term s a) (Term s (PList a))
   | PSNil
-  deriving stock (Generic)
-  deriving anyclass (PlutusType)
-
+  deriving stock
+    ( -- | @since WIP
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since WIP
+      SOP.Generic
+    )
+
+-- | @since WIP
+deriving via
+  DeriveAsSOPStruct (PList a)
+  instance
+    PlutusType (PList a)
+
+{-
 instance DerivePlutusType (PList a) where
   type DPTStrat _ = PlutusTypeScott
+-}
 
 instance PShow a => PShow (PList a) where
   pshow' _ x = pshowList @PList @a # x

diff --git a/Plutarch/Pair.hs b/Plutarch/Pair.hs
@@ -1,20 +1,38 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 module Plutarch.Pair (PPair (..)) where
 
+import Data.Kind (Type)
 import GHC.Generics (Generic)
+import Generics.SOP qualified as SOP
 import Plutarch.Internal.Eq (PEq)
-import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType)
-import Plutarch.Internal.ScottEncoding (PlutusTypeScott)
+import Plutarch.Internal.PlutusType (PlutusType)
 import Plutarch.Internal.Show (PShow)
-import Plutarch.Internal.Term (PType, S, Term)
+import Plutarch.Internal.Term (S, Term)
+import Plutarch.Repr.SOP (DeriveAsSOPStruct (DeriveAsSOPStruct))
 
 {- |
   Plutus encoding of Pairs.
 
   Note: This is represented differently than 'BuiltinPair'. It is scott-encoded.
 -}
-data PPair (a :: PType) (b :: PType) (s :: S)
+data PPair (a :: S -> Type) (b :: S -> Type) (s :: S)
   = PPair (Term s a) (Term s b)
-  deriving stock (Generic)
-  deriving anyclass (PlutusType, PEq, PShow)
+  deriving stock
+    ( -- | @since WIP
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since WIP
+      SOP.Generic
+    , -- | @since WIP
+      PEq
+    , -- | @since WIP
+      PShow
+    )
 
-instance DerivePlutusType (PPair a b) where type DPTStrat _ = PlutusTypeScott
+-- | @since WIP
+deriving via
+  DeriveAsSOPStruct (PPair a b)
+  instance
+    PlutusType (PPair a b)
diff --git a/plutarch-testlib/goldens/either.bench.golden b/plutarch-testlib/goldens/either.bench.golden
@@ -1,5 +1,5 @@
-eq.true.left {"exBudgetCPU":516433,"exBudgetMemory":3001,"scriptSizeBytes":42}
-eq.true.right {"exBudgetCPU":516433,"exBudgetMemory":3001,"scriptSizeBytes":42}
-eq.false.left-right {"exBudgetCPU":400100,"exBudgetMemory":2600,"scriptSizeBytes":42}
-eq.false.left-left {"exBudgetCPU":516433,"exBudgetMemory":3001,"scriptSizeBytes":42}
-eq.false.right-right {"exBudgetCPU":516433,"exBudgetMemory":3001,"scriptSizeBytes":42}
+eq.true.left {"exBudgetCPU":356433,"exBudgetMemory":2001,"scriptSizeBytes":39}
+eq.true.right {"exBudgetCPU":356433,"exBudgetMemory":2001,"scriptSizeBytes":39}
+eq.false.left-right {"exBudgetCPU":240100,"exBudgetMemory":1600,"scriptSizeBytes":39}
+eq.false.left-left {"exBudgetCPU":356433,"exBudgetMemory":2001,"scriptSizeBytes":39}
+eq.false.right-right {"exBudgetCPU":356433,"exBudgetMemory":2001,"scriptSizeBytes":39}
diff --git a/plutarch-testlib/goldens/either.uplc.golden b/plutarch-testlib/goldens/either.uplc.golden
@@ -1,40 +1,45 @@
 eq.true.left program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (\!0 -> False))
-        (\!0 -> !2 (\!0 -> False) (\!0 -> equalsInteger !2 !1)))
-     (\!0 !0 -> !2 42)
-     (\!0 !0 -> !2 42))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), (\!0 -> False)])
+        , (\!0 -> case !2 [(\!0 -> False), (\!0 -> equalsInteger !2 !1)]) ])
+     (constr 0 [42])
+     (constr 0 [42]))
 eq.true.right program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (\!0 -> False))
-        (\!0 -> !2 (\!0 -> False) (\!0 -> equalsInteger !2 !1)))
-     (\!0 !0 -> !1 42)
-     (\!0 !0 -> !1 42))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), (\!0 -> False)])
+        , (\!0 -> case !2 [(\!0 -> False), (\!0 -> equalsInteger !2 !1)]) ])
+     (constr 1 [42])
+     (constr 1 [42]))
 eq.false.left-right program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (\!0 -> False))
-        (\!0 -> !2 (\!0 -> False) (\!0 -> equalsInteger !2 !1)))
-     (\!0 !0 -> !2 42)
-     (\!0 !0 -> !1 42))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), (\!0 -> False)])
+        , (\!0 -> case !2 [(\!0 -> False), (\!0 -> equalsInteger !2 !1)]) ])
+     (constr 0 [42])
+     (constr 1 [42]))
 eq.false.left-left program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (\!0 -> False))
-        (\!0 -> !2 (\!0 -> False) (\!0 -> equalsInteger !2 !1)))
-     (\!0 !0 -> !2 24)
-     (\!0 !0 -> !2 42))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), (\!0 -> False)])
+        , (\!0 -> case !2 [(\!0 -> False), (\!0 -> equalsInteger !2 !1)]) ])
+     (constr 0 [24])
+     (constr 0 [42]))
 eq.false.right-right program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (\!0 -> False))
-        (\!0 -> !2 (\!0 -> False) (\!0 -> equalsInteger !2 !1)))
-     (\!0 !0 -> !1 24)
-     (\!0 !0 -> !1 42))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), (\!0 -> False)])
+        , (\!0 -> case !2 [(\!0 -> False), (\!0 -> equalsInteger !2 !1)]) ])
+     (constr 1 [24])
+     (constr 1 [42]))
diff --git a/plutarch-testlib/goldens/int.examples.uplc.eval.golden b/plutarch-testlib/goldens/int.examples.uplc.eval.golden
@@ -1,7 +1,9 @@
 add1 program 1.0.0 (\!0 !0 -> addInteger (addInteger !2 !1) 1)
 add1Hoisted program 1.0.0 (\!0 !0 -> addInteger (addInteger !2 !1) 1)
 example1 program 1.0.0 55
-example2 program 1.0.0 (\!0 -> !1 (\!0 -> addInteger !1 1) (\!0 -> subtractInteger !1 1))
+example2 program
+  1.0.0
+  (\!0 -> case !1 [(\!0 -> addInteger !1 1), (\!0 -> subtractInteger !1 1)])
 fib.lam program
   1.0.0
   (\!0 ->

diff --git a/plutarch-testlib/goldens/int.examples.uplc.golden b/plutarch-testlib/goldens/int.examples.uplc.golden
@@ -4,7 +4,9 @@ example1 program
   1.0.0
   ((\!0 -> addInteger (!1 12 32) (!1 5 4))
      (\!0 !0 -> addInteger (addInteger !2 !1) 1))
-example2 program 1.0.0 (\!0 -> !1 (\!0 -> addInteger !1 1) (\!0 -> subtractInteger !1 1))
+example2 program
+  1.0.0
+  (\!0 -> case !1 [(\!0 -> addInteger !1 1), (\!0 -> subtractInteger !1 1)])
 fib.lam program
   1.0.0
   ((\!0 ->

diff --git a/plutarch-testlib/goldens/list.bench.golden b/plutarch-testlib/goldens/list.bench.golden
@@ -1,23 +1,23 @@
-pmatch {"exBudgetCPU":1026515,"exBudgetMemory":420,"scriptSizeBytes":63}
-phead {"exBudgetCPU":9275497,"exBudgetMemory":39293,"scriptSizeBytes":79}
-ptail {"exBudgetCPU":25287859,"exBudgetMemory":115806,"scriptSizeBytes":142}
-pnull.empty {"exBudgetCPU":677094,"exBudgetMemory":3532,"scriptSizeBytes":64}
-pnull.nonempty {"exBudgetCPU":9395213,"exBudgetMemory":39893,"scriptSizeBytes":84}
-pconcat.identity {"exBudgetCPU":59152045,"exBudgetMemory":279509,"scriptSizeBytes":188}
-pmap.eg {"exBudgetCPU":34086128,"exBudgetMemory":161924,"scriptSizeBytes":163}
-pmap.identity {"exBudgetCPU":928100,"exBudgetMemory":5900,"scriptSizeBytes":97}
-pfilter.evens {"exBudgetCPU":28410223,"exBudgetMemory":129344,"scriptSizeBytes":175}
-pfilter.gt5 {"exBudgetCPU":26380493,"exBudgetMemory":125334,"scriptSizeBytes":170}
-pzipWith.double {"exBudgetCPU":44141192,"exBudgetMemory":206316,"scriptSizeBytes":174}
-pfoldl.nonempty {"exBudgetCPU":15423577,"exBudgetMemory":71413,"scriptSizeBytes":96}
-pfoldl.nonempty-primed {"exBudgetCPU":15423577,"exBudgetMemory":71413,"scriptSizeBytes":96}
-pfoldl.empty {"exBudgetCPU":1033427,"exBudgetMemory":5433,"scriptSizeBytes":85}
-pfoldl.empty-primed {"exBudgetCPU":1033427,"exBudgetMemory":5433,"scriptSizeBytes":85}
-elemAt.elemAt_3_[1..10] {"exBudgetCPU":12945655,"exBudgetMemory":56708,"scriptSizeBytes":157}
-elemAt.elemAt_0_[1..10] {"exBudgetCPU":10192885,"exBudgetMemory":43796,"scriptSizeBytes":157}
-elemAt.elemAt_9_[1..10] {"exBudgetCPU":18451195,"exBudgetMemory":82532,"scriptSizeBytes":157}
-find.find_(==3)_[1..4] {"exBudgetCPU":6365468,"exBudgetMemory":29622,"scriptSizeBytes":100}
-find.find_(==5)_[1..4] {"exBudgetCPU":7549850,"exBudgetMemory":36224,"scriptSizeBytes":100}
+pmatch {"exBudgetCPU":1026515,"exBudgetMemory":420,"scriptSizeBytes":60}
+phead {"exBudgetCPU":9467497,"exBudgetMemory":40493,"scriptSizeBytes":76}
+ptail {"exBudgetCPU":23271859,"exBudgetMemory":103206,"scriptSizeBytes":137}
+pnull.empty {"exBudgetCPU":581094,"exBudgetMemory":2932,"scriptSizeBytes":60}
+pnull.nonempty {"exBudgetCPU":9587213,"exBudgetMemory":41093,"scriptSizeBytes":80}
+pconcat.identity {"exBudgetCPU":53680045,"exBudgetMemory":245309,"scriptSizeBytes":179}
+pmap.eg {"exBudgetCPU":30918128,"exBudgetMemory":142124,"scriptSizeBytes":156}
+pmap.identity {"exBudgetCPU":640100,"exBudgetMemory":4100,"scriptSizeBytes":89}
+pfilter.evens {"exBudgetCPU":26202223,"exBudgetMemory":115544,"scriptSizeBytes":168}
+pfilter.gt5 {"exBudgetCPU":24172493,"exBudgetMemory":111534,"scriptSizeBytes":163}
+pzipWith.double {"exBudgetCPU":40013192,"exBudgetMemory":180516,"scriptSizeBytes":165}
+pfoldl.nonempty {"exBudgetCPU":14367577,"exBudgetMemory":64813,"scriptSizeBytes":93}
+pfoldl.nonempty-primed {"exBudgetCPU":14367577,"exBudgetMemory":64813,"scriptSizeBytes":93}
+pfoldl.empty {"exBudgetCPU":937427,"exBudgetMemory":4833,"scriptSizeBytes":81}
+pfoldl.empty-primed {"exBudgetCPU":937427,"exBudgetMemory":4833,"scriptSizeBytes":81}
+elemAt.elemAt_3_[1..10] {"exBudgetCPU":12753655,"exBudgetMemory":55508,"scriptSizeBytes":153}
+elemAt.elemAt_0_[1..10] {"exBudgetCPU":10384885,"exBudgetMemory":44996,"scriptSizeBytes":153}
+elemAt.elemAt_9_[1..10] {"exBudgetCPU":17491195,"exBudgetMemory":76532,"scriptSizeBytes":153}
+find.find_(==3)_[1..4] {"exBudgetCPU":6109468,"exBudgetMemory":28022,"scriptSizeBytes":96}
+find.find_(==5)_[1..4] {"exBudgetCPU":7069850,"exBudgetMemory":33224,"scriptSizeBytes":96}
 x1+x2.builtin {"exBudgetCPU":653271,"exBudgetMemory":2098,"scriptSizeBytes":29}
 x1+x2.pmatch {"exBudgetCPU":1303259,"exBudgetMemory":4562,"scriptSizeBytes":48}
 uncons.ChooseList {"exBudgetCPU":486757,"exBudgetMemory":1864,"scriptSizeBytes":26}