Skip to content

Commit

Permalink
Speedy computational benchmarks. (digital-asset#6239)
Browse files Browse the repository at this point in the history 
This PR adds some DAML speed benchmarks which focus on the computational aspects of DAML.

The first benchmark is `nfib`. The speed is reported in nfibs/micro-second.

The second benchmark is `json-parser`.  We have a short pipeline: JSON AST is constructed
to represent an arithmetic expression. The AST is converted to its string representation.
The JSON string is then parsed back to AST using the JSON parser (which is defined using
parser combinators defined in the benchmark code). Finally the arithmetic expression
embedded in the JSON AST is evaluated. We report the speed in k-chars/second.

The speed tests are designed to be quick and easy to run. Both tests scale exponentially
in their integer argument, and so are easy to tune so each iteration takes about half a
second. The are run like this:

```
bazel run daml-lf/interpreter/perf:nfib
bazel run daml-lf/interpreter/perf:speed-json-parser
```

For interest, the speeds I see on my dev machine are:

- nfib: 1.35 nfibs/us
- json-parser: 27 k/s

changelog_begin
changelog_end
  • Loading branch information
@nickchapman-da
nickchapman-da authored Jun 5, 2020
1 parent 1c0c304 commit cfa66ec
Show file tree
Hide file tree
Showing 5 changed files with 481 additions and 0 deletions.
57 changes: 57 additions & 0 deletions daml-lf/interpreter/perf/BUILD.bazel
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,3 +49,60 @@ da_scala_binary(
"@maven//:com_google_protobuf_protobuf_java",
],
)

da_scala_binary(
name = "speed-nfib",
srcs = glob([
"src/main/**/LoadDarFunction.scala",
"src/main/**/SpeedTestNfib.scala",
]),
data = [
":Examples.dar",
":Examples.dar.pp",
],
main_class = "com.daml.lf.speedy.explore.SpeedTestNfib",
runtime_deps = [
"@maven//:ch_qos_logback_logback_classic",
],
deps = [
"//bazel_tools/runfiles:scala_runfiles",
"//daml-lf/archive:daml_lf_archive_reader",
"//daml-lf/archive:daml_lf_dev_archive_java_proto",
"//daml-lf/data",
"//daml-lf/interpreter",
"//daml-lf/language",
"//daml-lf/transaction",
"@maven//:com_google_protobuf_protobuf_java",
],
)

daml_compile(
name = "JsonParser",
srcs = glob(["daml/JsonParser.daml"]),
)

da_scala_binary(
name = "speed-json-parser",
srcs = glob([
"src/main/**/LoadDarFunction.scala",
"src/main/**/SpeedTestJsonParser.scala",
]),
data = [
":JsonParser.dar",
":JsonParser.dar.pp",
],
main_class = "com.daml.lf.speedy.explore.SpeedTestJsonParser",
runtime_deps = [
"@maven//:ch_qos_logback_logback_classic",
],
deps = [
"//bazel_tools/runfiles:scala_runfiles",
"//daml-lf/archive:daml_lf_archive_reader",
"//daml-lf/archive:daml_lf_dev_archive_java_proto",
"//daml-lf/data",
"//daml-lf/interpreter",
"//daml-lf/language",
"//daml-lf/transaction",
"@maven//:com_google_protobuf_protobuf_java",
],
)
293 changes: 293 additions & 0 deletions daml-lf/interpreter/perf/daml/JsonParser.daml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,293 @@
-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# OPTIONS_GHC -Wall -Wno-name-shadowing #-}

-- This is not an industial strength JSON parser! (Although it is fairly complete)
-- The DAML code is written for sole intent of having a semi-realistic computationally heavy exmaple.
-- The JSON parser is based on the Crockford grammar: https://www.json.org/json-en.html
-- The parser is written using parser-combinators, following:
-- "Parser combinators need four values to report errors", Andrew Partridge & David Wright

module JsonParser (pipeline) where

