Memory/time benchmarks

* added memory/time benchmarks and a command line 'bench.py' utility for
  comparing benchmarks over multiple commits
* added a couple of parsers to the tests and fixed spans on parsing blocks
* added a 'Reversed' data type for efficient appending, for later use in the parser

Author: harpocrates

bench.py

@@ -0,0 +1,113 @@
+#!/usr/bin/env python3
+
+import json
+import sys
+import subprocess
+import tabulate
+import argparse
+
+def merge(dict1, dict2, def1, def2, func):
+    """Merge two nested dictionaries, using default values when it makes sense"""
+    assert isinstance(dict1, dict)
+    assert isinstance(dict2, dict)
+
+    toReturn = {}
+    keys1 = set(dict1.keys())
+    keys2 = set(dict2.keys())
+
+    for key in keys1 | keys2:  # change this to |
+        val1 = dict1.get(key, None)
+        val2 = dict2.get(key, None)
+
+        if isinstance(val1,dict) or isinstance(val2,dict):
+            toReturn[key] = merge(val1 or {}, val2 or {}, def1, def2, func)
+        else:
+            toReturn[key] = func(val1 or def1, val2 or def2)
+
+    return toReturn
+
+
+def flattenListDict(d, indent=0):
+    """Flatten a nested dictionary into a list of lists representing a table"""
+    assert isinstance(d, dict)
+    result = []
+    for k,v in d.items():
+        assert isinstance(k, str)
+        if isinstance(v, list):
+            first = None
+            row = []
+            for entry in v:
+                if entry:
+                    if first:
+                        percentDiff = 100 * (float(entry) - first) / first
+                        color = '\033[92m' if percentDiff > -1.0 else '\033[91m'
+                        row.append("%s%2.1f%s" % (color, percentDiff, '%\033[0m'))
+                    else:
+                        first = float(entry)
+                        row.append(entry)
+                else:
+                    row.append(entry)
+
+            result.append([ '.' * indent + k ] + row)
+        elif isinstance(v, dict):
+            result.append([ '.' * indent + k ])
+            result.extend(flattenListDict(v, indent + 2))
+        else:
+            raise "List dict can only contain lists or other list dicts"
+    return result
+
+# Currently not used...
+def fmtSize(num):
+    for unit in ['','KB','MB','GB','TB','PB','EB','ZB']:
+        if abs(num) < 1024.0:
+            return "%3.1f%s" % (num, unit)
+        num /= 1024.0
+    return "%.1f%s%s" % (num, 'YB', suffix)
+
+
+if __name__ == "__main__":
+    # Argument parser
+    parser = argparse.ArgumentParser()
+    parser.add_argument('--folder',           default='.', type=str, help='benchmark folder to analyze')
+    parser.add_argument('--last',  nargs='?', default=5,   type=int, help='include benchmarks for the last "n" commits')
+    parser.add_argument('--exact', nargs='*', default=[],  type=str, help='include benchmarks for specific commits')
+    parsed = parser.parse_args(sys.argv[1:])
+
+    # Commits
+    commits = ["WIP", "HEAD"]
+    if parsed.last:
+        commits.extend([ "HEAD~" + str(i) for i in range(1,parsed.last) ])
+    if parsed.exact:
+        commits.extend([ str(commit) for commit in parsed.exact ])
+
+    # Sanitized commits
+    sanitized = ["WIP"]
+    for commit in commits[1:]:
+        try:
+            c = subprocess.check_output(["git", "rev-parse", commit]).decode("utf-8").strip()
+            sanitized.append(c)
+        except:
+            print('Invalid commit "' + commit + '"')
+
+    # Load the JSONs
+    datas = []
+    for sane in sanitized:
+        try:
+            with open(parsed.folder + '/' + sane + '.json') as json_data:
+                datas.append(json.load(json_data))
+        except:
+            print('Could not read file for "' + sane + '.json"')
+            datas.append({})
+
+    # Aggregate the output
+    aggregated = {}
+    n = 0
+    for data in datas:
+        aggregated = merge(aggregated, data, n * [ None ], None, lambda xs, x: xs + [x])
+        n += 1
+
+    # Convert to a table
+    print(tabulate.tabulate(flattenListDict(aggregated), [ '' ] + commits))
+
+
+

