wip

plutus-benchmark/marlowe/test/Spec.hs

@@ -46,13 +46,13 @@ main = do
       allTests =
         testGroup "plutus-benchmark Marlowe tests"
             [ testGroupGhcIn ["semantics"] $
-                goldenSize "semantics" marloweValidator
+                goldenASTSize "semantics" marloweValidator
                   : [ goldenUEvalBudget name [value]
                     | bench <- semanticsMBench
                     , let (name, value) = mkBudgetTest marloweValidator bench
                     ]
             , testGroupGhcIn ["role-payout"] $
-                goldenSize "role-payout" rolePayoutValidator
+                goldenASTSize "role-payout" rolePayoutValidator
                   : [ goldenUEvalBudget name [value]
                     | bench <- rolePayoutMBench
                     , let (name, value) = mkBudgetTest rolePayoutValidator bench

plutus-benchmark/nofib/test/Spec.hs

@@ -49,7 +49,7 @@ testClausify = testGroup "clausify"
                , testCase "formula5" $ mkClausifyTest Clausify.F5
                , testGroupGhc
                      [ Tx.goldenPirReadable "clausify-F5" formula5example
-                     , Tx.goldenSize "clausify-F5" formula5example
+                     , Tx.goldenASTSize "clausify-F5" formula5example
                      , Tx.goldenBudget "clausify-F5" formula5example
                      , Tx.goldenEvalCekCatch "clausify-F5" [formula5example]
                      ]
@@ -72,7 +72,7 @@ testKnights = testGroup "knights"  -- Odd sizes call "error" because there are n
               , testCase "depth 100, 8x8" $ mkKnightsTest 100 8
               , testGroupGhc
                     [ Tx.goldenPirReadable "knights10-4x4" knightsExample
-                    , Tx.goldenSize "knights10-4x4" knightsExample
+                    , Tx.goldenASTSize "knights10-4x4" knightsExample
                     , Tx.goldenBudget "knights10-4x4" knightsExample
                     , Tx.goldenEvalCekCatch "knights10-4x4" [knightsExample]
                     ]
@@ -95,7 +95,7 @@ testQueens = testGroup "queens"
                , testCase "Fc"    $ mkQueensTest 4 Queens.Fc
                , testGroupGhc
                      [ Tx.goldenPirReadable "queens4-bt" queens4btExample
-                     , Tx.goldenSize "queens4-bt" queens4btExample
+                     , Tx.goldenASTSize "queens4-bt" queens4btExample
                      , Tx.goldenBudget "queens4-bt" queens4btExample
                      , Tx.goldenEvalCekCatch "queens4-bt" [queens4btExample]
                      ]
@@ -108,7 +108,7 @@ testQueens = testGroup "queens"
                , testCase "Fc"    $ mkQueensTest 5 Queens.Fc
                , testGroupGhc
                      [ Tx.goldenPirReadable "queens5-fc" queens5fcExample
-                     , Tx.goldenSize "queens5-fc" queens5fcExample
+                     , Tx.goldenASTSize "queens5-fc" queens5fcExample
                      , Tx.goldenBudget "queens5-fc" queens5fcExample
                      , Tx.goldenEvalCekCatch "queens5-fc" [queens5fcExample]
                      ]

plutus-benchmark/script-contexts/test/Spec.hs

@@ -43,7 +43,7 @@ testCheckSc1 = testGroup "checkScriptContext1"
         compiledCodeToTerm $ mkCheckScriptContext1Code (mkScriptContext 4)
     , testCase "fails on 5" . assertFailed $
         compiledCodeToTerm $ mkCheckScriptContext1Code (mkScriptContext 5)
-    , testGroupGhc [ Tx.goldenSize "checkScriptContext1" $
+    , testGroupGhc [ Tx.goldenASTSize "checkScriptContext1" $
                         mkCheckScriptContext1Code (mkScriptContext 1)
                    , Tx.goldenPirReadable "checkScriptContext1" $
                         mkCheckScriptContext1Code (mkScriptContext 1)
@@ -64,7 +64,7 @@ testCheckSc2 = testGroup "checkScriptContext2"
           compiledCodeToTerm $ mkCheckScriptContext2Code (mkScriptContext 4)
     , testCase "succeed on 5" . assertSucceeded $
           compiledCodeToTerm $ mkCheckScriptContext2Code (mkScriptContext 5)
-    , testGroupGhc [ Tx.goldenSize "checkScriptContext2" $
+    , testGroupGhc [ Tx.goldenASTSize "checkScriptContext2" $
                         mkCheckScriptContext2Code (mkScriptContext 1)
                    , Tx.goldenPirReadable "checkScriptContext2" $
                         mkCheckScriptContext2Code (mkScriptContext 1)

plutus-core/executables/pir/Main.hs

@@ -219,11 +219,11 @@ runOptimisations (PirOptimiseOptions inp ifmt outp ofmt mode) = do
 ---------------- Analysis ----------------
 
 -- | a csv-outputtable record row of {name,unique,size}
-data RetentionRecord = RetentionRecord { name :: T.Text, unique :: Int, size :: PIR.Size}
+data RetentionRecord = RetentionRecord { name :: T.Text, unique :: Int, size :: PIR.ASTSize}
     deriving stock (Generic, Show)
     deriving anyclass Csv.ToNamedRecord
     deriving anyclass Csv.DefaultOrdered
-deriving newtype instance Csv.ToField PIR.Size
+deriving newtype instance Csv.ToField PIR.ASTSize
 
 loadPirAndAnalyse :: AnalyseOptions -> IO ()
 loadPirAndAnalyse (AnalyseOptions inp ifmt outp) = do

plutus-core/executables/src/PlutusCore/Executable/Common.hs

@@ -167,7 +167,7 @@ printBudgetStateTally term model (Cek.CekExTally costs) = do
     putStrLn ""
     putStrLn $ "startup    " ++ (budgetToString $ getSpent Cek.BStartup)
     putStrLn $ "compute    " ++ budgetToString totalComputeCost
-    putStrLn $ "AST nodes  " ++ printf "%15d" (UPLC.unSize $ UPLC.termSize term)
+    putStrLn $ "AST nodes  " ++ printf "%15d" (UPLC.unASTSize $ UPLC.termASTSize term)
     putStrLn ""
     case model of
         Default ->

plutus-core/plutus-core.cabal

@@ -159,7 +159,7 @@ library
     PlutusCore.Rename
     PlutusCore.Rename.Internal
     PlutusCore.Rename.Monad
-    PlutusCore.Size
+    PlutusCore.ASTSize
     PlutusCore.StdLib.Data.Bool
     PlutusCore.StdLib.Data.ChurchNat
     PlutusCore.StdLib.Data.Data
@@ -260,7 +260,7 @@ library
     UntypedPlutusCore.Rename.Internal
     UntypedPlutusCore.Simplify
     UntypedPlutusCore.Simplify.Opts
-    UntypedPlutusCore.Size
+    UntypedPlutusCore.ASTSize
     UntypedPlutusCore.Subst
     UntypedPlutusCore.Transform.CaseReduce
     UntypedPlutusCore.Transform.Cse
@@ -551,8 +551,8 @@ library plutus-ir
 
   other-modules:
     PlutusIR.Analysis.Definitions
-    PlutusIR.Analysis.Size
     PlutusIR.Analysis.Usages
+    PlutusIR.ASTSize
     PlutusIR.Compiler.Error
     PlutusIR.Compiler.Lower
     PlutusIR.Compiler.Recursion

plutus-core/plutus-core/src/PlutusCore.hs

@@ -119,11 +119,10 @@ module PlutusCore
     -- * Combining programs
     , applyProgram
     -- * Benchmarking
-    , termSize
-    , typeSize
-    , kindSize
-    , programSize
-    , serialisedSize
+    , termASTSize
+    , typeASTSize
+    , kindASTSize
+    , programASTSize
     ) where
 
 
@@ -142,7 +141,7 @@ import PlutusCore.Normalize
 import PlutusCore.Parser
 import PlutusCore.Quote
 import PlutusCore.Rename
-import PlutusCore.Size
+import PlutusCore.ASTSize
 import PlutusCore.Subst
 import PlutusCore.TypeCheck as TypeCheck
 

plutus-core/plutus-core/src/PlutusCore/ASTSize.hs

@@ -0,0 +1,66 @@
+module PlutusCore.ASTSize
+    ( ASTSize (..)
+    , kindASTSize
+    , typeASTSize
+    , tyVarDeclASTSize
+    , termASTSize
+    , varDeclASTSize
+    , programASTSize
+    ) where
+
+import PlutusPrelude
+import PlutusCore.Core
+
+import Control.Lens
+import Data.Monoid
+
+newtype ASTSize = ASTSize
+    { unASTSize :: Integer
+    } deriving stock (Show)
+      deriving newtype (Pretty, Eq, Ord, Num)
+      deriving (Semigroup, Monoid) via Sum Integer
+
+-- | Count the number of AST nodes in a kind.
+--
+-- >>> kindASTSize $ Type ()
+-- ASTSize {unASTSize = 1}
+-- >>> kindASTSize $ KindArrow () (KindArrow () (Type ()) (Type ())) (Type ())
+-- ASTSize {unASTSize = 5}
+kindASTSize :: Kind a -> ASTSize
+kindASTSize kind = fold
+    [ ASTSize 1
+    , kind ^. kindSubkinds . to kindASTSize
+    ]
+
+-- | Count the number of AST nodes in a type.
+typeASTSize :: Type tyname uni ann -> ASTSize
+typeASTSize ty = fold
+    [ ASTSize 1
+    , ty ^. typeSubkinds . to kindASTSize
+    , ty ^. typeSubtypes . to typeASTSize
+    ]
+
+tyVarDeclASTSize :: TyVarDecl tyname ann -> ASTSize
+tyVarDeclASTSize tyVarDecl = fold
+    [ ASTSize 1
+    , tyVarDecl ^. tyVarDeclSubkinds . to kindASTSize
+    ]
+
+-- | Count the number of AST nodes in a term.
+termASTSize :: Term tyname name uni fun ann -> ASTSize
+termASTSize term = fold
+    [ ASTSize 1
+    , term ^. termSubkinds . to kindASTSize
+    , term ^. termSubtypes . to typeASTSize
+    , term ^. termSubterms . to termASTSize
+    ]
+
+varDeclASTSize :: VarDecl tyname name uni ann -> ASTSize
+varDeclASTSize varDecl = fold
+    [ ASTSize 1
+    , varDecl ^. varDeclSubtypes . to typeASTSize
+    ]
+
+-- | Count the number of AST nodes in a program.
+programASTSize :: Program tyname name uni fun ann -> ASTSize
+programASTSize (Program _ _ t) = termASTSize t

plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs

@@ -122,7 +122,12 @@ instance Ord Name where
 instance Hashable Name where
   hashWithSalt s = hashWithSalt s . _nameUnique
 
--- | A unique identifier
+{-| A unique identifier
+
+We only make use of positive integral numbers. Using `Word` does not buy us much,
+because under- & over-flow could still happen. Using `Natural`s would be nice, but
+then we cannot use the faster `IntMap` implementation for the `UniqueMap`.
+-}
 newtype Unique = Unique {unUnique :: Int}
   deriving stock (Eq, Show, Ord, Lift)
   deriving newtype (Enum, NFData, Pretty, Hashable)

plutus-core/plutus-ir/src/PlutusIR/ASTSize.hs

@@ -0,0 +1,25 @@
+module PlutusIR.ASTSize
+    ( ASTSize (..)
+    , kindASTSize
+    , typeASTSize
+    , tyVarDeclASTSize
+    , termASTSize
+    , varDeclASTSize
+    ) where
+
+import PlutusPrelude
+
+import PlutusIR.Core
+
+import PlutusCore.ASTSize (ASTSize (..), kindASTSize, tyVarDeclASTSize, typeASTSize, varDeclASTSize)
+
+import Control.Lens
+
+-- | Count the number of AST nodes in a term.
+termASTSize :: Term tyname name uni fun ann -> ASTSize
+termASTSize term = fold
+    [ ASTSize 1
+    , term ^. termSubkinds . to kindASTSize
+    , term ^. termSubtypes . to typeASTSize
+    , term ^. termSubterms . to termASTSize
+    ]