Merge master into mlabs-haskell-koz/secp256k1 and fix what got broken

plutus-benchmark/nofib-compare

@@ -0,0 +1,55 @@
+#!/usr/bin/env bash
+# Compare the output from two runs of 'nofib-exe sizes-and-budgets' and print a
+# table of the increase/decrease in size/cpu/memory for each.  We only print the
+# changes because including the input data would make the table too wide.
+
+# Do something like
+#    `cabal run nofib-exe sizes-and-budgets >results1
+# in one branch and then 
+#    `cabal run nofib-exe sizes-and-budgets >results2
+# in another, then
+#    `nofib-compare results1 results2`
+# to see the comparison.
+#
+
+if [[ $# -lt 2 || $1 == "-h" || $1 == "--help" ]]
+then
+    echo -n "Usage: $0 <file1> <file2>"
+    exit 1
+fi
+
+INPUT1=$1
+INPUT2=$2
+
+if [[ ! -r "$INPUT1" ]]
+then echo "Error: can't open $INPUT1" && exit 1
+fi
+
+if [[ ! -r "$INPUT2" ]]
+then echo "Error: can't open $INPUT2" && exit 1
+fi
+
+TMP1=$(mktemp /tmp/bc1-XXXXXXX)
+TMP2=$(mktemp /tmp/bc2-XXXXXXX)
+
+trap 'rm -f "$TMP1" "$TMP2"' EXIT
+
+# Print out everything after the first line containing "----", ie after the header.
+# This should ensure that we're only processing actual data.
+awk 'afterHdr >= 1 { print} /-------/ {afterHdr = 1}' "$INPUT1" > "$TMP1"
+awk 'afterHdr >= 1 { print} /-------/ {afterHdr = 1}' "$INPUT2" > "$TMP2"
+
+paste "$TMP1" "$TMP2" |
+   awk '
+      function diff (n1, n2) {
+        d = (n2-n1)/n1 * 100
+        sign = (d<0) ? "" : ((d==0) ? " " : "+")  # We get the "-" anyway if d<0
+        return sprintf ("%s%.1f%%", sign, d)
+      }       
+      BEGIN { 
+        printf ("Script                     Size         CPU budget    Memory budget\n")
+        printf ("-------------------------------------------------------------------\n")
+     }
+     { printf ("%-15s %15s %15s %15s\n", $1, diff($2,$6), diff($3,$7), diff($4,$8)) }
+  '
+

plutus-benchmark/nofib/exe/Main.hs

@@ -1,18 +1,21 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase       #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
 import Prelude ((<>))
-import Prelude qualified as Haskell
+import Prelude qualified as Hs
 
 import Control.Monad ()
+import Control.Monad.Trans.Except (runExceptT)
 import Data.ByteString qualified as BS
 import Data.Char (isSpace)
 import Flat qualified
 import Options.Applicative as Opt hiding (action)
 import System.Exit (exitFailure)
 import System.IO
 import Text.PrettyPrint.ANSI.Leijen (Doc, indent, line, string, text, vsep)
+import Text.Printf (printf)
 
 import PlutusBenchmark.Common (toAnonDeBruijnTerm)
 
@@ -22,23 +25,28 @@ import PlutusBenchmark.NoFib.LastPiece qualified as LastPiece
 import PlutusBenchmark.NoFib.Prime qualified as Prime
 import PlutusBenchmark.NoFib.Queens qualified as Queens
 
-import PlutusCore (Name (..))
+import PlutusCore (EvaluationResult, Name (..))
 import PlutusCore qualified as PLC
-import PlutusCore.Default
-import PlutusCore.Pretty qualified as PLC
-import PlutusTx.Prelude as Plutus hiding (fmap, mappend, (<$), (<$>), (<*>), (<>))
+import PlutusCore.Default (DefaultFun, DefaultUni)
+import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
+import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..))
+import PlutusCore.Pretty (prettyPlcClassicDebug)
+import PlutusTx (getPlc)
+import PlutusTx.Code (CompiledCode, sizePlc)
+import PlutusTx.Evaluation (evaluateCekTrace)
+import PlutusTx.Prelude hiding (fmap, mappend, (<$), (<$>), (<*>), (<>))
 import UntypedPlutusCore qualified as UPLC
