From c671ea7fbff1ebd6b8febfca97944d5b8f11af15 Mon Sep 17 00:00:00 2001
From: Hongrui Fang <chfanghr@gmail.com>
Date: Fri, 28 Oct 2022 00:35:42 +0800
Subject: [PATCH] improve efficiency of `authorityTokenPolicy`

---
 agora/Agora/AuthorityToken.hs |  10 ++--
 agora/Agora/Utils.hs          | 102 +++++++++++++---------------------
 2 files changed, 42 insertions(+), 70 deletions(-)

diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs
index cc450cb..f148ffb 100644
--- a/agora/Agora/AuthorityToken.hs
+++ b/agora/Agora/AuthorityToken.hs
@@ -13,8 +13,7 @@ module Agora.AuthorityToken (
 
 import Agora.Utils (
   passert,
-  pnegativeSymbolValueOf,
-  ppositiveSymbolValueOf,
+  psymbolValueOf',
  )
 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
-
-      mintedATs <- pletC $ applySymbolValueOf # ppositiveSymbolValueOf
-      let burntATs = applySymbolValueOf # pnegativeSymbolValueOf
+      PPair mintedATs burntATs <-
+        pmatchC $ pfromJust #$ psymbolValueOf' # ownSymbol # txInfo.mint
 
       pure $
         popaque $
diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs
index e1ae405..8288ea1 100644
--- a/agora/Agora/Utils.hs
+++ b/agora/Agora/Utils.hs
@@ -33,34 +33,30 @@ module Agora.Utils (
   passert,
   pisNothing,
   pisDNothing,
-  ppositiveSymbolValueOf,
-  pnegativeSymbolValueOf,
+  psymbolValueOf',
 ) 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 (pexpectJustC, pjust, pnothing)
+import Plutarch.Extra.Maybe (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
-        :--> ( PValue keys amounts
-                :--> PInteger
-             )
+    ( PCurrencySymbol
+        :--> PValue keys amounts
+        :--> PMaybe
+              ( PPair
+                  -- Positive amount
+                  PInteger
+                  -- Negative amount
+                  PInteger
+              )
     )
-psymbolValueOfHelper =
-  phoistAcyclic $
-    plam $ \cond sym value'' -> unTermCont $ do
-      PValue value' <- pmatchC value''
-      PMap value <- pmatchC value'
-      m' <-
-        pexpectJustC
-          0
-          ( plookupAssoc
-              # pfstBuiltin
-              # psndBuiltin
-              # pdata sym
-              # value
-          )
-      PMap m <- pmatchC (pfromData m')
-      pure $
-        pfoldr
-          # plam
-            ( \x v ->
-                plet (pfromData $ psndBuiltin # x) $ \q ->
-                  pif
-                    (cond # q)
-                    (q + v)
-                    v
+psymbolValueOf' = phoistAcyclic $
+  plam $ \sym value ->
+    let tnMap = plookup # sym # pto value
+        f =
+          plam $
+            ( pfoldr
+                # plam
+                  ( \x r ->
+                      let q = pfromData $ psndBuiltin # x
+                       in pmatch r $ \(PPair p n) ->
+                            pif
+                              (0 #< q)
+                              (pcon $ PPair (p + q) n)
+                              (pcon $ PPair p (n + q))
+                  )
+                # pcon (PPair 0 0)
+                #
             )
-          # 0
-          # m
-
-{- | 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)
+              . pto
+     in pfmap # f # tnMap