Convert PMaybe to SOP

CHANGELOG.md

@@ -40,6 +40,7 @@
 * New methods for `Data` and Scott encoding derivation
 * `optimizeTerm` for separate optimization via UPLC from compilation
 * New numerical hierarchy in `Plutarch.Internal.Numeric`, plus new instances
+* Support for SoP encoding of data
 
 ## Changed
 
@@ -63,6 +64,7 @@
 * `#<`, `#<=`, `#>=`, `#>` are now part of `POrd`
 * `PPositive` (and `Positive`) are now exported from the prelude, along with
   some functionality
+* `PMaybe` now uses SoP instead of Scott encoding
 
 ## Removed
 

Plutarch/Internal/Show.hs

@@ -90,7 +90,7 @@ import Plutarch.Internal.Term (
   (#$),
   type (:-->),
  )
-import Plutarch.Maybe (PMaybe, PMaybeSoP)
+import Plutarch.Maybe (PMaybe)
 
 import PlutusCore qualified as PLC
 
@@ -352,6 +352,3 @@ instance PShow PPositive
 
 -- | @since WIP
 instance PShow a => PShow (PMaybe a)
-
--- | @since WIP
-instance PShow a => PShow (PMaybeSoP a)

Plutarch/Maybe.hs

@@ -3,7 +3,6 @@
 module Plutarch.Maybe (
   -- * Type
   PMaybe (..),
-  PMaybeSoP (..),
 
   -- * Functions
 
@@ -21,11 +20,6 @@ module Plutarch.Maybe (
   pmaybe,
   passertPJust,
   pmapMaybe,
-  pmapMaybeSoP,
-
-  -- ** Conversions
-  pmaybeToMaybeSoP,
-  pmaybeSoPToMaybe,
 ) where
 
 import Data.Kind (Type)
@@ -52,12 +46,10 @@ import Plutarch.Internal.Lift (
  )
 import Plutarch.Internal.PLam (plam)
 import Plutarch.Internal.PlutusType (
-  DerivePlutusType (DPTStrat),
   PlutusType,
   pcon,
   pmatch,
  )
-import Plutarch.Internal.ScottEncoding (PlutusTypeScott)
 import Plutarch.Internal.Term (
   S,
   Term,
@@ -68,14 +60,23 @@ import Plutarch.Internal.Term (
  )
 import Plutarch.Repr.SOP (DeriveAsSOPStruct (DeriveAsSOPStruct))
 
--- | Plutus Maybe type, with Scott-encoded repr
+-- | @since WIP
 data PMaybe (a :: S -> Type) (s :: S)
   = PJust (Term s a)
   | PNothing
-  deriving stock (Generic)
-  deriving anyclass (PlutusType, PEq)
+  deriving stock
+    ( -- | @since WIP
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since WIP
+      SOP.Generic
+    , -- | @since WIP
+      PEq
+    )
 
-instance DerivePlutusType (PMaybe a) where type DPTStrat _ = PlutusTypeScott
+-- | @since WIP
+deriving via DeriveAsSOPStruct (PMaybe a) instance PlutusType (PMaybe a)
 
 -- | @since WIP
 instance PLiftable a => PLiftable (PMaybe a) where
@@ -201,53 +202,3 @@ pmapMaybe = phoistAcyclic $
   plam $ \f mv -> pmatch mv $ \case
     PJust v -> pjust # (f # v)
     PNothing -> pnothing
-
--- | @since WIP
-data PMaybeSoP (a :: S -> Type) (s :: S)
-  = PJustSoP (Term s a)
-  | PNothingSoP
-  deriving stock (Generic)
-  deriving anyclass (SOP.Generic, PEq)
-
--- | @since WIP
-deriving via DeriveAsSOPStruct (PMaybeSoP a) instance PlutusType (PMaybeSoP a)
-
--- | @since WIP
-instance PLiftable a => PLiftable (PMaybeSoP a) where
-  type AsHaskell (PMaybeSoP a) = Maybe (AsHaskell a)
-  type PlutusRepr (PMaybeSoP a) = PLiftedClosed (PMaybeSoP a)
-
-  {-# INLINEABLE toPlutarchRepr #-}
-  toPlutarchRepr = toPlutarchReprClosed
-
-  {-# INLINEABLE toPlutarch #-}
-  toPlutarch (Just a) = mkPLifted $ pcon $ PJustSoP $ pconstant @a a
-  toPlutarch Nothing = mkPLifted $ pcon PNothingSoP
-
-  {-# INLINEABLE fromPlutarchRepr #-}
-  fromPlutarchRepr = fromPlutarchReprClosed
-
-  {-# INLINEABLE fromPlutarch #-}
-  fromPlutarch t = do
-    isJust' <- fromPlutarch $ mkPLifted $ pisJust # (pmaybeSoPToMaybe # getPLifted t)
-    if isJust'
-      then fmap Just $ fromPlutarch $ mkPLifted $ pfromJust # (pmaybeSoPToMaybe # getPLifted t)
-      else Right Nothing
-
--- | @since WIP
-pmaybeToMaybeSoP :: Term s (PMaybe a :--> PMaybeSoP a)
-pmaybeToMaybeSoP = phoistAcyclic $ plam $ flip pmatch $ \case
-  PJust a -> pcon $ PJustSoP a
-  PNothing -> pcon PNothingSoP
-
--- | @since WIP
-pmaybeSoPToMaybe :: Term s (PMaybeSoP a :--> PMaybe a)
-pmaybeSoPToMaybe = phoistAcyclic $ plam $ flip pmatch $ \case
-  PJustSoP a -> pcon $ PJust a
-  PNothingSoP -> pcon PNothing
-
--- @since WIP
-pmapMaybeSoP :: Term s ((a :--> b) :--> PMaybeSoP a :--> PMaybeSoP b)
-pmapMaybeSoP = phoistAcyclic $ plam $ \f -> flip pmatch $ \case
-  PJustSoP v -> pcon $ PJustSoP (f # v)
-  PNothingSoP -> pcon PNothingSoP

plutarch-testlib/bench/Bench.hs

@@ -1,7 +1,7 @@
 module Main (main) where
 
 import Plutarch.LedgerApi.Utils (PMaybeData, pmapMaybeData, pmaybeDataToMaybe, pmaybeToMaybeData)
-import Plutarch.Maybe (PMaybeSoP, pmapMaybe, pmapMaybeSoP)
+import Plutarch.Maybe (pmapMaybe)
 import Plutarch.Prelude
 import Plutarch.Test.Bench (BenchConfig (Optimizing), bcompare, bench, benchWithConfig, defaultMain)
 import Test.Tasty (TestTree, testGroup)
@@ -44,8 +44,6 @@ maybeBenches =
           (pmapMaybeData # plam (\v -> pdata (peven # pfromData v)) # pconstant @(PMaybeData PInteger) (Just 42))
       , bcompare "$(NF-1) == \"fmap even\" && $NF == \"PMaybeData\"" $
           bench "PMaybe vs PMaybeData" (pmapMaybe # peven # pconstant @(PMaybe PInteger) (Just 42))
-      , bcompare "$(NF-1) == \"fmap even\" && $NF == \"PMaybeData\"" $
-          bench "PMaybeSop vs PMaybeData" (pmapMaybeSoP # peven # pconstant @(PMaybeSoP PInteger) (Just 42))
       ]
   , -- We run both cheap and expensive calculation in 'pmap*' to mitigate impact of PAsData encoding/decoding
     let
@@ -58,8 +56,6 @@ maybeBenches =
             (pmapMaybeData # plam (\v -> pdata (pfib # pfromData v)) # pconstant @(PMaybeData PInteger) (Just n))
         , bcompare "$(NF-1) == \"fmap fib\" && $NF == \"PMaybeData\"" $
             bench "PMaybe vs PMaybeData" (pmapMaybe # pfib # pconstant @(PMaybe PInteger) (Just n))
-        , bcompare "$(NF-1) == \"fmap fib\" && $NF == \"PMaybeData\"" $
-            bench "PMaybeSop vs PMaybeData" (pmapMaybeSoP # pfib # pconstant @(PMaybeSoP PInteger) (Just n))
         ]
   ]
 

plutarch-testlib/goldens/list.bench.golden

@@ -16,8 +16,8 @@ pfoldl.empty-primed {"exBudgetCPU":1033427,"exBudgetMemory":5433,"scriptSizeByte
 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}
+find.find_(==3)_[1..4] {"exBudgetCPU":6381468,"exBudgetMemory":29722,"scriptSizeBytes":97}
+find.find_(==5)_[1..4] {"exBudgetCPU":7549850,"exBudgetMemory":36224,"scriptSizeBytes":97}
 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}

plutarch-testlib/goldens/list.uplc.eval.golden

@@ -16,8 +16,8 @@ pfoldl.empty-primed program 1.0.0 True
 elemAt.elemAt_3_[1..10] program 1.0.0 4
 elemAt.elemAt_0_[1..10] program 1.0.0 1
 elemAt.elemAt_9_[1..10] program 1.0.0 10
-find.find_(==3)_[1..4] program 1.0.0 (\!0 !0 -> !2 3)
-find.find_(==5)_[1..4] program 1.0.0 (\!0 !0 -> force !1)
+find.find_(==3)_[1..4] program 1.0.0 (constr 0 [3])
+find.find_(==5)_[1..4] program 1.0.0 (constr 1 [])
 x1+x2.builtin program 1.0.0 3
 x1+x2.pmatch program 1.0.0 3
 uncons.ChooseList program 1.0.0 [2,3,4,5]

plutarch-testlib/goldens/list.uplc.golden

@@ -583,9 +583,9 @@ find.find_(==3)_[1..4] program
                 force
                   (force ifThenElse
                      (!4 !2)
-                     (delay (\!0 !0 -> !2 !4))
+                     (delay (constr 0 [!2]))
                      (delay (!5 !4 !1))))
-             (delay (\!0 !0 -> force !1)))
+             (delay (constr 1 [])))
         (\!0 -> equalsInteger !1 3)
         (!1
            (\!0 !0 ->
@@ -609,9 +609,9 @@ find.find_(==5)_[1..4] program
                 force
                   (force ifThenElse
                      (!4 !2)
-                     (delay (\!0 !0 -> !2 !4))
+                     (delay (constr 0 [!2]))
                      (delay (!5 !4 !1))))
-             (delay (\!0 !0 -> force !1)))
+             (delay (constr 1 [])))
         (\!0 -> equalsInteger !1 5)
         (!1
            (\!0 !0 ->

plutarch-testlib/goldens/maybe.bench.golden

@@ -1,4 +1,4 @@
-eq.true.nothing {"exBudgetCPU":368100,"exBudgetMemory":2400,"scriptSizeBytes":34}
-eq.true.just {"exBudgetCPU":516433,"exBudgetMemory":3001,"scriptSizeBytes":38}
-eq.false.nothing-just {"exBudgetCPU":384100,"exBudgetMemory":2500,"scriptSizeBytes":36}
-eq.false.just-just {"exBudgetCPU":516433,"exBudgetMemory":3001,"scriptSizeBytes":38}
+eq.true.nothing {"exBudgetCPU":176100,"exBudgetMemory":1200,"scriptSizeBytes":29}
+eq.true.just {"exBudgetCPU":356433,"exBudgetMemory":2001,"scriptSizeBytes":34}
+eq.false.nothing-just {"exBudgetCPU":208100,"exBudgetMemory":1400,"scriptSizeBytes":31}
+eq.false.just-just {"exBudgetCPU":356433,"exBudgetMemory":2001,"scriptSizeBytes":34}

plutarch-testlib/goldens/maybe.uplc.golden

@@ -1,32 +1,36 @@
 eq.true.nothing program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (delay False))
-        (delay (!1 (\!0 -> False) (delay True))))
-     (\!0 !0 -> force !1)
-     (\!0 !0 -> force !1))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), False])
+        , (case !1 [(\!0 -> False), True]) ])
+     (constr 1 [])
+     (constr 1 []))
 eq.true.just program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (delay False))