-import UntypedPlutusCore.Evaluation.Machine.Cek
+import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC
 
-failWithMsg :: Haskell.String -> IO a
+failWithMsg :: Hs.String -> IO a
 failWithMsg s = hPutStrLn stderr s >> exitFailure
 
 
 -- | A program together with its arguments
 data ProgAndArgs =
     Clausify  Clausify.StaticFormula
-  | Queens    Haskell.Integer Queens.Algorithm
-  | Knights   Haskell.Integer Haskell.Integer
+  | Queens    Hs.Integer Queens.Algorithm
+  | Knights   Hs.Integer Hs.Integer
   | LastPiece
   | Prime     Prime.PrimeID
   | Primetest Integer
@@ -50,14 +58,15 @@ data Options
     | DumpPLC          ProgAndArgs
     | DumpFlatNamed    ProgAndArgs
     | DumpFlatDeBruijn ProgAndArgs
+    | SizesAndBudgets
 
 
 -- Clausify options --
 
-knownFormulae :: Haskell.String
+knownFormulae :: Hs.String
 knownFormulae = "one of F1, F2, F3, F4, F5, F6, F7"
 
-clausifyFormulaReader :: Haskell.String -> Either Haskell.String Clausify.StaticFormula
+clausifyFormulaReader :: Hs.String -> Either Hs.String Clausify.StaticFormula
 clausifyFormulaReader "F1" = Right Clausify.F1
 clausifyFormulaReader "F2" = Right Clausify.F2
 clausifyFormulaReader "F3" = Right Clausify.F3
@@ -87,15 +96,15 @@ knightsOptions =
 -- Lastpiece options --
 
 lastpieceOptions :: Parser ProgAndArgs
-lastpieceOptions = Haskell.pure LastPiece
+lastpieceOptions = Hs.pure LastPiece
 
 
 -- Primes options --
 
-knownPrimes :: Haskell.String
+knownPrimes :: Hs.String
 knownPrimes = "P05, P08, P10, P20, P30, P40, P50, P60, P100, P150, or P200 (a prime with the indicated number of digits)"
 
-primeIdReader :: Haskell.String -> Either Haskell.String Prime.PrimeID
+primeIdReader :: Hs.String -> Either Hs.String Prime.PrimeID
 primeIdReader "P05"  = Right Prime.P5
 primeIdReader "P08"  = Right Prime.P8
 primeIdReader "P10"  = Right Prime.P10
@@ -126,10 +135,10 @@ primetestOptions =
 
 -- Queens options --
 
-knownAlgorithms :: Haskell.String
+knownAlgorithms :: Hs.String
 knownAlgorithms = "bt, bm, bjbt1, bjbt2, fc"
 
-queensAlgorithmReader :: Haskell.String -> Either Haskell.String Queens.Algorithm
+queensAlgorithmReader :: Hs.String -> Either Hs.String Queens.Algorithm
 queensAlgorithmReader "bt"    = Right Queens.Bt
 queensAlgorithmReader "bm"    = Right Queens.Bm
 queensAlgorithmReader "bjbt1" = Right Queens.Bjbt1
@@ -162,42 +171,45 @@ options = hsubparser
   (  command "run"
      (info (RunPLC <$> progAndArgs)
       (progDesc "same as runPLC"))
-  <> command "runPLC"
+  <> command "run-plc"
      (info (RunPLC <$> progAndArgs)
       (progDesc "compile the program to Plutus Core and evaluate it using the CEK machine"))
-  <> command "runHaskell"
+  <> command "run-hs"
      (info (RunHaskell <$> progAndArgs)
-      (progDesc "run the program directly as Haskell"))
-  <> command "dumpPLC"
+      (progDesc "run the program directly as Hs"))
+  <> command "dump-plc"
      (info (DumpPLC <$> progAndArgs)
       (progDesc "print the program (applied to arguments) as Plutus Core source on standard output"))