import Prelude hiding (null,length)
import DA.List (length)
import DA.Optional (fromSome)
import DA.Text (implode,explode,parseInt)
import qualified DA.Text as Text


-- Pipeline: generate JSON; convert to string; parse; eval
pipeline : Int -> Int
pipeline n = do
let ast0 = nfibJ n -- generate
let res0 = eval ast0
let str = show ast0 -- convert to string
let len = Text.length str
let ast1 = parse str
let res1 = eval ast1
if (res1 /= res0) then error "res1 <> res0" else
len

-- Construct an arithmetic expression for an nfib calculation in JSON
nfibJ : Int -> Json
nfibJ 0 = lit 1
nfibJ 1 = lit 1
nfibJ n = add (lit 1) (add (nfibJ (n-1)) (nfibJ (n-2)))


-- Constructors for JSON rep of simple arithmetic expressions
lit : Int -> Json
lit n = Jobject [("lit", Jnumber n),("extra",Jstring"info")]

add : Json -> Json -> Json
add x y = Jobject [("op", Jarray [x,y]), ("isAdd",Jtrue)]


-- Evaluate JSON represented arithmetic expressions
eval : Json -> Int
eval = \case
Jobject [("lit", Jnumber n),("extra",Jstring _)] -> n
Jobject [("op", Jarray [x,y]), ("isAdd",Jtrue)] -> eval x + eval y
Jobject [("op", Jarray [x,y]), ("isAdd",Jfalse)] -> eval x - eval y
x -> error $ "eval unexpected ast: " <> show x


-- AST for JSON
type Member = (Text,Json)
data Json
= Jobject [Member]
| Jarray [Json]
| Jstring Text
| Jnumber Int
| Jtrue
| Jfalse
| Jnull


-- Convert JSON to a string: Collect all the text chunks and implode them at the end
instance Show Json where
show json = implode (reverse (chunks [] json))

chunks : [Text] -> Json -> [Text]
chunks acc = \case
Jobject [] -> "{}" :: acc
Jobject (x::xs) ->
" }" :: foldl (\acc x -> chunksMember (", " :: acc) x) (chunksMember ("{ " :: acc) x) xs
Jarray [] -> "[]" :: acc
Jarray (x::xs) ->
" ]" :: foldl (\acc x -> chunks (", " :: acc) x) (chunks ("[ " :: acc) x) xs
Jstring s -> show s :: acc
Jnumber n -> show n :: acc
Jtrue -> "true" :: acc
Jfalse -> "false" :: acc
Jnull -> "null" :: acc

where
chunksMember : [Text] -> Member -> [Text]
chunksMember acc (k,v) = chunks (": " :: (show k :: acc)) v


-- Parse a string into JSON
parse : Text -> Json
parse = parseWith json


-- JSON gramar, following: https://www.json.org/json-en.html

json : Par Json
json = do ws; fixP (\element -> recursiveStructure element)

recursiveStructure : Par Json -> Par Json
recursiveStructure element0 = element where

value,object,array,element : Par Json
elements : Par [Json]
members : Par [Member]
member : Par Member

element = do
v <- value
ws; return v

value = alts [object,array,string,number,true,false,null]

object = do
char "{"
ws; ms <- alts [return [], members]
char "}"
return $ Jobject ms

members = commaSeparated member

member = do
s <- str
ws; char ":"
ws; v <- element0
return (s,v)

array = do
char "[";
ws; es <- alts [return [], elements]
char "]";
return $ Jarray es

elements = commaSeparated element0


string,number,true,false,null : Par Json
integer,positive : Par Int
str,characters,character,digit,onenine : Par Text

true = do keyword "true"; return Jtrue
false = do keyword "false"; return Jfalse
null = do keyword "null"; return Jnull

string = Jstring <$> str

str = do
char "\""
cs <- characters
char "\""
return cs

characters = implode <$> many character

character = satisfy $ \c ->
c >= " " && c `notElem` ["\"","\\"] -- escaping not supported

