design doc and more refactoring

src/plutarch-onchain-lib/lib/Plutarch/Core/Eval.hs

@@ -18,6 +18,7 @@ module Plutarch.Core.Eval(
   writePlutusScriptTraceBind,
   writePlutusScriptTrace,
   writePlutusScriptNoTrace,
+  calcBudgetNoTraces,
   ) where
 
 import qualified Cardano.Binary              as CBOR
@@ -61,6 +62,15 @@ evalWithArgsT cfg x args = do
   scr <- first (pack . show) escr
   pure (scr, budg, trc)
 
+calcBudgetNoTraces :: ClosedTerm a -> [Data] -> ExBudget
+calcBudgetNoTraces x args =
+  let cmp = compile NoTracing x
+  in  case cmp of 
+        Left e -> error $ "Failed to compile term: " <> show e
+        Right scr -> 
+          let (_, budg, _) = evalScript $ applyArguments scr args
+          in budg 
+
 writePlutusScript :: Config -> String -> FilePath -> ClosedTerm a -> IO ()
 writePlutusScript cfg title filepath term = do
   case evalT cfg term of

src/plutarch-onchain-lib/lib/Plutarch/Core/Time.hs

@@ -62,4 +62,14 @@ ptoCustomFiniteRangeH timeRange = do
   PFinite ((pfield @"_0" #) -> start) <- pmatchC (pfield @"_0" # lb)
   PUpperBound ub <- pmatchC timeRangeF.to
   PFinite ((pfield @"_0" #) -> end) <- pmatchC (pfield @"_0" # ub)
-  pure (pnonew $ pfromData start, pnonew $ pfromData end)
+  pure (pnonew $ pfromData start, pnonew $ pfromData end)
+
+pisFinite :: Term s (PInterval PPosixTime :--> PBool)
+pisFinite = plam $ \i ->
+  let isFiniteFrom = pmatch (pfield @"_0" # (pfield @"from" # i)) $ \case
+        PFinite _ -> pconstant True
+        _ -> pconstant False
+      isFiniteTo = pmatch (pfield @"_0" # (pfield @"to" # i)) $ \case
+        PFinite _ -> pconstant True
+        _ -> pconstant False
+   in pand' # isFiniteFrom # isFiniteTo

src/plutarch-onchain-lib/lib/Plutarch/Core/Unroll.hs

@@ -0,0 +1,53 @@
+{- |
+Unrolling a recursive function involves explicitly laying out some or all of the recursive steps, rather than relying on recursion via a fixed-point combinator.
+In UPLC, the typical `pfix` implementation uses a Y-combinator under the hood. Each recursive step incurs additional evaluation costs (CPU and memory) due to
+the execution of the Y-combinator. By eliminating these costs in each recursive step, unrolled functions reduce execution overhead. However, since each recursive
+step is explicitly laid out, unrolled functions consume more script size.
+
+There are various unrolling strategies available. It is important to carefully study the implications of each strategy, as they may impose different requirements,
+such as hard limit on recursion depth.
+-}
+module Plutarch.Core.Unroll (punrollBound, punrollUnbound, punrollUnboundWhole) where
+
+import Plutarch.Internal.Fix (pfix)
+import Plutarch.Internal.PLam (plam)
+import Plutarch.Internal.Term (Term, (#$), (:-->))
+
+{- |
+The first argument specifies the unrolling depth.
+The second argument defines the fallback behavior when the recursion depth exceeds the provided unrolling depth.
+
+The fixed-point implementation provided requires a Haskell-level value @c@ and a Plutarch function of type `Term s (a :--> b)`. The functional for the recursion is passed as a Haskell function.
+The inclusion of the additional, arbitrary Haskell value (typed @c@) enables further optimization by allowing pre-computation of constant values that depend only on the recursion depth.
+
+@since WIP
+-}
+punrollBound ::
+  forall a b c s.
+  Integer ->
+  (c -> Term s (a :--> b)) ->
+  ((c -> Term s (a :--> b)) -> c -> Term s (a :--> b)) ->
+  c ->
+  Term s (a :--> b)
+punrollBound 0 def _ c = def c
+punrollBound d def f c = f (punrollBound (d - 1) def f) c
+
+{- |
+Unroll given amount of steps, and for rest, uses `pfix` to support unbound recursion.
+
+@since WIP
+-}
+punrollUnbound :: forall a b s. Integer -> (Term s (a :--> b) -> Term s (a :--> b)) -> Term s (a :--> b)
+punrollUnbound 0 f = pfix #$ plam f
+punrollUnbound d f = f (punrollUnbound (d - 1) f)
+
+{- |
+Uses `pfix` to recurse unrolled function itself. Unlike @punrollUnbound@, this function uses unrolled instructions
+within `pfix` recursions.
+
+This should perform better than @punrollUnbound@ when a function requires a large recursion depth.
+
+@since WIP
+-}
+punrollUnboundWhole :: forall a b s. Integer -> (Term s (a :--> b) -> Term s (a :--> b)) -> Term s (a :--> b)
+punrollUnboundWhole d f = pfix #$ plam $ \r -> punrollBound d (const r) (\g () -> f (g ())) ()

src/plutarch-onchain-lib/lib/Plutarch/Core/Utils.hs

@@ -26,7 +26,6 @@ module Plutarch.Core.Utils(
   ppair,
   passert,
   pcheck,
-  pcountScriptInputs,
   pfoldl2,
   pelemAtWithRest',
   pmapIdxs,
@@ -45,19 +44,12 @@ module Plutarch.Core.Utils(
   ptxSignedByPkh,
   (#-),
   pfindWithRest,
-  pcountCS,
-  pcountNonAdaCS,
-  pfirstTokenName,
-  ptryLookupValue,
-  pfilterCSFromValue,
   phasUTxO,
-  pvalueContains,
   pand'List,
   pcond,
   (#>=),
   (#>),
   (#/=),
-  pisFinite,
   pmapAndConvertList,
   pintToByteString,
   punwrapPosixTime,
@@ -73,36 +65,27 @@ module Plutarch.Core.Utils(
 import qualified Data.Text                        as T
 import           Plutarch.Prelude                 
 
-import qualified Plutarch.LedgerApi.AssocMap      as AssocMap
 import Plutarch.LedgerApi.V3
     ( KeyGuarantees(Sorted),
-      PMap(..),
-      PExtended(PFinite),
-      PInterval,
       PMaybeData,
       PAddress,
       PCredential(..),
       PPubKeyHash,
       PDatum,
-      PRedeemer,
       PScriptHash,
       PPosixTime(..),
       POutputDatum(POutputDatum),
       PTxOut,
       PScriptInfo,
-      PScriptPurpose,
       PTxInInfo,
       PTxOutRef,
       AmountGuarantees(Positive),
-      PCurrencySymbol,
-      PTokenName,
       PValue(..) )            
-import           Plutarch.LedgerApi.Value         (padaSymbol,
-                                                   pvalueOf)
 import qualified Plutarch.Monadic                 as P
 
 import           Prelude
 import           Plutarch.Internal.Term ( PType ) 
+import Plutarch.Core.Value (pvalueContains)
 
 pfail ::
   forall (s :: S) a.
@@ -194,21 +177,6 @@ passert longErrorMsg b inp = pif b inp $ ptraceInfoError (pconstant longErrorMsg
 pcheck :: forall (s :: S) (a :: PType). Term s PBool -> Term s a -> Term s (PMaybe a)
 pcheck b inp = pif b (pcon $ PJust inp) (pcon PNothing)
 
-pcountScriptInputs :: Term s (PBuiltinList PTxInInfo :--> PInteger)
-pcountScriptInputs =
-  phoistAcyclic $
-    let go :: Term s (PInteger :--> PBuiltinList PTxInInfo :--> PInteger)
-        go = pfix #$ plam $ \self n ->
-              pelimList
-                (\x xs ->
-                  let cred = pfield @"credential" # (pfield @"address" # (pfield @"resolved" # x))
-                   in pmatch cred $ \case
-                        PScriptCredential _ -> self # (n + 1) # xs
-                        _ -> self # n # xs
-                )
-                n
-     in go # 0
-
 pfoldl2 ::
   (PListLike listA, PListLike listB, PElemConstraint listA a, PElemConstraint listB b) =>
   Term s ((acc :--> a :--> b :--> acc) :--> acc :--> listA a :--> listB b :--> acc)
@@ -384,92 +352,6 @@ pfindWithRest = phoistAcyclic $
         mnil = const (ptraceInfoError "Find")
      in precList mcons mnil # ys # pnil
 
-pcountCS ::
-  forall
-    (keys :: KeyGuarantees)
-    (amounts :: AmountGuarantees)
-    (s :: S).
-  Term s (PValue keys amounts :--> PInteger)
-pcountCS = phoistAcyclic $
-  plam $ \val ->
-    pmatch val $ \(PValue val') ->
-      pmatch val' $ \(PMap csPairs) ->
-        plength # csPairs
-
-pcountNonAdaCS ::
-  forall
-    (keys :: KeyGuarantees)
-    (amounts :: AmountGuarantees)
-    (s :: S).
-  Term s (PValue keys amounts :--> PInteger)
-pcountNonAdaCS =
-  phoistAcyclic $
-    let go :: Term (s2 :: S) (PInteger :--> PBuiltinList (PBuiltinPair (PAsData PCurrencySymbol) (PAsData (PMap keys PTokenName PInteger))) :--> PInteger)
-        go = plet (pdata padaSymbol) $ \padaSymbolD ->
-          pfix #$ plam $ \self n ->
-            pelimList (\x xs -> pif (pfstBuiltin # x #== padaSymbolD) (self # n # xs) (self # (n + 1) # xs)) n
-     in plam $ \val ->
-          pmatch val $ \(PValue val') ->
-            pmatch val' $ \(PMap csPairs) ->
-              go # 0 # csPairs
-
-pfirstTokenName ::
-  forall
-    (keys :: KeyGuarantees)
-    (amounts :: AmountGuarantees)
-    (s :: S).
-  Term s (PValue keys amounts :--> PTokenName)
-pfirstTokenName = phoistAcyclic $
-  plam $ \val ->
-    pmatch val $ \(PValue val') ->
-      pmatch val' $ \(PMap csPairs) ->
-        pmatch (pfromData (psndBuiltin # (phead # csPairs))) $ \(PMap tokens) ->
-          pfromData $ pfstBuiltin # (phead # tokens)
-
-ptryLookupValue ::
-  forall
-    (keys :: KeyGuarantees)
-    (amounts :: AmountGuarantees)
-    (s :: S).
-  Term
-    s
-    ( PAsData PCurrencySymbol
-        :--> PValue keys amounts
-        :--> PBuiltinList (PBuiltinPair (PAsData PTokenName) (PAsData PInteger))
-    )
-ptryLookupValue = phoistAcyclic $
-  plam $ \policyId val ->
-    pmatch val $ \(PValue val') ->
-      precList
-        ( \self x xs ->
-            pif
-              (pfstBuiltin # x #== policyId)
-              ( pmatch (pfromData (psndBuiltin # x)) $ \(PMap tokens) ->
-                  tokens
-              )
-              (self # xs)
-        )
-        (const perror)
-        # pto val'
-
-{- | Removes a currency symbol from a value
--}
-pfilterCSFromValue ::
-  forall
-    (anyOrder :: KeyGuarantees)
-    (anyAmount :: AmountGuarantees).
-  ClosedTerm
-    ( PValue anyOrder anyAmount
-        :--> PAsData PCurrencySymbol
-        :--> PValue anyOrder anyAmount
-    )
-pfilterCSFromValue = phoistAcyclic $
-  plam $ \value policyId ->
-      let mapVal = pto (pto value)
-          go = pfix #$ plam $ \self ys ->
-                pelimList (\x xs -> pif (pfstBuiltin # x #== policyId) xs (pcons # x # (self # xs))) pnil ys
-       in pcon (PValue $ pcon $ PMap $ go # mapVal)
-
 {- | @phasUTxO # oref # inputs@
   ensures that in @inputs@ there is an input having @TxOutRef@ @oref@ .
 -}
@@ -483,24 +365,6 @@ phasUTxO = phoistAcyclic $
   plam $ \oref inInputs ->
     pany @PBuiltinList # plam (\input -> oref #== (pfield @"outRef" # input)) # inInputs
 
-pvalueContains ::
-  ClosedTerm
-    ( PValue 'Sorted 'Positive
-        :--> PValue 'Sorted 'Positive
-        :--> PBool
-    )
-pvalueContains = phoistAcyclic $
-  plam $ \superset subset ->
-    let forEachTN cs = plam $ \tnPair ->
-          let tn = pfromData $ pfstBuiltin # tnPair
-              amount = pfromData $ psndBuiltin # tnPair
-           in amount #<= pvalueOf # superset # cs # tn
-        forEachCS = plam $ \csPair ->
-          let cs = pfromData $ pfstBuiltin # csPair
-              tnMap = pto $ pfromData $ psndBuiltin # csPair
-           in pall # forEachTN cs # tnMap
-     in pall # forEachCS #$ pto $ pto subset
-
 pand'List :: [Term s PBool] -> Term s PBool
 pand'List ts' =
   case ts' of
@@ -515,16 +379,6 @@ pand'List ts' =
 a #/= b = pnot # (a #== b)
 infix 4 #/=
 
-pisFinite :: Term s (PInterval PPosixTime :--> PBool)
-pisFinite = plam $ \i ->
-  let isFiniteFrom = pmatch (pfield @"_0" # (pfield @"from" # i)) $ \case
-        PFinite _ -> pconstant True
-        _ -> pconstant False
-      isFiniteTo = pmatch (pfield @"_0" # (pfield @"to" # i)) $ \case
-        PFinite _ -> pconstant True
-        _ -> pconstant False
-   in pand' # isFiniteFrom # isFiniteTo
-
 pmapAndConvertList :: (PIsListLike listA a, PIsListLike listB b) => Term s ((a :--> b) :--> listA a :--> listB b)
 pmapAndConvertList = phoistAcyclic $
   plam $ \f ->