-  <> command "dumpFlatNamed"
+  <> command "dump-flat-named"
      (info (DumpFlatNamed <$> progAndArgs)
       (progDesc "dump the AST as Flat, preserving names"))
-  <> command "dumpFlat"
+  <> command "dump-flat"
      (info (DumpFlatDeBruijn <$> progAndArgs)
-      (progDesc "same as dumpFlatDeBruijn, but easier to type"))
-  <> command "dumpFlatDeBruijn"
+      (progDesc "same as dump-flat-deBruijn, but easier to type"))
+  <> command "dump-flat-deBruijn"
      (info (DumpFlatDeBruijn <$> progAndArgs)
       (progDesc "dump the AST as Flat, with names replaced by de Bruijn indices"))
+  <> command "sizes-and-budgets"
+     (info (Hs.pure SizesAndBudgets)
+      (progDesc "Print the size and cpu/memory budgets of each program"))
   )
 
 
 ---------------- Evaluation ----------------
 
 evaluateWithCek :: UPLC.Term Name DefaultUni DefaultFun () -> EvaluationResult (UPLC.Term Name DefaultUni DefaultFun ())
-evaluateWithCek = unsafeEvaluateCekNoEmit PLC.defaultCekParameters
+evaluateWithCek = UPLC.unsafeEvaluateCekNoEmit PLC.defaultCekParameters
 
 writeFlatNamed :: UPLC.Program Name DefaultUni DefaultFun () -> IO ()
 writeFlatNamed prog = BS.putStr $ Flat.flat prog
 
 writeFlatDeBruijn ::UPLC.Program UPLC.DeBruijn DefaultUni DefaultFun () -> IO ()
 writeFlatDeBruijn  prog = BS.putStr . Flat.flat $ prog
 
-description :: Haskell.String
+description :: Hs.String
 description = "This program provides operations on a number of Plutus programs "
-              ++ "ported from the nofib Haskell test suite.  "
-              ++ "The programs are written in Haskell and can be run directly "
+              ++ "ported from the nofib Hs test suite.  "
+              ++ "The programs are written in Hs and can be run directly "
               ++ "or compiled into Plutus Core and run on the CEK machine.  "
               ++ "Compiled programs can also be output in a number of formats."
 
@@ -209,7 +221,7 @@ knownProgs = map text ["clausify", "knights", "lastpiece", "prime", "primetest",
 -- manual formatting in here because the text doesn't wrap as expected, presumably
 -- due to what optparse-applicative is doing internally.
 footerInfo :: Doc
-footerInfo = text "Every command takes the name of a program and a (possbily empty) list of arguments."
+footerInfo = text "Most commands take the name of a program and a (possbily empty) list of arguments."
            <> line <> line
            <> text "The available programs are: "
            <> line
@@ -222,23 +234,93 @@ footerInfo = text "Every command takes the name of a program and a (possbily emp
                    ++ "arguments and prints the result to the terminal in the specified format.\n"
                    ++ "You'll probably want to redirect the output to a file.")
 
