start on benchmarking (parsers)

.github/workflows/ci.yml

@@ -198,3 +198,34 @@ jobs:
         path: "C:/cabal/bin/${{ env.EXE_NAME }}.exe"
         name: ${{ env.EXE_NAME }}-windows-ghc-${{ matrix.ghc }}-cabal-${{ github.sha }}.exe
         if-no-files-found: error
+
+  ubuntu-stack-bench:
+    runs-on: ubuntu-latest
+    name: Ubuntu / Stack / benchmark
+    steps:
+    - uses: actions/checkout@v2
+
+    # relative paths are relative to the project directory
+    - name: Cache Stack build artifacts (user + project)
+      uses: actions/cache@v2
+      with:
+        path: |
+          ~/.stack
+          .stack-work
+        # best effort for cache: tie it to Stack resolver and package config
+        key: ${{ runner.os }}-stack-${{ hashFiles('stack.yaml.lock', 'package.yaml') }}
+        restore-keys: |
+          ${{ runner.os }}-stack
+
+    - name: Build benchmarks
+      run: stack build --bench --no-run-benchmarks
+
+    # the weird piping is for copying STDERR
+    - name: Run benchmarks
+      run: stack --no-terminal bench 2> >(tee bench.log >&2)
+
+    - name: Archive benchmark log
+      uses: actions/upload-artifact@v2
+      with:
+        name: benchmark-log-ubuntu-stack.txt
+        path: bench.log

bench/Bench.hs

@@ -0,0 +1,119 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import           Criterion.Main
+
+import qualified Language.Fortran.Parser                as Parser
+import           Language.Fortran.Version
+import           Language.Fortran.AST
+import qualified Language.Fortran.Parser.Free.Fortran90 as F90
+
+import           Data.ByteString (ByteString)
+import qualified Data.Text                      as Text
+import qualified Data.Text.Encoding             as Text
+import           Data.List (intercalate)
+
+main :: IO ()
+main = defaultMain
+  [ bgroup "parser"
+      [ bgroup "Fortran 90"
+          [ bench "statement (expr)" $ whnf pF90Stmt snippetFreeStmtExpr
+          , bench "statement (assign)" $ whnf pF90Stmt snippetFreeStmtDeclAssign
+          , bench "function" $ whnf pF90Func snippetFreeFunc
+          , bench "ProgramFile (default transformations)" $ whnf pF90pfDefTs snippetFreePF
+          , bench "ProgramFile (no transformations)" $ whnf pF90pfNoTs snippetFreePF
+          ]
+      , bgroup "Fortran 77"
+          [ bench "statement (expr)" $ whnf pF77Stmt snippetFixedStmt
+          --, bench "function" $ whnf pF77Func snippetFixedFunc
+          , bench "ProgramFile (default transformations)" $ whnf pF77pfDefTs snippetFixedPF
+          , bench "ProgramFile (no transformations)" $ whnf pF77pfNoTs snippetFixedPF
+          ]
+      , bgroup "Fortran 66"
+          [ bench "statement (expr)" $ whnf pF66Stmt snippetFixedStmt
+          -- , bench "function" $ whnf pF66Func snippetFixedFunc
+          --, bench "ProgramFile (default transformations)" $ whnf pF66pfDefTs snippetFixedPF
+          --, bench "ProgramFile (no transformations)" $ whnf pF66pfNoTs snippetFixedPF
+          ]
+      ]
+  ]
+
+--------------------------------------------------------------------------------
+
+pF90Stmt :: ByteString -> Statement A0
+pF90Stmt = Parser.parseUnsafe $ Parser.makeParserFree F90.statementParser Fortran90
+
+pF90Func = undefined
+pF90pfDefTs = undefined
+pF90pfNoTs = undefined
+pF77Stmt = undefined
+pF77pfDefTs = undefined
+pF77pfNoTs = undefined
+pF66Stmt = undefined
+
+--------------------------------------------------------------------------------
+
+snippetFreeStmtExpr :: ByteString
+snippetFreeStmtExpr = programListing $
+  [ "x = y*2 + z - 1"
+  ]
+
+snippetFreeStmtDeclAssign :: ByteString
+snippetFreeStmtDeclAssign = programListing $
+  [ "character(5) :: assign_in_decl*5 = \"test!\""
+  ]
+
+snippetFreeFunc :: ByteString
+snippetFreeFunc = programListing $
+  [ "integer function f(x, y, z) result(i)"
+  , "  print *, i"
+  , "  i = (i - 1)"
+  , "end function f"
+  ]
+
+snippetFreePF :: ByteString
+snippetFreePF = programListing $
+  [ "integer function f(x, y, z) result(i)"
+  , "  print *, i"
+  , "  i = (i - 1)"
+  , "end function f"
+  , ""
+  , "program main"
+  , "  x = 1 + 2"
+  , "end program main"
+  ]
+
+--------------------------------------------------------------------------------
+
+snippetFixedStmt :: ByteString
+snippetFixedStmt = programListing $
+  [ "      x = y*2 + z - 1"
+  ]
+
+snippetFixedFunc :: ByteString
+snippetFixedFunc = programListing $
+  [ "      subroutine f(x, y, z)"
+  , "      print *, i"
+  , "      i = (i - 1)"
+  , "      end"
+  ]
+
+snippetFixedPF :: ByteString
+snippetFixedPF = programListing $
+  [ "      subroutine f(x, y, z)"
+  , "        print *, i"
+  , "        i = (i - 1)"
+  , "      end"
+  , ""
+  , "      program main"
+  , "        x = 1 + 2"
+  , "      end"
+  ]
+
+--------------------------------------------------------------------------------
+
+-- | unlines but without the trailing newline
+programListing :: [String] -> ByteString
+programListing = strToByteString . intercalate "\n"
+
+strToByteString :: String -> ByteString
+strToByteString = Text.encodeUtf8 . Text.pack

