{-# 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 "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 hiding (evalPythonProject, evalRubyProject, evaluateProject) import Source.Loc import qualified System.Path as Path import System.Path (()) -- Duplicating this stuff from Util to shut off the logging callGraphProject' :: ( Language.SLanguage lang , Ord1 (Syntax term) , Declarations1 (Syntax term) , Evaluatable (Syntax term) , FreeVariables1 (Syntax term) , AccessControls1 (Syntax term) , HasPrelude lang , IsTerm term , Functor (Syntax term) , VertexDeclaration1 (Syntax 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 = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Ruby) rubyParser evalPythonProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Python) pythonParser evaluateProject proxy parser path = withOptions defaultOptions $ \ config logger statter -> 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" ] ]