+
+-- Copied pretty much directly from plutus-tx/testlib/PlutusTx/Test.hs
+measureBudget :: CompiledCode a -> (Integer, Integer)
+measureBudget compiledCode =
+  let programE = PLC.runQuote
+               $ runExceptT @PLC.FreeVariableError
+               $ UPLC.unDeBruijnProgram
+               $ getPlc compiledCode
+   in case programE of
+        Left _ -> (-1,-1) -- Something has gone wrong but I don't care.
+        Right program ->
+          let (_, UPLC.TallyingSt _ budget, _) = evaluateCekTrace program
+              ExCPU cpu = exBudgetCPU budget
+              ExMemory mem = exBudgetMemory budget
+          in (Hs.fromIntegral cpu, Hs.fromIntegral mem)
+
+getInfo :: (Hs.String, CompiledCode a) -> (Hs.String, Integer, Integer, Integer)
+getInfo (name, code) =
+    let size = sizePlc code
+        (cpu, mem) = measureBudget code
+    in (name, size, cpu, mem)
+
+printSizesAndBudgets :: IO ()
+printSizesAndBudgets = do
+  -- The applied programs to measure, which are the same as the ones in the benchmarks.
+   -- We can't put all of these in one list because the 'a's in 'CompiledCode a' are different
+  let clausify =  [ ("clausify/F1", Clausify.mkClausifyCode Clausify.F1)
+                  , ("clausify/F2", Clausify.mkClausifyCode Clausify.F2)
+                  , ("clausify/F3", Clausify.mkClausifyCode Clausify.F3)
+                  , ("clausify/F4", Clausify.mkClausifyCode Clausify.F4)
+                  , ("clausify/F5", Clausify.mkClausifyCode Clausify.F5)
+                  ]
+      knights =   [ ( "knights/4x4",  Knights.mkKnightsCode 100 4)
+                  , ( "knights/6x6",  Knights.mkKnightsCode 100 6)
+                  , ( "knights/8x8",  Knights.mkKnightsCode 100 8)
+                  ]
+      primetest = [ ("primes/05digits", Prime.mkPrimalityCode Prime.P5)
+                  , ("primes/08digits", Prime.mkPrimalityCode Prime.P8)
+                  , ("primes/10digits", Prime.mkPrimalityCode Prime.P10)
+                  , ("primes/20digits", Prime.mkPrimalityCode Prime.P20)
+                  , ("primes/30digits", Prime.mkPrimalityCode Prime.P30)
+                  , ("primes/40digits", Prime.mkPrimalityCode Prime.P40)
+                  , ("primes/50digits", Prime.mkPrimalityCode Prime.P50)
+                  ]
+      queens4x4 = [ ("queens4x4/bt",    Queens.mkQueensCode 4 Queens.Bt)
+                  , ("queens4x4/bm",    Queens.mkQueensCode 4 Queens.Bm)
+                  , ("queens4x4/bjbt1", Queens.mkQueensCode 4 Queens.Bjbt1)
+                  , ("queens4x4/bjbt2", Queens.mkQueensCode 4 Queens.Bjbt2)
+                  , ("queens4x4/fc",    Queens.mkQueensCode 4 Queens.Fc)
+                  ]
+      queens5x5 = [ ("queens5x5/bt"    ,Queens.mkQueensCode 5 Queens.Bt)
+                  , ("queens5x5/bm"    ,Queens.mkQueensCode 5 Queens.Bm)
+                  , ("queens5x5/bjbt1" ,Queens.mkQueensCode 5 Queens.Bjbt1)
+                  , ("queens5x5/bjbt2" ,Queens.mkQueensCode 5 Queens.Bjbt2)
+                  , ("queens5x5/fc"    ,Queens.mkQueensCode 5 Queens.Fc)
+                  ]
+      statistics = map getInfo clausify ++ map getInfo knights ++ map getInfo primetest ++ map getInfo queens4x4 ++ map getInfo queens5x5
+      formatInfo (name, size, cpu, mem) = printf "%-20s %10d %15d %15d\n" name size cpu mem
+
+  putStrLn "Script                     Size     CPU budget      Memory budget"
+  putStrLn "-----------------------------------------------------------------"
+  mapM_ (putStr . formatInfo) statistics
+
+
 main :: IO ()
 main = do
   execParser (info (helper <*> options) (fullDesc <> progDesc description <> footerDoc (Just footerInfo))) >>= \case
-    RunPLC pa ->  print . PLC.prettyPlcClassicDebug . evaluateWithCek . getTerm $ pa
+    RunPLC pa ->
+        print . prettyPlcClassicDebug . evaluateWithCek . getTerm $ pa
     RunHaskell pa ->
         case pa of
           Clausify formula        -> print $ Clausify.runClausify formula
           Knights depth boardSize -> print $ Knights.runKnights depth boardSize
           LastPiece               -> print $ LastPiece.runLastPiece
           Queens boardSize alg    -> print $ Queens.runQueens boardSize alg
           Prime input             -> print $ Prime.runFixedPrimalityTest input
