diff --git a/framework/README.md b/framework/README.md index 8e1477b..86e4e72 100644 --- a/framework/README.md +++ b/framework/README.md @@ -20,21 +20,27 @@ Recommended organization is to put all build artifacts into a `build` subdirecto Benchmarks can be parameterized using environment variables. By convention, we start the names of these environment variables with the `ZKBENCH_` prefix. -An additional file `benchmark.cfg` specifies the configuration and parameter ranges. +An additional file `bench.cfg` specifies the configuration and parameter ranges. Example file: - name: "Poseidon2 Groth16 benchmarks" + name: "Poseidon2 Groth16 benchmarks" + author: Xenon Y. Zorro timeout: 300 - rerunFrom: build + rerun_from: build params: [ PROVER: [ snarkjs, rapidsnark ] , INPUT_SIZE: [ 256, 512, 1024, 2048 ] , WHICH: [ hash_sponge, hash_sponge_rate2, hash_merkle ] ] + tags: Groth16, Poseidon2, $PROVER + comments: + Here you can even write + multiline comments + for convenience Note: in case of an arithmetic circuit, every step of the build process must be rerun if the circuit changes, and the circuit depends on the input size... -The `rerunFrom` parameter allows to set this. Normally you want it te be `run` +The `rerun_from` parameter allows to set this. Normally you want it te be `run` (only rerun the `run.sh` script), but in case of Groth16 you want that to be `build`. `timeout` (in seconds) sets the maximum target time we should spend on this specific @@ -44,3 +50,5 @@ and everage them to get a less noisy result. `params` corresponds to the possible values of the corresponding environment variables (in this example, `ZKBENCH_PROVER`, etc) +`tags` are used to select relevant subsets of the benchmarks (as we expect to +have a lots of them, with lots of parameter settings). diff --git a/framework/src/Parser.hs b/framework/src/Parser.hs new file mode 100644 index 0000000..8efa94b --- /dev/null +++ b/framework/src/Parser.hs @@ -0,0 +1,361 @@ + +-- | Parsing the @bench.cfg@ files. +-- +-- Example config file: +-- +-- > name: "Poseidon2 Groth16 benchmarks" +-- > timeout: 300 +-- > rerunFrom: build +-- > params: +-- > [ PROVER: [ snarkjs, rapidsnark ] +-- > , INPUT_SIZE: [ 256, 512, 1024, 2048 ] +-- > , WHICH: [ hash_sponge, hash_sponge_rate2, hash_merkle ] +-- > ] +-- > tags: Groth16, Poseidon2, $PROVER +-- + +{-# OPTIONS_GHC -Wno-overlapping-patterns #-} +{-# LANGUAGE PackageImports #-} +module Parser where + +-------------------------------------------------------------------------------- + +import Data.Char +import Data.Maybe +-- import Data.List + +import qualified Data.Map as Map + +import Control.Monad +import Control.Applicative + +import "parsec1" Text.ParserCombinators.Parsec + +import Types + +-------------------------------------------------------------------------------- + +exampleConfigString :: String +exampleConfigString = unlines + [ "name: \"Poseidon2 Groth16 benchmarks\" " + , "timeout: 300" + , "rerunFrom: build " + , "params:" + , " [ PROVER: [ snarkjs, \"rapidsnark\" ]" + , " , INPUT_SIZE: [ 256, 512, 1024, " + , " 2048 ]" + , " , WHICH: [ hash_sponge, hash_sponge_rate2, hash_merkle ]" + , " ]" + , "tags: Groth16, Poseidon2, $PROVER, \"stringy tag\" " + , "comment: " + , " foo" + , " bar" + , " baz" + , "author: \"X. Middlename Y.\"" + ] + +-------------------------------------------------------------------------------- + +data CfgField + = Field_name + | Field_timeout + | Field_rerun + | Field_params + | Field_tags + | Field_author + | Field_comment + deriving Show + +recognizeField :: String -> Maybe CfgField +recognizeField s = case filter (/='_') (map toLower s) of + "name" -> Just Field_name + "timeout" -> Just Field_timeout + "rerun" -> Just Field_rerun + "rerunfrom" -> Just Field_rerun + "params" -> Just Field_params + "tags" -> Just Field_tags + "author" -> Just Field_author + "comment" -> Just Field_comment + "comments" -> Just Field_comment + _ -> Nothing + +-------------------------------------------------------------------------------- + +naturalP :: Parser Integer +naturalP = do + xs <- many1 digit + return (read xs) + +numberP :: Parser Integer +numberP = naturalP + +identP :: Parser String +identP = do + c <- letter <|> oneOf "_" + cs <- many (alphaNum <|> oneOf "_") + return (c:cs) + +singleWordP :: Parser String +singleWordP = do + c <- letter <|> oneOf "_" + cs <- many (alphaNum <|> oneOf "_-") + return (c:cs) + +quotedStringP :: Parser String +quotedStringP = do + char '"' + xs <- many (noneOf "\"\n\r") + char '"' + return xs + +tagP :: Parser Tag +tagP = (FixedTag <$> quotedStringP) <|> nakedTagP + +nakedTagP :: Parser Tag +nakedTagP = do + c <- letter <|> oneOf "_$" + cs <- many (alphaNum <|> oneOf "_-+!?@#%^/&*=:") + return $ case c of + '$' -> ParamTag cs + _ -> FixedTag (c:cs) + +-------------------------------------------------------------------------------- + +-- | A list delimited by @[@ and @]@ +listP :: Parser a -> Parser [a] +listP userP = (char '[' >> spaces >> start) where + finish = do + char ']' + return [] + start = finish <|> do + x <- userP ; spaces + xs <- continue + return (x:xs) + continue = finish <|> do + char ',' ; spaces + x <- userP ; spaces + xs <- continue + return (x:xs) + +-- | A list without delimiters +nakedListP :: Parser a -> Parser [a] +nakedListP userP = start where + start = do + x <- userP ; onlySpaces + xs <- continue + return (x:xs) + continue = (newlineP >> return []) <|> do + char ',' ; spaces + x <- userP ; onlySpaces + xs <- continue + return (x:xs) + +-------------------------------------------------------------------------------- + +postEOF :: Parser a -> Parser a +postEOF userP = do + x <- userP + spaces + eof + return x + +postNewline :: Parser a -> Parser a +postNewline userP = do + x <- userP + onlySpaces + newlineP + return x + +postSpaces :: Parser a -> Parser a +postSpaces userP = do + x <- userP + spaces + return x + +-------------------------------------------------------------------------------- + +onlySpaces :: Parser () +onlySpaces = void $ many (oneOf " \t") + +newlineP :: Parser () +newlineP = try (void $ string "\r\n") + <|> (void $ oneOf "\r\n") + <|> eof + +singleLineP :: Parser String +singleLineP = quotedStringP <|> many (noneOf "\r\n") + +multiLineP_ :: Parser String +multiLineP_ = unlines <$> multiLineP + +multiLineP :: Parser [String] +multiLineP = loop where + loop = do + l <- tillEndOfLine + ls <- indented + return (l:ls) + indented = do + newlineP + continue <|> return [] + continue = do + _ <- many1 (oneOf " \t") + loop + tillEndOfLine = many (noneOf "\r\n") + +-------------------------------------------------------------------------------- + +phaseP :: Parser Phase +phaseP = do + s <- identP + case (map toLower s) of + "build" -> return Build + "setup" -> return Setup + "witness" -> return Witness + "run" -> return Run + _ -> fail ("unknown phase " ++ quote s) + +tagsP :: Parser [Tag] +tagsP = listP tagP <|> nakedListP tagP + +-------------------------------------------------------------------------------- + +simpleValP :: Parser Value +simpleValP = (StringV <$> (quotedStringP <|> singleWordP)) + <|> (NumberV <$> numberP) + +type ParamRange = KeyVal String [Value] + +paramP :: Parser ParamRange +paramP = do + key <- identP ; spaces + char ':' ; spaces + vals <- listP simpleValP + return (MkKeyVal key vals) + +paramsP :: Parser [ParamRange] +paramsP = listP paramP + +-------------------------------------------------------------------------------- + +data KeyVal k a + = MkKeyVal k a + deriving (Eq,Show) + +data Value + = StringV String + | NumberV Integer + | PhaseV Phase + | TagV Tag + | ListV [Value] + | KeyValV (KeyVal String Value) + deriving (Eq,Show) + +paramRangeToValue :: ParamRange -> Value +paramRangeToValue (MkKeyVal key list) = KeyValV (MkKeyVal key (ListV list)) + +type Entry = KeyVal CfgField Value + +entryP :: Parser Entry +entryP = + postSpaces $ do + key <- identP ; spaces + char ':' ; spaces + (fld,val) <- case recognizeField key of + Nothing -> fail ("invalid configuration key " ++ quote key) + Just fld -> do + rhs <- fieldValueP fld + return (fld,rhs) + return (MkKeyVal fld val) + where + +fieldValueP :: CfgField -> Parser Value +fieldValueP fld = case fld of + Field_name -> StringV <$> singleLineP + Field_timeout -> NumberV <$> numberP + Field_rerun -> PhaseV <$> phaseP + Field_params -> ListV <$> (map paramRangeToValue <$> paramsP) + Field_tags -> ListV <$> (map TagV <$> tagsP ) + Field_author -> StringV <$> singleLineP + Field_comment -> StringV <$> multiLineP_ + +configP :: Parser [Entry] +configP = spaces >> postEOF (many1 entryP) + +-------------------------------------------------------------------------------- + +fromTagV :: Value -> Maybe Tag +fromTagV (TagV tag) = Just tag +fromTagV _ = Nothing + +fromSimpleV :: Value -> Maybe String +fromSimpleV (StringV s) = Just s +fromSimpleV (NumberV x) = Just (show x) +fromSimpleV _ = Nothing + +fromParamV :: Value -> Maybe (String,[String]) +fromParamV (KeyValV kv) = case kv of + MkKeyVal s (ListV list) -> Just (s, mapMaybe fromSimpleV list) + MkKeyVal s value -> (\y -> (s,[y])) <$> fromSimpleV value +fromParamV _ = Nothing + +-- fromParamsV :: Value -> Maybe [(String,[String])] +-- fromParamsV (ListV list) = Just (catMaybes $ fromParamV list) +-- fromParamsV _ = Nothing + +-------------------------------------------------------------------------------- + +type ErrM a = Either String a + +err :: String -> ErrM a +err = Left + +entriesToBenchmark :: [Entry] -> ErrM Benchmark +entriesToBenchmark = entriesToBenchmark' dummyBenchmark + +entriesToBenchmark' :: Benchmark -> [Entry] -> ErrM Benchmark +entriesToBenchmark' oldBenchmark = foldM handle oldBenchmark where + + handle :: Benchmark -> KeyVal CfgField Value -> ErrM Benchmark + handle old (MkKeyVal key val) = case key of + + Field_name -> case val of + StringV s -> return $ old { _benchName = Just s } + _ -> err "unexpected type for field `name`" + + Field_timeout -> case val of + NumberV t -> return $ old { _benchTimeout = MkSeconds (fromInteger t) } + _ -> err "unexpected type for field `timeout`" + + Field_rerun -> case val of + PhaseV p -> return $ old { _benchRerunFrom = p } + _ -> err "unexpected type for field `rerun_from`" + + Field_params -> case val of + ListV list -> return $ old { _benchParams = Map.fromList (mapMaybe fromParamV list) } + _ -> err "unexpected type for field `rparams`" + + Field_tags -> case val of + ListV list -> return $ old { _benchTags = mapMaybe fromTagV list } + _ -> err "unexpected type for field `tags`" + + Field_author -> case val of + StringV s -> return $ old { _benchAuthor = Just s } + _ -> err "unexpected type for field `author`" + + Field_comment -> case val of + StringV s -> return $ old { _benchComment = Just s } + _ -> err "unexpected type for field `comment`" + + _ -> err $ "unknown field " ++ show key + +-------------------------------------------------------------------------------- + +parseConfig :: FilePath -> String -> ErrM Benchmark +parseConfig fpath str = case parse configP fpath str of + Left err -> Left (show err) + Right entries -> entriesToBenchmark entries + +parseConfig_ :: String -> ErrM Benchmark +parseConfig_ = parseConfig "" + +-------------------------------------------------------------------------------- diff --git a/framework/src/Runner.hs b/framework/src/Runner.hs index 381f429..fe6ea7d 100644 --- a/framework/src/Runner.hs +++ b/framework/src/Runner.hs @@ -26,40 +26,7 @@ import System.Process import "time" Data.Time.Clock import "time" Data.Time.Clock.System --------------------------------------------------------------------------------- - -quote :: String -> String -quote str = "`" ++ str ++ "`" - --------------------------------------------------------------------------------- - -data Phase - = Build - | Setup - | Witness - | Run - deriving (Eq,Ord,Show) - -phaseBaseName :: Phase -> FilePath -phaseBaseName phase = case phase of - Build -> "build" - Setup -> "setup" - Witness -> "witness" - Run -> "run" - -parsePhase :: String -> Maybe Phase -parsePhase str = case map toLower str of - "build" -> Just Build - "setup" -> Just Setup - "witness" -> Just Witness - "run" -> Just Run - _ -> Nothing - -phaseScript :: Phase -> FilePath -phaseScript phase = phaseBaseName phase <.> "sh" - -phaseLockFile :: Phase -> FilePath -phaseLockFile phase = phaseBaseName phase <.> "lock" +import Types -------------------------------------------------------------------------------- @@ -70,48 +37,6 @@ createLockFile fpath = do -------------------------------------------------------------------------------- -newtype Params - = MkParams (Map String String) - deriving (Eq,Show) - -mkParams :: [(String,String)] -> Params -mkParams list = MkParams (Map.fromList list) - -extendEnvWithParams :: Params -> [(String,String)] -> [(String,String)] -extendEnvWithParams (MkParams table) oldEnv = newEnv ++ filteredOld where - filteredOld = filter (\pair -> not (fst pair `elem` newKeys)) oldEnv - newKeys = map fst newEnv - newEnv = [ ("ZKBENCH_" ++ key, value) | (key,value) <- Map.toList table ] - --------------------------------------------------------------------------------- - -newtype Seconds a - = MkSeconds a - deriving (Eq,Ord,Show) - -fromSeconds :: Seconds a -> a -fromSeconds (MkSeconds x) = x - --------------------------------------------------------------------------------- - -data Benchmark = MkBenchmark - { _benchDir :: FilePath - , _benchTimeout :: Seconds Int - , _benchRerunFrom :: Phase - , _benchPhases :: [Phase] - , _benchParams :: Params - } - deriving Show - -data Result = MkResult - { _resParams :: !Params - , _resPhase :: !Phase - , _resAvgTime :: !(Seconds Double) - } - deriving Show - --------------------------------------------------------------------------------- - runBenchmark :: Bool -> Benchmark -> IO [Result] runBenchmark rerunAll bench = do origEnv <- getEnvironment diff --git a/framework/src/Types.hs b/framework/src/Types.hs new file mode 100644 index 0000000..90474e8 --- /dev/null +++ b/framework/src/Types.hs @@ -0,0 +1,136 @@ + +-- | Common types + +{-# LANGUAGE PackageImports #-} +module Types where + +-------------------------------------------------------------------------------- + +import Control.Monad + +import Data.Char +import Data.Maybe +import Data.Fixed + +import Data.Map (Map) +import qualified Data.Map as Map + +import System.FilePath + +-------------------------------------------------------------------------------- +-- * Benchmark phases + +data Phase + = Build + | Setup + | Witness + | Run + deriving (Eq,Ord,Show) + +phaseBaseName :: Phase -> FilePath +phaseBaseName phase = case phase of + Build -> "build" + Setup -> "setup" + Witness -> "witness" + Run -> "run" + +parsePhase :: String -> Maybe Phase +parsePhase str = case map toLower str of + "build" -> Just Build + "setup" -> Just Setup + "witness" -> Just Witness + "run" -> Just Run + _ -> Nothing + +phaseScript :: Phase -> FilePath +phaseScript phase = phaseBaseName phase <.> "sh" + +phaseLockFile :: Phase -> FilePath +phaseLockFile phase = phaseBaseName phase <.> "lock" + +-------------------------------------------------------------------------------- +-- * Parameters + +newtype Params + = MkParams (Map String String) + deriving (Eq,Show) + +mkParams :: [(String,String)] -> Params +mkParams list = MkParams (Map.fromList list) + +extendEnvWithParams :: Params -> [(String,String)] -> [(String,String)] +extendEnvWithParams (MkParams table) oldEnv = newEnv ++ filteredOld where + filteredOld = filter (\pair -> not (fst pair `elem` newKeys)) oldEnv + newKeys = map fst newEnv + newEnv = [ ("ZKBENCH_" ++ key, value) | (key,value) <- Map.toList table ] + +-------------------------------------------------------------------------------- +-- * Tags + +-- | Tags are used to select subsets of the benchmarks. +-- +-- A tag can be fixed constant, say @"Groth16"@, or a reference to a +-- parameter, for example @"$PROVER". +-- +data Tag + = FixedTag String + | ParamTag String + deriving (Eq,Show) + +-------------------------------------------------------------------------------- +-- * Time + +newtype Seconds a + = MkSeconds a + deriving (Eq,Ord,Show) + +fromSeconds :: Seconds a -> a +fromSeconds (MkSeconds x) = x + +-------------------------------------------------------------------------------- +-- * Benchmark config + +data Benchmark = MkBenchmark + { _benchDir :: FilePath + , _benchTimeout :: Seconds Int + , _benchRerunFrom :: Phase + , _benchPhases :: [Phase] + , _benchParams :: Map String [String] + , _benchTags :: [Tag] + , _benchName :: Maybe String + , _benchAuthor :: Maybe String + , _benchComment :: Maybe String + } + deriving Show + +dummyBenchmark :: Benchmark +dummyBenchmark = MkBenchmark + { _benchDir = "." + , _benchTimeout = MkSeconds 60 + , _benchRerunFrom = Run + , _benchPhases = [Run] + , _benchParams = Map.empty + , _benchTags = [] + , _benchName = Nothing + , _benchAuthor = Nothing + , _benchComment = Nothing + } + +-------------------------------------------------------------------------------- +-- * Results + +data Result = MkResult + { _resParams :: !Params + , _resPhase :: !Phase + , _resTags :: [Tag] + , _resAvgTime :: !(Seconds Double) + } + deriving Show + +-------------------------------------------------------------------------------- +-- * Misc + +quote :: String -> String +quote str = "`" ++ str ++ "`" + +--------------------------------------------------------------------------------