Skip to content

Commit

Permalink
Adding some more commands to nofib-exe
Browse files Browse the repository at this point in the history
  • Loading branch information
@kwxm
kwxm committed Oct 24, 2020
1 parent 3ea869d commit d6aebf7
Show file tree
Hide file tree
Showing 5 changed files with 119 additions and 78 deletions.
135 changes: 94 additions & 41 deletions plutus-benchmark/nofib/exe/Main.hs
View file
@@ -1,20 +1,32 @@
{-# LANGUAGE LambdaCase #-}

module Main where

import Codec.Serialise
import Control.Monad
import Options.Applicative
import qualified Data.ByteString.Lazy as BSL
import Options.Applicative hiding (action)
import System.Environment
import System.Exit (exitFailure)
import System.IO

import Control.Monad ()
import Control.Monad.Trans.Except (runExceptT)
import Data.Char (isSpace)
import qualified Data.Map as Map
import Language.PlutusCore (Name (..))
import qualified Language.PlutusCore as PLC
import Language.PlutusCore.CBOR ()
import Language.PlutusCore.Constant (DynamicBuiltinNameMeanings (..))
import Language.PlutusCore.Evaluation.Machine.Cek ()
import Language.PlutusCore.Evaluation.Machine.ExBudgetingDefaults
import qualified Language.PlutusCore.Pretty as PLC
import Language.PlutusCore.Universe
import qualified Language.PlutusTx as Tx
import Language.PlutusTx.Prelude as TxPrelude hiding (replicate)
import Language.UntypedPlutusCore
import Language.PlutusTx.Prelude as TxPrelude hiding (replicate, (<$), (<$>),
(<*>))
import Language.UntypedPlutusCore as UPLC
import qualified Language.UntypedPlutusCore.DeBruijn as UPLC
import Language.UntypedPlutusCore.Evaluation.Machine.Cek
import Plutus.Benchmark.Clausify (Formula (..), clauses, replicate)
import qualified Plutus.Benchmark.Clausify as Clausify
Expand All @@ -24,13 +36,34 @@ import qualified Plutus.Benchmark.Prime as P
import qualified Plutus.Benchmark.Queens as Queens
import qualified Prelude as P

data Command =
data Action = RunPLC | RunHaskell | DumpPLC | DumpCBORnamed | DumpCBORdeBruijn

actionReader :: String -> Maybe Action
actionReader =
\case
"run" -> Just RunPLC
"runPLC" -> Just RunPLC
"runHaskell" -> Just RunHaskell
"dumpPLC" -> Just DumpPLC
"dumpCBORnamed" -> Just DumpCBORnamed
"dumpCBOR" -> Just DumpCBORdeBruijn
"dumpCBORdeBruijn" -> Just DumpCBORdeBruijn
_ -> Nothing

action :: Parser Action
action = argument (maybeReader actionReader)
( metavar "ACTION")

data ProgAndArgs =
Clausify Clausify.StaticFormula
| Queens P.Integer Queens.Algorithm
| Knights P.Integer P.Integer
| LastPiece
| Prime Prime.PrimeID

data Command = Command Action ProgAndArgs


clausifyFormulaReader :: String -> Either String Clausify.StaticFormula
clausifyFormulaReader "1" = Right Clausify.F1
clausifyFormulaReader "2" = Right Clausify.F2
Expand All @@ -41,21 +74,21 @@ clausifyFormulaReader "6" = Right Clausify.F6
clausifyFormulaReader "7" = Right Clausify.F7
clausifyFormulaReader f = Left $ "Cannot parse `" <> f <> "`. Should be 1, 2, 3, 4, 5, 6 or 7."

clausifyOptions :: Parser Command
clausifyOptions :: Parser ProgAndArgs
clausifyOptions =
Clausify P.<$> argument (eitherReader clausifyFormulaReader)
(metavar "FORMULA" P.<>
help "Formula to use for benchmarking: 1, 2, 3, 4, 5, 6 or 7")

queensOptions :: Parser Command
queensOptions :: Parser ProgAndArgs
queensOptions =
Queens P.<$> argument auto (metavar "BOARD-SIZE" P.<>
help "Size of the playing board NxN")
P.<*> (argument (eitherReader queensAlgorithmReader)
(metavar "ALGORITHM" P.<>
help "Algorithm to use for constraint solving. I know of: bt, bm, bjbt, bjbt' or fc"))

knightsOptions :: Parser Command
knightsOptions :: Parser ProgAndArgs
knightsOptions =
Knights P.<$> argument auto (metavar "DEPTH" P.<>
help "How deep does the search go.")
Expand All @@ -70,7 +103,7 @@ queensAlgorithmReader "bjbt2" = Right Queens.Bjbt2
queensAlgorithmReader "fc" = Right Queens.Fc
queensAlgorithmReader alg = Left $ "Unknown algorithm: " <> alg <> ". I know of: bt, bm, bjbt, bjbt1 or fc."

lastpieceOptions :: Parser Command
lastpieceOptions :: Parser ProgAndArgs
lastpieceOptions = P.pure LastPiece

primeIdReader :: String -> Either String Prime.PrimeID
Expand All @@ -82,20 +115,22 @@ primeIdReader "30" = Right Prime.P30
primeIdReader "40" = Right Prime.P40
primeIdReader "50" = Right Prime.P50
primeIdReader "60" = Right Prime.P60
primeIdReader f = Left $ "Cannot parse `" <> f <> "`. Should be 5, 8, 10, 20, 30, 40, 50, or 60."
primeIdReader f = Left $ "Cannot parse `" <> f <> "`. Should be 'P' plus number of digits (5, 8, 10, 20, 30, 40, 50, or 60 .)"

primeOptions :: Parser Command
primeOptions :: Parser ProgAndArgs
primeOptions =
Prime P.<$> (argument auto (metavar "INPUT" P.<>
help "Identifier for input prime: P<number of digits>"))

options :: Parser Command
options = hsubparser
( command "clausify" (info clausifyOptions (progDesc "Run the clausify benchmark.")) P.<>
command "queens" (info queensOptions (progDesc "Run the queens benchmark.")) P.<>
command "knights" (info knightsOptions (progDesc "Run the knights benchmark")) P.<>
progAndArgs = hsubparser
( command "clausify" (info clausifyOptions (progDesc "Run the clausify benchmark.")) P.<>
command "queens" (info queensOptions (progDesc "Run the queens benchmark.")) P.<>
command "knights" (info knightsOptions (progDesc "Run the knights benchmark")) P.<>
command "lastpiece" (info lastpieceOptions (progDesc "Run the lastpiece benchmark")) P.<>
command "prime" (info primeOptions (progDesc "Run the primes benchmark")) )
command "prime" (info primeOptions (progDesc "Run the primes benchmark")) )

options :: Parser Command
options = Command <$> action <*> progAndArgs

emptyBuiltins :: DynamicBuiltinNameMeanings (CekValue DefaultUni)
emptyBuiltins = DynamicBuiltinNameMeanings Map.empty
Expand All @@ -104,29 +139,47 @@ evaluateWithCek :: Term Name DefaultUni () -> EvaluationResult (Term Name Defaul
evaluateWithCek term =
unsafeEvaluateCek emptyBuiltins defaultCostModel term

main1 :: IO ()
main1 = do
cmd <- execParser (info (helper P.<*> options) idm)
let program =
case cmd of
Clausify formula -> Clausify.mkClausifyTerm formula
Queens boardSize alg -> Queens.mkQueensTerm boardSize alg
Knights depth boardSize -> Knights.mkKnightsTerm depth boardSize
LastPiece -> LastPiece.mkLastPieceTerm
Prime input -> Prime.mkPrimalityBenchTerm input
let result = unsafeEvaluateCek emptyBuiltins defaultCostModel program
print . PLC.prettyPlcClassicDebug $ result

{-
main2 :: IO ()
main2 = do
cmd <- execParser (info (helper P.<*> options) idm)
case cmd of
Clausify formula -> print . PLC.prettyPlcClassicDebug $ Clausify.runClausify formula
Queens boardSize alg -> print . PLC.prettyPlcClassicDebug $ Queens.runQueens boardSize alg
Knights depth boardSize -> print . PLC.prettyPlcClassicDebug $ Knights.runKnights depth boardSize
LastPiece -> return ()
Prime input -> return ()
-}
toDeBruijn :: Program Name DefaultUni a -> IO (Program UPLC.DeBruijn DefaultUni a)
toDeBruijn prog = do
r <- PLC.runQuoteT $ runExceptT (UPLC.deBruijnProgram prog)
case r of
Left e -> hPutStrLn stderr (show e) >> exitFailure
Right p -> return $ UPLC.programMapNames (\(UPLC.NamedDeBruijn _ ix) -> UPLC.DeBruijn ix) p

data CborMode = Named | DeBruijn

writeCBOR :: CborMode -> Program Name DefaultUni () -> IO ()
writeCBOR cborMode prog =
case cborMode of
Named -> BSL.putStr $ serialise prog
DeBruijn -> toDeBruijn prog >>= BSL.putStr . serialise


main :: IO ()
main = main1
main = do
Command act panda <- execParser (info (helper P.<*> options) idm)
case act of
RunPLC -> do
let program = getProgram panda
result = unsafeEvaluateCek emptyBuiltins defaultCostModel program
print . PLC.prettyPlcClassicDebug $ result
RunHaskell ->
case panda of
Clausify formula -> print $ Clausify.runClausify formula
Queens boardSize alg -> print $ Queens.runQueens boardSize alg
Knights depth boardSize -> print $ Knights.runKnights depth boardSize
LastPiece -> print $ "Not yet"
Prime input -> print $ Prime.runFixedPrimalityTest input
DumpPLC -> mapM_ putStrLn $ unindent . PLC.prettyPlcClassicDebug $ getWrappedProgram panda
where unindent d = map (dropWhile isSpace) $ (lines . show $ d)
DumpCBORnamed -> writeCBOR Named $ getWrappedProgram panda
DumpCBORdeBruijn -> writeCBOR DeBruijn $ getWrappedProgram panda
-- ^ Write the output to stdout and let the user deal with redirecting it.
where getProgram =
\case
Clausify formula -> Clausify.mkClausifyTerm formula
Queens boardSize alg -> Queens.mkQueensTerm boardSize alg
Knights depth boardSize -> Knights.mkKnightsTerm depth boardSize
LastPiece -> LastPiece.mkLastPieceTerm
Prime input -> Prime.mkPrimalityBenchTerm input
getWrappedProgram = Program () (Version () 1 0 0) . getProgram
43 changes: 10 additions & 33 deletions plutus-benchmark/nofib/src/Plutus/Benchmark/Knights/ChessSetList.hs
View file
Expand Up @@ -15,7 +15,10 @@ module Plutus.Benchmark.Knights.ChessSetList
isSquareFree
) where

import Language.PlutusTx.Prelude as Tx hiding (init)
import Plutus.Benchmark.Knights.Sort
import Plutus.Benchmark.Knights.Utils

import Language.PlutusTx.Prelude as Tx hiding (init)


type Tile = (Integer,Integer)
Expand Down Expand Up @@ -119,33 +122,9 @@ isSquareFree :: Tile -> ChessSet -> Bool
isSquareFree x (Board _ _ _ ts) = notIn x ts


{-
-- % Everything below here is only needed for printing boards.
-- % This is useful for debugging.

{-# INLINABLE showInteger #-}
showInteger :: Tx.Integer -> Tx.String
showInteger n =
if n == 0 then "0"
else if n == 1 then "1"
else if n == 2 then "2"
else if n == 3 then "3"
else if n == 4 then "4"
else if n == 5 then "5"
else if n == 6 then "6"
else if n == 7 then "7"
else "?"
{-# INLINABLE showList #-}
showList :: [Integer] -> String
showList [] = "0"
showList [_] = "1"
showList [_,_] = "2"
showList [_,_,_] = "3"
showList [_,_,_,_] = "4"
showList _ = "?"
instance Show ChessSet where
showsPrec _ (Board sze n _ ts)
= showString (printBoard sze sortedTrail 1)
Expand All @@ -172,12 +151,10 @@ printBoard s trail@((i,j):xs) n
printBoard _ _ _ = "?"

spaces :: Integer -> Integer -> String
spaces s y = take ((logTen s) - (logTen y) + 1) [' ',' '..]
where
logTen :: Integer -> Integer
logTen 0 = 0
logTen x = 1 + logTen (x `div` 10)
spaces s y =
take' ((logTen s) - (logTen y) + 1) [' ',' '..]
where
logTen :: Integer -> Integer
logTen 0 = 0
logTen x = 1 + logTen (x `div` 10)

PlutusTx.makeLift ''ChessSet
-}
2 changes: 1 addition & 1 deletion plutus-benchmark/nofib/src/Plutus/Benchmark/Knights/Utils.hs
View file
Expand Up @@ -9,4 +9,4 @@ import Language.PlutusTx.Prelude as PLC
{-# INLINABLE take' #-}
take' :: Integer -> [a] -> [a]
take' _ [] = []
take' n (a:as) = a:(take' (n-1) as)
take' n (a:as) = if n<=0 then [] else a:(take' (n-1) as)
14 changes: 11 additions & 3 deletions plutus-benchmark/nofib/src/Plutus/Benchmark/Prime.hs
View file
Expand Up @@ -295,11 +295,19 @@ mkPrimalityTestTerm n =
`Tx.applyCode` Tx.liftCode n
in code


-- Run the program on one of the fixed primes listed above
runFixedPrimalityTest :: PrimeID -> Result
runFixedPrimalityTest pid = runPrimalityTest (getPrime 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 Name DefaultUni ()
mkPrimalityBenchTerm pid =
let (Program _ _ code) = Tx.getPlc $ $$(Tx.compile
[|| runPrimalityTest ||])
`Tx.applyCode` Tx.liftCode (getPrime pid)
let (Program _ _ code) = Tx.getPlc $
$$(Tx.compile [|| runFixedPrimalityTest ||])
`Tx.applyCode` Tx.liftCode pid
in code

Tx.makeLift ''PrimeID

3 changes: 3 additions & 0 deletions plutus-benchmark/plutus-benchmark.cabal
View file
Expand Up @@ -78,8 +78,11 @@ executable nofib-exe
, plutus-tx -any
, plutus-tx-plugin -any
, plutus-core -any
, bytestring -any
, containers -any
, optparse-applicative -any
, serialise -any
, transformers -any

benchmark nofib
import: lang
Expand Down

0 comments on commit d6aebf7

Please sign in to comment.