improve efficiency of authorityTokenPolicy

agora/Agora/AuthorityToken.hs

@@ -13,8 +13,7 @@ module Agora.AuthorityToken (
 
 import Agora.Utils (
   passert,
-  pnegativeSymbolValueOf,
+  psymbolValueOf',
-  ppositiveSymbolValueOf,
  )
 import Plutarch.Api.V1 (
   PCredential (..),
@@ -35,6 +34,7 @@ import Plutarch.Api.V2 (
  )
 import Plutarch.Extra.AssetClass (PAssetClassData, ptoScottEncoding)
 import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
+import Plutarch.Extra.Maybe (pfromJust)
 import Plutarch.Extra.ScriptContext (pisTokenSpent)
 import Plutarch.Extra.Sum (PSum (PSum))
 import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
@@ -160,10 +160,8 @@ authorityTokenPolicy =
 
       let ownSymbol = pfromData $ pfield @"_0" # ownSymbol'
 
-      applySymbolValueOf <- pletC $ plam $ \f -> f # ownSymbol # txInfo.mint
+      PPair mintedATs burntATs <-
-
+        pmatchC $ pfromJust #$ psymbolValueOf' # ownSymbol # txInfo.mint
-      mintedATs <- pletC $ applySymbolValueOf # ppositiveSymbolValueOf
-      let burntATs = applySymbolValueOf # pnegativeSymbolValueOf
 
       pure $
         popaque $

agora/Agora/Utils.hs

@@ -33,34 +33,30 @@ module Agora.Utils (
   passert,
   pisNothing,
   pisDNothing,
-  ppositiveSymbolValueOf,
+  psymbolValueOf',
-  pnegativeSymbolValueOf,
 ) where
 
 import Plutarch.Api.V1 (
   KeyGuarantees (Unsorted),
   PPOSIXTime,
   PRedeemer,
-  PTokenName,
   PValidatorHash,
  )
 import Plutarch.Api.V1.AssocMap (PMap, plookup)
 import Plutarch.Api.V2 (
   AmountGuarantees,
   PCurrencySymbol,
-  PMap (PMap),
   PMaybeData (PDNothing),
   PScriptHash,
   PScriptPurpose,
-  PValue (PValue),
+  PTokenName,
+  PValue,
  )
 import Plutarch.Extra.Applicative (PApplicative (ppure))
 import Plutarch.Extra.Category (PCategory (pidentity))
 import Plutarch.Extra.Functor (PFunctor (PSubcategory, pfmap))
-import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
+import Plutarch.Extra.Maybe (pjust, pnothing)
-import Plutarch.Extra.Maybe (pexpectJustC, pjust, pnothing)
 import Plutarch.Extra.Ord (PComparator, POrdering (PLT), pcompareBy, pequateBy)
-import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pmatchC)
 import Plutarch.Extra.Time (PCurrentTime (PCurrentTime))
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V2 (
@@ -426,67 +422,45 @@ pisDNothing = phoistAcyclic $
       PDNothing _ -> pconstant True
       _ -> pconstant False
 
-psymbolValueOfHelper ::
+{- | Get the negative and positive amount of a particular 'CurrencySymbol', and
+     return nothing if it doesn't exist in the value.
+
+     @since 1.0.0
+-}
+psymbolValueOf' ::
   forall
     (keys :: KeyGuarantees)
     (amounts :: AmountGuarantees)
     (s :: S).
   Term
     s
-    ( (PInteger :--> PBool)
+    ( PCurrencySymbol
-        :--> PCurrencySymbol
+        :--> PValue keys amounts
-        :--> ( PValue keys amounts
+        :--> PMaybe
-                :--> PInteger
+              ( PPair
-             )
+                  -- Positive amount
+                  PInteger
+                  -- Negative amount
+                  PInteger
+              )
     )
-psymbolValueOfHelper =
+psymbolValueOf' = phoistAcyclic $
-  phoistAcyclic $
+  plam $ \sym value ->
-    plam $ \cond sym value'' -> unTermCont $ do
+    let tnMap = plookup # sym # pto value
-      PValue value' <- pmatchC value''
+        f =
-      PMap value <- pmatchC value'
+          plam $
-      m' <-
+            ( pfoldr
-        pexpectJustC
+                # plam
-          0
+                  ( \x r ->
-          ( plookupAssoc
+                      let q = pfromData $ psndBuiltin # x
-              # pfstBuiltin
+                       in pmatch r $ \(PPair p n) ->
-              # psndBuiltin
+                            pif
-              # pdata sym
+                              (0 #< q)
-              # value
+                              (pcon $ PPair (p + q) n)
-          )
+                              (pcon $ PPair p (n + q))
-      PMap m <- pmatchC (pfromData m')
+                  )
-      pure $
+                # pcon (PPair 0 0)
-        pfoldr
+                #
-          # plam
-            ( \x v ->
-                plet (pfromData $ psndBuiltin # x) $ \q ->
-                  pif
-                    (cond # q)
-                    (q + v)
-                    v
             )
-          # 0
+              . pto
-          # m
+     in pfmap # f # tnMap
-
-{- | The sum of positive entries belonging to a particular currency symbol.
-
-   @since 1.0.0
--}
-ppositiveSymbolValueOf ::
-  forall
-    (keys :: KeyGuarantees)
-    (amounts :: AmountGuarantees)
-    (s :: S).
-  Term s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
-ppositiveSymbolValueOf = phoistAcyclic $ psymbolValueOfHelper #$ plam (0 #<)
-
-{- | The sum of negative entries belonging to a particular currency symbol.
-
-   @since 1.0.0
--}
-pnegativeSymbolValueOf ::
-  forall
-    (keys :: KeyGuarantees)
-    (amounts :: AmountGuarantees)
-    (s :: S).
-  Term s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
-pnegativeSymbolValueOf = phoistAcyclic $ psymbolValueOfHelper #$ plam (#< 0)