-          Primetest n             -> if n<0 then Haskell.error "Positive number expected"
+          Primetest n             -> if n<0 then Hs.error "Positive number expected"
                                      else print $ Prime.runPrimalityTest n
-    DumpPLC pa -> Haskell.mapM_ putStrLn $ unindent . PLC.prettyPlcClassicDebug . mkProg . getTerm $ pa
-        where unindent d = map (dropWhile isSpace) $ (Haskell.lines . Haskell.show $ d)
-    DumpFlatNamed pa   -> writeFlatNamed . mkProg . getTerm $ pa
-    DumpFlatDeBruijn pa-> writeFlatDeBruijn . mkProg . toAnonDeBruijnTerm . getTerm $ pa
+    DumpPLC pa ->
+        Hs.mapM_ putStrLn $ unindent . prettyPlcClassicDebug . mkProg . getTerm $ pa
+            where unindent d = map (dropWhile isSpace) $ (Hs.lines . Hs.show $ d)
+    DumpFlatNamed pa ->
+        writeFlatNamed . mkProg . getTerm $ pa
+    DumpFlatDeBruijn pa ->
+        writeFlatDeBruijn . mkProg . toAnonDeBruijnTerm . getTerm $ pa
+    SizesAndBudgets
+        -> printSizesAndBudgets
     -- Write the output to stdout and let the user deal with redirecting it.
     where getTerm :: ProgAndArgs -> UPLC.Term UPLC.Name DefaultUni DefaultFun ()
           getTerm =
@@ -248,11 +330,8 @@ main = do
                Knights depth boardSize -> Knights.mkKnightsTerm depth boardSize
                LastPiece               -> LastPiece.mkLastPieceTerm
                Prime input             -> Prime.mkPrimalityBenchTerm input
-               Primetest n             -> if n<0 then Haskell.error "Positive number expected"
+               Primetest n             -> if n<0 then Hs.error "Positive number expected"
                                           else Prime.mkPrimalityTestTerm n
 
---          getUnDBrTerm :: ProgAndArgs -> UPLC.Term Name DefaultUni DefaultFun ()
---          getUnDBrTerm = unDeBruijn . getDBrTerm
-
           mkProg :: UPLC.Term name uni fun () -> UPLC.Program name uni fun ()
           mkProg = UPLC.Program () (UPLC.Version () 1 0 0)

plutus-benchmark/nofib/src/PlutusBenchmark/NoFib/Prime.hs

@@ -304,13 +304,17 @@ mkPrimalityTestTerm n =
 runFixedPrimalityTest :: PrimeID -> Result
 runFixedPrimalityTest pid = runPrimalityTest (getPrime pid)
 
+
+mkPrimalityCode :: PrimeID -> Tx.CompiledCode Result
+mkPrimalityCode pid =
+    $$(Tx.compile [|| runFixedPrimalityTest ||])
+          `Tx.applyCode` Tx.liftCode pid
+
 -- % Run the program on a number known to be prime, for benchmarking
 -- (primes take a long time, composite numbers generally don't).
 mkPrimalityBenchTerm :: PrimeID -> Term
 mkPrimalityBenchTerm pid =
-    compiledCodeToTerm $
-        $$(Tx.compile [|| runFixedPrimalityTest ||])
-        `Tx.applyCode` Tx.liftCode pid
+    compiledCodeToTerm $ mkPrimalityCode pid
 
 Tx.makeLift ''PrimeID
 Tx.makeLift ''Result

plutus-benchmark/plutus-benchmark.cabal

@@ -101,6 +101,7 @@ executable nofib-exe
     , bytestring -any
     , flat -any
     , optparse-applicative -any
+    , transformers -any
 
 benchmark nofib
   import: lang