number = Jnumber <$> integer -- fraction/exponent not supported

integer = alts
[ positive
, do char "-"; negate <$> positive
]

positive = (fromSome . parseInt) <$> alts
[ do char "0"; return "0"
, do d <- onenine; ds <- many digit; return (d <> implode ds)
]

digit = satisfy $ \c -> c >= "0" && c <= "9"
onenine = satisfy $ \c -> c >= "1" && c <= "9"


commaSeparated : Par a -> Par [a]
commaSeparated thing = do
x <- thing
xs <- alts [return [], do char ","; ws; commaSeparated thing]
return (x::xs)

ws : Par ()
ws = fixP $ \ws -> alts
[ return ()
, do char " "; ws
, do char "\n"; ws
, do char "\t"; ws
]

keyword : Text -> Par ()
keyword t = chars (explode t)

chars : [Text] -> Par ()
chars [] = return ()
chars (x::xs) = do char x; chars xs

char : Text -> Par ()
char x = do _ <- satisfy (== x); return ()

alts : [Par a] -> Par a
alts = foldl altP failP

many : Par a -> Par [a]
many thing = alts [return [], do x <- thing; xs <- many thing; return (x::xs)]


instance Functor Par where fmap f p = p >>= return . f
instance Applicative Par where pure = retP; (<*>) = ap
instance Action Par where (>>=) = bindP


-- Parser combinators, in continuation passing style.

newtype Par a = Par (forall b. Chars -> K4 a b -> Res b)

runPar : Par a -> Chars -> K4 a b -> Res b
runPar (Par f) = f

type Chars = [Text]

type Res a = Either Chars (a,Chars)

data K4 a b = K4 -- Four continuations:
{ eps : a -> Res b -- success; *no* input consumed
, succ : Chars -> a -> Res b -- success; input consumed
, fail : () -> Res b -- failure; *no* input consumed
, err : Chars -> Res b -- failure; input consumed (so an error!)
}


parseWith : Par a -> Text -> a
parseWith (Par p) input = finalize (p chars kFinal) where

chars = explode input
len = length chars

finalize : Res a -> a
finalize = \case
Left remain -> error $ "failed to parse at position: " <> show (len - length remain)
Right (a,[]) -> a
Right (_,remain) -> error $ "unparsed input remains at: " <> show (len - length remain)

kFinal : K4 x x
kFinal = K4 { eps = \a -> Right (a,chars)
, succ = \chars a -> Right (a,chars)
, fail = \() -> Left chars
, err = \chars -> Left chars
}


fixP : (Par a -> Par a) -> Par a
fixP f = Par (\chars k -> runPar (f (fixP f)) chars k)

retP : a -> Par a
retP x = Par (\_chars K4{eps} -> eps x)

failP : Par a
failP = Par (\_chars K4{fail} -> fail ())

satisfy : (Text -> Bool) -> Par Text
satisfy pred = Par (
\chars K4{succ,fail} -> do
case chars of
[] -> fail ()
x::chars -> if pred x then succ chars x else fail ())

altP : Par a -> Par a -> Par a
altP (Par p1) (Par p2) = Par (
\chars k@K4{eps,succ,err} ->
p1 chars K4{ eps = \a1 -> p2 chars K4{ eps = \_ -> eps a1 -- left biased
, succ
, fail = \() -> eps a1
, err
}
, succ
, fail = \() -> p2 chars k
, err
})

bindP : Par a -> (a -> Par b) -> Par b
bindP (Par p1) f2 = Par (
\chars k@K4{succ,fail,err} ->
p1 chars K4{ eps = \a -> runPar (f2 a) chars k
, succ = \chars a ->
runPar (f2 a) chars K4{ eps = \a -> succ chars a -- consume: eps -> succ
, succ
, fail = \() -> err chars -- consume: fail -> err
, err
}
, fail
, err
})

Loading

0 comments on commit cfa66ec

Please sign in to comment.