mirror of
https://github.com/github/semantic.git
synced 2024-11-28 10:15:55 +03:00
92 lines
4.3 KiB
Haskell
92 lines
4.3 KiB
Haskell
{-# LANGUAGE DataKinds, FlexibleContexts, PackageImports, PartialTypeSignatures, TypeApplications, TypeFamilies #-}
|
|
|
|
module Evaluation (benchmarks) where
|
|
|
|
import Algebra.Graph
|
|
import Control.Monad
|
|
import Control.Carrier.Parse.Simple
|
|
import qualified Data.Duration as Duration
|
|
import Data.Abstract.Evaluatable
|
|
import Data.Abstract.FreeVariables
|
|
import Data.Blob
|
|
import Data.Blob.IO (readBlobFromFile')
|
|
import Data.Bifunctor
|
|
import Data.Functor.Classes
|
|
import Data.Functor.Foldable (Base, Recursive)
|
|
import "semantic" Data.Graph (Graph (..), topologicalSort)
|
|
import Data.Graph.ControlFlowVertex
|
|
import qualified Data.Language as Language
|
|
import Data.Project
|
|
import Data.Proxy
|
|
import Data.Term
|
|
import Gauge.Main
|
|
import Parsing.Parser
|
|
import Semantic.Config (defaultOptions)
|
|
import Semantic.Graph
|
|
import Semantic.Task (SomeException, TaskSession (..), runTask, withOptions)
|
|
import Semantic.Util
|
|
import Source.Loc
|
|
import Source.Span (HasSpan)
|
|
import qualified System.Path as Path
|
|
import System.Path ((</>))
|
|
|
|
-- Duplicating this stuff from Util to shut off the logging
|
|
|
|
callGraphProject' :: ( Language.SLanguage lang
|
|
, HasPrelude lang
|
|
, AccessControls (term Loc)
|
|
, Declarations (term Loc)
|
|
, Evaluatable (Base (term Loc))
|
|
, FreeVariables (term Loc)
|
|
, HasSpan (term Loc)
|
|
, Ord (term Loc)
|
|
, Recursive (term Loc)
|
|
, Show (term Loc)
|
|
, VertexDeclaration term
|
|
)
|
|
=> TaskSession
|
|
-> Proxy lang
|
|
-> Parser (term Loc)
|
|
-> Path.RelFile
|
|
-> IO (Either String (Data.Graph.Graph ControlFlowVertex))
|
|
callGraphProject' session proxy parser path = fmap (first show) . runTask session $ do
|
|
blob <- readBlobFromFile' (fileForTypedPath path)
|
|
package <- fmap snd <$> runParse (Duration.fromSeconds 10) (parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] (Language.reflect proxy) []))
|
|
modules <- topologicalSort <$> runImportGraphToModules proxy package
|
|
runCallGraph proxy False modules package
|
|
|
|
callGraphProject proxy parser paths = withOptions defaultOptions $ \ config logger statter ->
|
|
callGraphProject' (TaskSession config "" False logger statter) proxy parser paths
|
|
|
|
evalRubyProject = evaluateProject (Proxy @'Language.Ruby) rubyParser
|
|
evalPythonProject = evaluateProject (Proxy @'Language.Python) pythonParser
|
|
|
|
evaluateProject proxy parser path = withOptions defaultOptions $ \ config logger statter ->
|
|
justEvaluating =<< evaluateProject' (TaskSession config "" False logger statter) proxy parser [Path.toString path]
|
|
|
|
pyEval :: Path.RelFile -> Benchmarkable
|
|
pyEval p = nfIO $ () <$ evalPythonProject (Path.relDir "bench/bench-fixtures/python" </> p)
|
|
|
|
rbEval :: Path.RelFile -> Benchmarkable
|
|
rbEval p = nfIO $ () <$ evalRubyProject (Path.relDir "bench/bench-fixtures/python" </> p)
|
|
|
|
pyCall :: Path.RelFile -> Benchmarkable
|
|
pyCall p = nfIO $ callGraphProject (Proxy @'Language.Python) pythonParser (Path.relDir "bench/bench-fixtures/python/" </> p)
|
|
|
|
rbCall :: Path.RelFile -> Benchmarkable
|
|
rbCall p = nfIO $ callGraphProject (Proxy @'Language.Ruby) rubyParser $ (Path.relDir "bench/bench-fixtures/ruby" </> p)
|
|
|
|
benchmarks :: Benchmark
|
|
benchmarks = bgroup "evaluation"
|
|
[ bgroup "python" [ bench "assignment" . pyEval $ Path.relFile "simple-assignment.py"
|
|
, bench "function def" . pyEval $ Path.relFile "function-definition.py"
|
|
, bench "if + function calls" . pyCall . Path.relFile $ "if-statement-functions.py"
|
|
, bench "call graph" $ pyCall . Path.relFile $ "if-statement-functions.py"
|
|
]
|
|
, bgroup "ruby" [ bench "assignment" . rbEval $ Path.relFile "simple-assignment.rb"
|
|
, bench "function def" . rbEval . Path.relFile $ "function-definition.rb"
|
|
, bench "if + function calls" . rbCall $ Path.relFile "if-statement-functions.rb"
|
|
, bench "call graph" $ rbCall $ Path.relFile "if-statement-functions.rb"
|
|
]
|
|
]
|