mirror of
https://github.com/github/semantic.git
synced 2025-01-06 23:46:21 +03:00
save characters on the typechecking functions
This commit is contained in:
parent
2b99769c20
commit
77d7b93f58
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE Rank2Types, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
|
{-# LANGUAGE ConstraintKinds, Rank2Types, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
|
||||||
{-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-export-lists #-}
|
{-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-export-lists #-}
|
||||||
module Semantic.Util where
|
module Semantic.Util where
|
||||||
|
|
||||||
@ -324,101 +324,65 @@ evalJavaScriptProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Lang
|
|||||||
evalTypeScriptProject :: FileEvaluator Language.TypeScript.Assignment.Syntax
|
evalTypeScriptProject :: FileEvaluator Language.TypeScript.Assignment.Syntax
|
||||||
evalTypeScriptProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.TypeScript) typescriptParser
|
evalTypeScriptProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.TypeScript) typescriptParser
|
||||||
|
|
||||||
|
type FileTypechecker (syntax :: [* -> *]) qterm value address result
|
||||||
|
= FilePath
|
||||||
|
-> IO
|
||||||
|
(Heap
|
||||||
|
address
|
||||||
|
address
|
||||||
|
value,
|
||||||
|
(ScopeGraph
|
||||||
|
address,
|
||||||
|
(Cache
|
||||||
|
qterm
|
||||||
|
address
|
||||||
|
value,
|
||||||
|
[Either
|
||||||
|
(SomeError
|
||||||
|
(Sum
|
||||||
|
'[BaseError
|
||||||
|
Type.TypeError,
|
||||||
|
BaseError
|
||||||
|
(AddressError
|
||||||
|
address
|
||||||
|
value),
|
||||||
|
BaseError
|
||||||
|
(EvalError
|
||||||
|
qterm
|
||||||
|
address
|
||||||
|
value),
|
||||||
|
BaseError
|
||||||
|
ResolutionError,
|
||||||
|
BaseError
|
||||||
|
(HeapError
|
||||||
|
address),
|
||||||
|
BaseError
|
||||||
|
(ScopeError
|
||||||
|
address),
|
||||||
|
BaseError
|
||||||
|
(UnspecializedError
|
||||||
|
address
|
||||||
|
value),
|
||||||
|
BaseError
|
||||||
|
(LoadError
|
||||||
|
address
|
||||||
|
value)]))
|
||||||
|
result])))
|
||||||
|
|
||||||
typecheckGoFile :: ( syntax ~ Language.Go.Assignment.Syntax
|
typecheckGoFile :: ( syntax ~ Language.Go.Assignment.Syntax
|
||||||
, qterm ~ Quieterm (Sum syntax) Location
|
, qterm ~ Quieterm (Sum syntax) Location
|
||||||
, value ~ Type
|
, value ~ Type
|
||||||
, address ~ Monovariant
|
, address ~ Monovariant
|
||||||
, result ~ (ModuleTable (Module (ModuleResult address value)))) => FilePath
|
, result ~ (ModuleTable (Module (ModuleResult address value))))
|
||||||
-> IO
|
=> FileTypechecker syntax qterm value address result
|
||||||
(Heap
|
|
||||||
address
|
|
||||||
address
|
|
||||||
value,
|
|
||||||
(ScopeGraph
|
|
||||||
address,
|
|
||||||
(Cache
|
|
||||||
qterm
|
|
||||||
address
|
|
||||||
value,
|
|
||||||
[Either
|
|
||||||
(SomeError
|
|
||||||
(Sum
|
|
||||||
'[BaseError
|
|
||||||
Type.TypeError,
|
|
||||||
BaseError
|
|
||||||
(AddressError
|
|
||||||
address
|
|
||||||
value),
|
|
||||||
BaseError
|
|
||||||
(EvalError
|
|
||||||
qterm
|
|
||||||
address
|
|
||||||
value),
|
|
||||||
BaseError
|
|
||||||
ResolutionError,
|
|
||||||
BaseError
|
|
||||||
(HeapError
|
|
||||||
address),
|
|
||||||
BaseError
|
|
||||||
(ScopeError
|
|
||||||
address),
|
|
||||||
BaseError
|
|
||||||
(UnspecializedError
|
|
||||||
address
|
|
||||||
value),
|
|
||||||
BaseError
|
|
||||||
(LoadError
|
|
||||||
address
|
|
||||||
value)]))
|
|
||||||
result])))
|
|
||||||
typecheckGoFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Go) goParser
|
typecheckGoFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Go) goParser
|
||||||
|
|
||||||
typecheckRubyFile :: ( syntax ~ Language.Ruby.Assignment.Syntax
|
typecheckRubyFile :: ( syntax ~ Language.Ruby.Assignment.Syntax
|
||||||
, qterm ~ Quieterm (Sum syntax) Location
|
, qterm ~ Quieterm (Sum syntax) Location
|
||||||
, value ~ Type
|
, value ~ Type
|
||||||
, address ~ Monovariant
|
, address ~ Monovariant
|
||||||
, result ~ (ModuleTable (Module (ModuleResult address value)))) => FilePath
|
, result ~ (ModuleTable (Module (ModuleResult address value))))
|
||||||
-> IO
|
=> FileTypechecker syntax qterm value address result
|
||||||
(Heap
|
|
||||||
address
|
|
||||||
address
|
|
||||||
value,
|
|
||||||
(ScopeGraph
|
|
||||||
address,
|
|
||||||
(Cache
|
|
||||||
qterm
|
|
||||||
address
|
|
||||||
value,
|
|
||||||
[Either
|
|
||||||
(SomeError
|
|
||||||
(Sum
|
|
||||||
'[BaseError
|
|
||||||
Type.TypeError,
|
|
||||||
BaseError
|
|
||||||
(AddressError
|
|
||||||
address
|
|
||||||
value),
|
|
||||||
BaseError
|
|
||||||
(EvalError
|
|
||||||
qterm
|
|
||||||
address
|
|
||||||
value),
|
|
||||||
BaseError
|
|
||||||
ResolutionError,
|
|
||||||
BaseError
|
|
||||||
(HeapError
|
|
||||||
address),
|
|
||||||
BaseError
|
|
||||||
(ScopeError
|
|
||||||
address),
|
|
||||||
BaseError
|
|
||||||
(UnspecializedError
|
|
||||||
address
|
|
||||||
value),
|
|
||||||
BaseError
|
|
||||||
(LoadError
|
|
||||||
address
|
|
||||||
value)]))
|
|
||||||
result])))
|
|
||||||
typecheckRubyFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Ruby) rubyParser
|
typecheckRubyFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Ruby) rubyParser
|
||||||
|
|
||||||
callGraphProject parser proxy paths = runTask' $ do
|
callGraphProject parser proxy paths = runTask' $ do
|
||||||
@ -445,28 +409,29 @@ type EvalEffects qterm = ResumableC (BaseError (ValueError qterm Precise))
|
|||||||
(Eff (TraceByPrintingC
|
(Eff (TraceByPrintingC
|
||||||
(Eff (LiftC IO))))))))))))))))))))))))
|
(Eff (LiftC IO))))))))))))))))))))))))
|
||||||
|
|
||||||
|
type LanguageSyntax lang syntax = ( Language.SLanguage lang
|
||||||
|
, HasPrelude lang
|
||||||
|
, Apply Eq1 syntax
|
||||||
|
, Apply Ord1 syntax
|
||||||
|
, Apply Show1 syntax
|
||||||
|
, Apply Functor syntax
|
||||||
|
, Apply Foldable syntax
|
||||||
|
, Apply Evaluatable syntax
|
||||||
|
, Apply Declarations1 syntax
|
||||||
|
, Apply AccessControls1 syntax
|
||||||
|
, Apply FreeVariables1 syntax)
|
||||||
|
|
||||||
evaluateProject :: ( term ~ Term (Sum syntax) Location
|
evaluateProject :: ( term ~ Term (Sum syntax) Location
|
||||||
, qterm ~ Quieterm (Sum syntax) Location
|
, qterm ~ Quieterm (Sum syntax) Location
|
||||||
, Language.SLanguage lang
|
, LanguageSyntax lang syntax
|
||||||
, HasPrelude lang
|
)
|
||||||
, Apply Eq1 syntax
|
=> Proxy lang
|
||||||
, Apply Ord1 syntax
|
-> Parser term
|
||||||
, Apply Show1 syntax
|
-> [FilePath]
|
||||||
, Apply Functor syntax
|
-> IO (Evaluator qterm Precise
|
||||||
, Apply Foldable syntax
|
(Value qterm Precise)
|
||||||
, Apply Evaluatable syntax
|
(EvalEffects qterm)
|
||||||
, Apply Declarations1 syntax
|
(ModuleTable (Module (ModuleResult Precise (Value qterm Precise)))))
|
||||||
, Apply AccessControls1 syntax
|
|
||||||
, Apply FreeVariables1 syntax
|
|
||||||
)
|
|
||||||
=> Proxy lang
|
|
||||||
-> Parser term
|
|
||||||
-> [FilePath]
|
|
||||||
-> IO (Evaluator qterm Precise
|
|
||||||
(Value qterm Precise)
|
|
||||||
(EvalEffects qterm)
|
|
||||||
(ModuleTable (Module
|
|
||||||
(ModuleResult Precise (Value qterm Precise)))))
|
|
||||||
evaluateProject proxy parser paths = withOptions debugOptions $ \ config logger statter ->
|
evaluateProject proxy parser paths = withOptions debugOptions $ \ config logger statter ->
|
||||||
evaluateProject' (TaskSession config "-" logger statter) proxy parser paths
|
evaluateProject' (TaskSession config "-" logger statter) proxy parser paths
|
||||||
|
|
||||||
@ -474,17 +439,7 @@ evaluateProject proxy parser paths = withOptions debugOptions $ \ config logger
|
|||||||
-- TODO: This is used by our specs and should be moved into SpecHelpers.hs
|
-- TODO: This is used by our specs and should be moved into SpecHelpers.hs
|
||||||
evaluateProject' :: ( term ~ Term (Sum syntax) Location
|
evaluateProject' :: ( term ~ Term (Sum syntax) Location
|
||||||
, qterm ~ Quieterm (Sum syntax) Location
|
, qterm ~ Quieterm (Sum syntax) Location
|
||||||
, Language.SLanguage lang
|
, LanguageSyntax lang syntax
|
||||||
, HasPrelude lang
|
|
||||||
, Apply Eq1 syntax
|
|
||||||
, Apply Ord1 syntax
|
|
||||||
, Apply Show1 syntax
|
|
||||||
, Apply Functor syntax
|
|
||||||
, Apply Foldable syntax
|
|
||||||
, Apply Evaluatable syntax
|
|
||||||
, Apply Declarations1 syntax
|
|
||||||
, Apply AccessControls1 syntax
|
|
||||||
, Apply FreeVariables1 syntax
|
|
||||||
)
|
)
|
||||||
=> TaskSession
|
=> TaskSession
|
||||||
-> Proxy lang
|
-> Proxy lang
|
||||||
@ -493,8 +448,7 @@ evaluateProject' :: ( term ~ Term (Sum syntax) Location
|
|||||||
-> IO (Evaluator qterm Precise
|
-> IO (Evaluator qterm Precise
|
||||||
(Value qterm Precise)
|
(Value qterm Precise)
|
||||||
(EvalEffects qterm)
|
(EvalEffects qterm)
|
||||||
(ModuleTable (Module
|
(ModuleTable (Module (ModuleResult Precise (Value qterm Precise)))))
|
||||||
(ModuleResult Precise (Value qterm Precise)))))
|
|
||||||
evaluateProject' session proxy parser paths = do
|
evaluateProject' session proxy parser paths = do
|
||||||
res <- runTask session $ do
|
res <- runTask session $ do
|
||||||
blobs <- catMaybes <$> traverse readBlobFromFile (flip File (Language.reflect proxy) <$> paths)
|
blobs <- catMaybes <$> traverse readBlobFromFile (flip File (Language.reflect proxy) <$> paths)
|
||||||
@ -519,20 +473,8 @@ evaluatePythonProjects :: ( term ~ Term (Sum Language.Python.Assignment.Syntax)
|
|||||||
-> FilePath
|
-> FilePath
|
||||||
-> IO (Evaluator qterm Precise
|
-> IO (Evaluator qterm Precise
|
||||||
(Value qterm Precise)
|
(Value qterm Precise)
|
||||||
(ResumableC (BaseError (ValueError qterm Precise))
|
(EvalEffects qterm)
|
||||||
(Eff (ResumableC (BaseError (AddressError Precise (Value qterm Precise)))
|
(ModuleTable (Module (ModuleResult Precise (Value qterm Precise)))))
|
||||||
(Eff (ResumableC (BaseError ResolutionError)
|
|
||||||
(Eff (ResumableC (BaseError (EvalError qterm Precise (Value qterm Precise)))
|
|
||||||
(Eff (ResumableC (BaseError (HeapError Precise))
|
|
||||||
(Eff (ResumableC (BaseError (ScopeError Precise))
|
|
||||||
(Eff (ResumableC (BaseError (UnspecializedError Precise (Value qterm Precise)))
|
|
||||||
(Eff (ResumableC (BaseError (LoadError Precise (Value qterm Precise)))
|
|
||||||
(Eff (FreshC (Eff (StateC (ScopeGraph Precise)
|
|
||||||
(Eff (StateC (Heap Precise Precise (Value qterm Precise))
|
|
||||||
(Eff (TraceByPrintingC
|
|
||||||
(Eff (LiftC IO)))))))))))))))))))))))))
|
|
||||||
(ModuleTable (Module
|
|
||||||
(ModuleResult Precise (Value qterm Precise)))))
|
|
||||||
evaluatePythonProjects proxy parser lang path = runTask' $ do
|
evaluatePythonProjects proxy parser lang path = runTask' $ do
|
||||||
project <- readProject Nothing path lang []
|
project <- readProject Nothing path lang []
|
||||||
package <- fmap quieterm <$> parsePythonPackage parser project
|
package <- fmap quieterm <$> parsePythonPackage parser project
|
||||||
@ -546,19 +488,9 @@ evaluatePythonProjects proxy parser lang path = runTask' $ do
|
|||||||
(raiseHandler (runReader (lowerBound @Span))
|
(raiseHandler (runReader (lowerBound @Span))
|
||||||
(evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
|
(evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
|
||||||
|
|
||||||
evaluateProjectWithCaching :: ( Language.SLanguage lang
|
evaluateProjectWithCaching :: ( term ~ Term (Sum syntax) Location
|
||||||
, HasPrelude lang
|
|
||||||
, Apply Eq1 syntax
|
|
||||||
, Apply Ord1 syntax
|
|
||||||
, Apply Show1 syntax
|
|
||||||
, Apply Functor syntax
|
|
||||||
, Apply Foldable syntax
|
|
||||||
, Apply Evaluatable syntax
|
|
||||||
, Apply Declarations1 syntax
|
|
||||||
, Apply AccessControls1 syntax
|
|
||||||
, Apply FreeVariables1 syntax
|
|
||||||
, term ~ Term (Sum syntax) Location
|
|
||||||
, qterm ~ Quieterm (Sum syntax) Location
|
, qterm ~ Quieterm (Sum syntax) Location
|
||||||
|
, LanguageSyntax lang syntax
|
||||||
)
|
)
|
||||||
=> Proxy (lang :: Language.Language)
|
=> Proxy (lang :: Language.Language)
|
||||||
-> Parser term
|
-> Parser term
|
||||||
|
Loading…
Reference in New Issue
Block a user