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
+ ]