benchmarks/allocation-benchmarks/Main.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Weigh
+
+import Control.Monad (filterM)
+import Data.Foldable (traverse_)
+import GHC.Exts (fromString)
+
+import Language.Rust.Parser (parseSourceFile')
+
+import System.Directory (getCurrentDirectory, listDirectory, createDirectoryIfMissing, doesFileExist)
+import System.FilePath ((</>), (<.>), takeFileName)
+import System.Process (proc, readCreateProcess)
+
+import Data.Aeson
+import qualified Data.ByteString.Lazy as BL
+
+-- TODO:
+-- Only allocation and GCs seem to be really reproducible. Live and max sometimes are 0.
+
+main :: IO ()
+main = do
+  -- Open the output log file
+  status <- readCreateProcess (proc "git" ["status", "--porcelain"]) ""
+  logFileName <- case status of
+                   "" -> init <$> readCreateProcess (proc "git" ["rev-parse", "HEAD"]) ""
+                   _ -> pure "WIP"
+  
+  -- Get the test cases
+  workingDirectory <- getCurrentDirectory
+  let sampleSources = workingDirectory </> "sample-sources"
+  entries <- map (sampleSources </>) <$> listDirectory sampleSources
+  files <- filterM doesFileExist entries
+
+  -- Run 'weigh' tests
+  let weigh = setColumns [ Case, Max, Allocated, GCs, Live ] >> traverse_ (\f -> io (takeFileName f) parseSourceFile' f) files
+  mainWith weigh
+  (wr, _) <- weighResults weigh
+  let results = object [ case maybeErr of
+                           Nothing -> key .= object [ "allocated" .= weightAllocatedBytes weight
+--                                                    , "max"       .= weightMaxBytes w
+--                                                    , "live"      .= weightLiveBytes w
+--                                                    , "GCs"       .= weightGCs w
+                                                    ]
+                           Just err -> key .= String (fromString err)
+                       | (weight, maybeErr) <- wr
+                       , let key = fromString (weightLabel weight)
+                       ]
+
+  -- Save the output to JSON
+  createDirectoryIfMissing False (workingDirectory </> "allocations")
+  let logFile = workingDirectory </> "allocations" </> logFileName <.> "json"
+  logFile `BL.writeFile` encode results
+

benchmarks/timing-benchmarks/Main.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Criterion
+import Criterion.Types (anMean, reportAnalysis)
+import Statistics.Resampling.Bootstrap (Estimate(..))
+
+import Control.Monad (filterM)
+import Data.Traversable (for)
+import GHC.Exts (fromString)
+
+import Language.Rust.Parser (parseSourceFile')
+
+import System.Directory (getCurrentDirectory, listDirectory, createDirectoryIfMissing, doesFileExist)
+import System.FilePath ((</>), (<.>), takeFileName)
+import System.Process (proc, readCreateProcess)
+
+import Data.Aeson
+import qualified Data.ByteString.Lazy as BL
+
+main :: IO ()
+main = do
+  -- Open the output log file
+  status <- readCreateProcess (proc "git" ["status", "--porcelain"]) ""
+  logFileName <- case status of
+                   "" -> init <$> readCreateProcess (proc "git" ["rev-parse", "HEAD"]) ""
+                   _ -> pure "WIP"
+  
+  -- Get the test cases
+  workingDirectory <- getCurrentDirectory
+  let sampleSources = workingDirectory </> "sample-sources"
+  entries <- map (sampleSources </>) <$> listDirectory sampleSources
+  files <- filterM doesFileExist entries
+
+  -- Run 'criterion' tests
+  reports <- for files $ \f -> do
+    let name = takeFileName f
+    putStrLn name
+    bnch <- benchmark' (nfIO (parseSourceFile' f))
+    pure (name, bnch)
+  let results = object [ fromString name .= object [ "mean" .= m
+                                                   , "lower bound" .= l
+                                                   , "upper bound" .= u
+                                                   ]
+                       | (name,report) <- reports
+                       , let Estimate m l u _ = anMean (reportAnalysis report)
+                       ]
+
+  -- Save the output to JSON
+  createDirectoryIfMissing False (workingDirectory </> "timings")
+  let logFile = workingDirectory </> "timings" </> logFileName <.> "json"
+  logFile `BL.writeFile` encode results
+

language-rust.cabal

@@ -46,6 +46,7 @@ library
 
   other-modules:       Language.Rust.Parser.Internal
                        Language.Rust.Parser.Literals
+                       Language.Rust.Parser.Reversed
                        Language.Rust.Pretty.Resolve
                        Language.Rust.Syntax.AST
                        Language.Rust.Syntax.Ident
@@ -63,6 +64,7 @@ library
                      , wl-pprint-annotated >=0.1.0.0 && <0.2.0.0
                      , transformers >=0.5 && <0.6
                      , array >=0.5 && <0.6
+                     , deepseq >=1.4.2.0
 
   if flag(useByteStrings)
     build-depends:     utf8-string >=1.0
@@ -85,8 +87,6 @@ test-suite unit-tests
   type:                exitcode-stdio-1.0
   default-language:    Haskell2010
   build-depends:       base >=4.9 && <5.0
-                     , Cabal >= 1.10.0
-                     , transformers >=0.5 && <0.6
                      , HUnit >=1.5.0.0
                      , wl-pprint-annotated >=0.1.0.0 && <0.2.0.0
                      , test-framework >=0.8.0
@@ -102,15 +102,45 @@ test-suite rustc-tests
   type:                exitcode-stdio-1.0
   default-language:    Haskell2010
   build-depends:       base >=4.9 && <5.0
-                     , Cabal >= 1.10.0
                      , process >= 1.3
                      , bytestring >=0.10
                      , aeson >= 1.0.0.0
                      , directory >= 1.3.0.0
                      , filepath >= 1.4.0.0
-                     , transformers >=0.5 && <0.6
                      , test-framework >=0.8.0
                      , vector >=0.10.0
                      , text >=1.2.0
                      , unordered-containers >= 0.2.7
                      , language-rust
+
+benchmark timing-benchmarks
+  hs-source-dirs:      benchmarks/timing-benchmarks
+  ghc-options:         -Wall
+  main-is:             Main.hs
+  type:                exitcode-stdio-1.0
+  default-language:    Haskell2010
+  build-depends:       base >=4.9 && <5.0
+                     , process >= 1.3
+                     , bytestring >=0.10
+                     , directory >= 1.3.0.0
+                     , filepath >= 1.4.0.0
+                     , language-rust
+                     , criterion >=1.1.1.0
+                     , statistics
+                     , aeson >= 1.0.0.0
+
+benchmark allocation-benchmarks
+  hs-source-dirs:      benchmarks/allocation-benchmarks
+  ghc-options:         -Wall
+  main-is:             Main.hs
+  type:                exitcode-stdio-1.0
+  default-language:    Haskell2010
+  build-depends:       base >=4.9 && <5.0
+                     , process >= 1.3
+                     , bytestring >=0.10
+                     , directory >= 1.3.0.0
+                     , filepath >= 1.4.0.0
+                     , language-rust
+                     , weigh >=0.0.4
+                     , aeson >= 1.0.0.0
+

sample-sources/items.rs

@@ -16,7 +16,7 @@ mod bar {
 
   extern { }
   extern "C" {
-    fn foo(x: int) -> int;
+    fn foo<T>(x: int) -> int;
     static x: int;
     static mut x: *mut int;
   }

src/Language/Rust/Data/Position.hs

@@ -9,7 +9,7 @@ Portability : portable
 
 Everything to do with describing a position or a contiguous region in a file.
 -}
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, CPP, DeriveAnyClass #-}
 
 module Language.Rust.Data.Position (
   -- * Positions in files
@@ -21,6 +21,7 @@ module Language.Rust.Data.Position (
 import GHC.Generics (Generic)
 import Data.Data (Data)
 import Data.Typeable (Typeable)
+import Control.DeepSeq (NFData)
 
 import Data.Ord (comparing)
 import Data.List (maximumBy, minimumBy)
@@ -37,7 +38,7 @@ data Position = Position {
     col :: {-# UNPACK #-} !Int             -- ^ column in the source file.
   }
   | NoPosition
-  deriving (Eq, Show, Data, Typeable, Generic)
+  deriving (Eq, Show, Data, Typeable, Generic, NFData)
 
 -- | Pretty print a 'Position'
 prettyPosition :: Position -> String
@@ -98,7 +99,7 @@ data Span = Span {
 #else
     lo, hi ::                !Position
 #endif
-  } deriving (Eq, Show, Data, Typeable, Generic)
+  } deriving (Eq, Show, Data, Typeable, Generic, NFData)
 
 -- | Check if a span is a subset of another span
 subsetOf :: Span -> Span -> Bool
@@ -121,7 +122,7 @@ prettySpan :: Span -> String
 prettySpan (Span lo' hi') = show lo' ++ " - " ++ show hi'
 
 -- | A "tagging" of something with a 'Span' that describes its extent.
-data Spanned a = Spanned { unspan :: a, span :: {-# UNPACK #-} !Span } deriving (Data, Typeable, Generic)
+data Spanned a = Spanned { unspan :: a, span :: {-# UNPACK #-} !Span } deriving (Data, Typeable, Generic, NFData)
 
 instance Functor Spanned where
   fmap f (Spanned x s) = Spanned (f x) s

src/Language/Rust/Parser.hs

@@ -23,7 +23,7 @@ sourceFile :: SourceFile Span
 
 module Language.Rust.Parser (
   -- * Parsing
-  parse, parse', Parse(..), P, execParser, initPos, Span,
+  parse, parse', parseSourceFile', Parse(..), P, execParser, initPos, Span,
   -- * Lexing
   lexToken, lexNonSpace, lexTokens, translateLit,
   -- * Input stream
@@ -55,6 +55,10 @@ parse' is = case execParser parser is initPos of
               Left (pos, msg) -> throw (ParseFail pos msg)
               Right x -> x
 
+-- | Given a path pointing to a Rust source file, read that file and parse it into a 'SourceFile'
+parseSourceFile' :: FilePath -> IO (SourceFile Span)
+parseSourceFile' fileName = parse' <$> readInputStream fileName
+
 -- | Exceptions that occur during parsing
 data ParseFail = ParseFail Position String deriving (Eq, Typeable)
 
@@ -70,6 +74,7 @@ class Parse a where
 
 instance Parse (Lit Span) where parser = parseLit
 instance Parse (Attribute Span) where parser = parseAttr
+instance Parse (Arg Span) where parser = parseArg
 instance Parse (Ty Span) where parser = parseTy 
 instance Parse (Pat Span) where parser = parsePat
 instance Parse (Expr Span) where parser = parseExpr