-        (delay (!1 (\!0 -> False) (delay True))))
-     (\!0 !0 -> !2 42)
-     (\!0 !0 -> !2 42))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), False])
+        , (case !1 [(\!0 -> False), True]) ])
+     (constr 0 [42])
+     (constr 0 [42]))
 eq.false.nothing-just program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (delay False))
-        (delay (!1 (\!0 -> False) (delay True))))
-     (\!0 !0 -> force !1)
-     (\!0 !0 -> !2 42))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), False])
+        , (case !1 [(\!0 -> False), True]) ])
+     (constr 1 [])
+     (constr 0 [42]))
 eq.false.just-just program
   1.0.0
   ((\!0 !0 ->
-      !2
-        (\!0 -> !2 (\!0 -> equalsInteger !2 !1) (delay False))
-        (delay (!1 (\!0 -> False) (delay True))))
-     (\!0 !0 -> !2 24)
-     (\!0 !0 -> !2 42))
+      case
+        !2
+        [ (\!0 -> case !2 [(\!0 -> equalsInteger !2 !1), False])
+        , (case !1 [(\!0 -> False), True]) ])
+     (constr 0 [24])
+     (constr 0 [42]))

plutarch-testlib/goldens/show.bench.golden

@@ -22,10 +22,10 @@ str.quoted {"exBudgetCPU":18057049,"exBudgetMemory":72910,"scriptSizeBytes":138}
 str.slash {"exBudgetCPU":14134535,"exBudgetMemory":57643,"scriptSizeBytes":136}
 str.unicode {"exBudgetCPU":19470845,"exBudgetMemory":79932,"scriptSizeBytes":139}
 str.unicode-quoted {"exBudgetCPU":23649227,"exBudgetMemory":95604,"scriptSizeBytes":141}
-maybe.nothing {"exBudgetCPU":880100,"exBudgetMemory":5600,"scriptSizeBytes":340}
-maybe.just {"exBudgetCPU":8954174,"exBudgetMemory":34272,"scriptSizeBytes":342}
+maybe.nothing {"exBudgetCPU":784100,"exBudgetMemory":5000,"scriptSizeBytes":339}
+maybe.just {"exBudgetCPU":8874174,"exBudgetMemory":33772,"scriptSizeBytes":341}
 either.right {"exBudgetCPU":9062131,"exBudgetMemory":34573,"scriptSizeBytes":356}
-maybe.either {"exBudgetCPU":12308196,"exBudgetMemory":38034,"scriptSizeBytes":419}
+maybe.either {"exBudgetCPU":12228196,"exBudgetMemory":37534,"scriptSizeBytes":417}
 list.nil {"exBudgetCPU":2202965,"exBudgetMemory":11943,"scriptSizeBytes":395}
 list.1 {"exBudgetCPU":6059760,"exBudgetMemory":26860,"scriptSizeBytes":396}
 list.1,2,3 {"exBudgetCPU":17441292,"exBudgetMemory":66744,"scriptSizeBytes":399}