bench/issue-190.f

@@ -0,0 +1,4 @@
+      subroutine main
+      integer*1 x, int1, a1, a2, a3, a4, a5, a6, a7, a8, a9
+      x = INT(int1, 2)
+      end

fortran-src.cabal

@@ -269,3 +269,51 @@ test-suite spec
     , text >=1.2 && <2
     , uniplate >=1.6 && <2
   default-language: Haskell2010
+
+benchmark bench
+  type: exitcode-stdio-1.0
+  main-is: Bench.hs
+  other-modules:
+      Paths_fortran_src
+  hs-source-dirs:
+      bench
+  default-extensions:
+      EmptyCase
+      FlexibleContexts
+      FlexibleInstances
+      InstanceSigs
+      MultiParamTypeClasses
+      PolyKinds
+      LambdaCase
+      DerivingStrategies
+      StandaloneDeriving
+      DeriveAnyClass
+      DeriveGeneric
+      DeriveDataTypeable
+      DeriveFunctor
+      DeriveFoldable
+      DeriveTraversable
+      DeriveLift
+      BangPatterns
+      TupleSections
+  ghc-options: -Wall
+  build-depends:
+      GenericPretty >=1.2.2 && <2
+    , array ==0.5.*
+    , base >=4.6 && <5
+    , binary >=0.8.3.0 && <0.11
+    , bytestring >=0.10 && <0.12
+    , containers >=0.5 && <0.7
+    , criterion ==1.5.*
+    , deepseq ==1.4.*
+    , directory >=1.2 && <2
+    , either >=5.0.1.1 && <5.1
+    , fgl ==5.*
+    , filepath ==1.4.*
+    , fortran-src
+    , mtl >=2.2 && <3
+    , pretty >=1.1 && <2
+    , temporary >=1.2 && <1.4
+    , text >=1.2 && <2
+    , uniplate >=1.6 && <2
+  default-language: Haskell2010

package.yaml

@@ -96,3 +96,11 @@ tests:
     - deepseq >=1.4 && <1.5
     - hspec >=2.2 && <3
     - QuickCheck >=2.10 && <2.15
+
+benchmarks:
+  bench:
+    main: Bench.hs
+    source-dirs: bench
+    dependencies:
+    - fortran-src
+    - criterion >= 1.5 && <1.6