github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #2139 from github/there-can-only-be-one-concrete-evaluator-newtype

Browse Source 
Combine the concrete evaluator newtypes
This commit is contained in:
Josh Vera 2018-08-17 11:40:36 -04:00 committed by GitHub
commit 4f99f86ba8
5 changed files with 77 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Data/Abstract/Evaluatable.hs
View File

@ -2,6 +2,8 @@
module Data.Abstract.Evaluatable module Data.Abstract.Evaluatable
( module X ( module X
, Evaluatable(..) , Evaluatable(..)
, ModuleEffects
, ValueEffects
, evaluate , evaluate
, traceResolve , traceResolve
-- * Preludes -- * Preludes
@ -75,6 +77,19 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
rvalBox v rvalBox v
type ModuleEffects address value rest
= Exc (LoopControl address)
': Exc (Return address)
': Env address
': Deref value
': Allocator address
': Reader ModuleInfo
': rest
type ValueEffects address value rest
= Function address value
': rest
evaluate :: ( AbstractValue address value valueEffects evaluate :: ( AbstractValue address value valueEffects
, Declarations term , Declarations term
, Effects effects , Effects effects
@ -96,8 +111,8 @@ evaluate :: ( AbstractValue address value valueEffects
, Member Trace effects , Member Trace effects
, Ord address , Ord address
, Recursive term , Recursive term
, moduleEffects ~ (Exc (LoopControl address) ': Exc (Return address) ': Env address ': Deref value ': Allocator address ': Reader ModuleInfo ': effects) , moduleEffects ~ ModuleEffects address value effects
, valueEffects ~ (Function address value ': moduleEffects) , valueEffects ~ ValueEffects address value moduleEffects
) )
=> proxy lang => proxy lang
-> (SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address) -> SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address)) -> (SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address) -> SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address))

105
src/Semantic/Graph.hs
View File

@ -8,7 +8,7 @@ module Semantic.Graph
, GraphType(..) , GraphType(..)
, Graph , Graph
, Vertex , Vertex
, ImportGraphEff(..) , ConcreteEff(..)
, style , style
, parsePackage , parsePackage
, withTermSpans , withTermSpans
@ -123,40 +123,37 @@ runCallGraph lang includePackages modules package = do
. Hole.runDeref (Located.handleDeref Monovariant.handleDeref) . Hole.runDeref (Located.handleDeref Monovariant.handleDeref)
extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm runAddressEffects Abstract.runFunction modules)) extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm runAddressEffects Abstract.runFunction modules))
runImportGraphToModuleInfos :: forall effs lang term. runImportGraphToModuleInfos :: ( Declarations term
( Declarations term , Evaluatable (Base term)
, Evaluatable (Base term) , FreeVariables term
, FreeVariables term , HasPrelude lang
, HasPrelude lang , HasPostlude lang
, HasPostlude lang , Member Trace effs
, Member Trace effs , Recursive term
, Recursive term , Effects effs
, Effects effs )
) => Proxy lang
=> Proxy lang -> Package term
-> Package term -> Eff effs (Graph Vertex)
-> Eff effs (Graph Vertex)
runImportGraphToModuleInfos lang (package :: Package term) = runImportGraph lang package allModuleInfos runImportGraphToModuleInfos lang (package :: Package term) = runImportGraph lang package allModuleInfos
where allModuleInfos info = maybe (vertex (unknownModuleVertex info)) (foldMap (vertex . moduleVertex . moduleInfo)) (ModuleTable.lookup (modulePath info) (packageModules package)) where allModuleInfos info = maybe (vertex (unknownModuleVertex info)) (foldMap (vertex . moduleVertex . moduleInfo)) (ModuleTable.lookup (modulePath info) (packageModules package))
runImportGraphToModules :: forall effs lang term. runImportGraphToModules :: ( Declarations term
( Declarations term , Evaluatable (Base term)
, Evaluatable (Base term) , FreeVariables term
, FreeVariables term , HasPrelude lang
, HasPrelude lang , HasPostlude lang
, HasPostlude lang , Member Trace effs
, Member Trace effs , Recursive term
, Recursive term , Effects effs
, Effects effs )
) => Proxy lang
=> Proxy lang -> Package term
-> Package term -> Eff effs (Graph (Module term))
-> Eff effs (Graph (Module term))
runImportGraphToModules lang (package :: Package term) = runImportGraph lang package resolveOrLowerBound runImportGraphToModules lang (package :: Package term) = runImportGraph lang package resolveOrLowerBound
where resolveOrLowerBound info = maybe lowerBound (foldMap vertex) (ModuleTable.lookup (modulePath info) (packageModules package)) where resolveOrLowerBound info = maybe lowerBound (foldMap vertex) (ModuleTable.lookup (modulePath info) (packageModules package))
runImportGraph :: forall effs lang term vertex. runImportGraph :: ( Declarations term
( Declarations term
, Evaluatable (Base term) , Evaluatable (Base term)
, FreeVariables term , FreeVariables term
, HasPrelude lang , HasPrelude lang
@ -171,9 +168,10 @@ runImportGraph :: forall effs lang term vertex.
-> Eff effs (Graph vertex) -> Eff effs (Graph vertex)
runImportGraph lang (package :: Package term) f = runImportGraph lang (package :: Package term) f =
let analyzeModule = graphingModuleInfo let analyzeModule = graphingModuleInfo
extractGraph (_, (graph, _)) = graph >>= f extractGraph (graph, _) = graph >>= f
runImportGraphAnalysis runImportGraphAnalysis
= runState lowerBound = runState lowerBound
. runState lowerBound
. runFresh 0 . runFresh 0
. resumingLoadError . resumingLoadError
. resumingUnspecialized . resumingUnspecialized
@ -182,10 +180,9 @@ runImportGraph lang (package :: Package term) f =
. resumingResolutionError . resumingResolutionError
. resumingAddressError . resumingAddressError
. resumingValueError . resumingValueError
. runState lowerBound
. runReader lowerBound . runReader lowerBound
. runModules (ModuleTable.modulePaths (packageModules package)) . runModules (ModuleTable.modulePaths (packageModules package))
. runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ImportGraphEff (Hole (Maybe Name) Precise) effs)) . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ConcreteEff (Hole (Maybe Name) Precise) _))
. runReader (packageInfo package) . runReader (packageInfo package)
. runReader lowerBound . runReader lowerBound
runAddressEffects runAddressEffects
@ -193,30 +190,26 @@ runImportGraph lang (package :: Package term) f =
. Hole.runDeref Precise.handleDeref . Hole.runDeref Precise.handleDeref
in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate lang analyzeModule id runAddressEffects (Concrete.runFunction coerce coerce) (ModuleTable.toPairs (packageModules package) >>= toList . snd))) in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate lang analyzeModule id runAddressEffects (Concrete.runFunction coerce coerce) (ModuleTable.toPairs (packageModules package) >>= toList . snd)))
newtype ImportGraphEff address outerEffects a = ImportGraphEff type ConcreteEffects address rest
{ runImportGraphEff :: Eff ( Function address (Value address (ImportGraphEff address outerEffects)) = Reader Span
': Exc (LoopControl address) ': Reader PackageInfo
': Exc (Return address) ': Modules address
': Env address ': Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))
': Deref (Value address (ImportGraphEff address outerEffects)) ': Resumable (BaseError (ValueError address (ConcreteEff address rest)))
': Allocator address ': Resumable (BaseError (AddressError address (Value address (ConcreteEff address rest))))
': Reader ModuleInfo ': Resumable (BaseError ResolutionError)
': Reader Span ': Resumable (BaseError EvalError)
': Reader PackageInfo ': Resumable (BaseError (EnvironmentError address))
': Modules address ': Resumable (BaseError (UnspecializedError (Value address (ConcreteEff address rest))))
': Reader (ModuleTable (NonEmpty (Module (ModuleResult address)))) ': Resumable (BaseError (LoadError address))
': State (Graph ModuleInfo) ': Fresh
': Resumable (BaseError (ValueError address (ImportGraphEff address outerEffects))) ': State (Heap address (Value address (ConcreteEff address rest)))
': Resumable (BaseError (AddressError address (Value address (ImportGraphEff address outerEffects)))) ': rest
': Resumable (BaseError ResolutionError)
': Resumable (BaseError EvalError) newtype ConcreteEff address outerEffects a = ConcreteEff
': Resumable (BaseError (EnvironmentError address)) { runConcreteEff :: Eff (ValueEffects address (Value address (ConcreteEff address outerEffects))
': Resumable (BaseError (UnspecializedError (Value address (ImportGraphEff address outerEffects)))) (ModuleEffects address (Value address (ConcreteEff address outerEffects))
': Resumable (BaseError (LoadError address)) (ConcreteEffects address outerEffects))) a
': Fresh
': State (Heap address (Value address (ImportGraphEff address outerEffects)))
': outerEffects
) a
} }

6
src/Semantic/REPL.hs
View File

@ -88,7 +88,7 @@ repl proxy parser paths = defaultConfig debugOptions >>= \ config -> runM . runD
. fmap snd . fmap snd
. runState ([] @Breakpoint) . runState ([] @Breakpoint)
. runReader Step . runReader Step
. runTermEvaluator @_ @_ @(Value Precise (UtilEff Precise _)) . runTermEvaluator @_ @_ @(Value Precise (ConcreteEff Precise _))
. runPrintingTrace . runPrintingTrace
. runState lowerBound . runState lowerBound
. runFresh 0 . runFresh 0
@ -100,10 +100,10 @@ repl proxy parser paths = defaultConfig debugOptions >>= \ config -> runM . runD
. runResolutionError . runResolutionError
. runAddressError . runAddressError
. runValueError . runValueError
. runReader (packageInfo package)
. runReader (lowerBound @Span)
. runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise))))) . runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise)))))
. raiseHandler (runModules (ModuleTable.modulePaths (packageModules (snd <$> package)))) . raiseHandler (runModules (ModuleTable.modulePaths (packageModules (snd <$> package))))
. runReader (packageInfo package)
. runReader (lowerBound @Span)
$ evaluate proxy id (withTermSpans . step (fmap (\ (x:|_) -> moduleBody x) <$> ModuleTable.toPairs (packageModules (fst <$> package)))) (Precise.runAllocator . Precise.runDeref) (Concrete.runFunction coerce coerce) modules $ evaluate proxy id (withTermSpans . step (fmap (\ (x:|_) -> moduleBody x) <$> ModuleTable.toPairs (packageModules (fst <$> package)))) (Precise.runAllocator . Precise.runDeref) (Concrete.runFunction coerce coerce) modules
-- TODO: REPL for typechecking/abstract semantics -- TODO: REPL for typechecking/abstract semantics

32
src/Semantic/Util.hs
View File

@ -11,7 +11,6 @@ import Control.Exception (displayException)
import Control.Monad.Effect.Trace (runPrintingTrace) import Control.Monad.Effect.Trace (runPrintingTrace)
import Data.Abstract.Address.Monovariant as Monovariant import Data.Abstract.Address.Monovariant as Monovariant
import Data.Abstract.Address.Precise as Precise import Data.Abstract.Address.Precise as Precise
import Data.Abstract.BaseError (BaseError(..))
import Data.Abstract.Evaluatable import Data.Abstract.Evaluatable
import Data.Abstract.Module import Data.Abstract.Module
import qualified Data.Abstract.ModuleTable as ModuleTable import qualified Data.Abstract.ModuleTable as ModuleTable
@ -53,31 +52,6 @@ justEvaluating
. runAddressError . runAddressError
. runValueError . runValueError
newtype UtilEff address rest a = UtilEff
{ runUtilEff :: Eff ( Function address (Value address (UtilEff address rest))
': Exc (LoopControl address)
': Exc (Return address)
': Env address
': Deref (Value address (UtilEff address rest))
': Allocator address
': Reader ModuleInfo
': Modules address
': Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))
': Reader Span
': Reader PackageInfo
': Resumable (BaseError (ValueError address (UtilEff address rest)))
': Resumable (BaseError (AddressError address (Value address (UtilEff address rest))))
': Resumable (BaseError ResolutionError)
': Resumable (BaseError EvalError)
': Resumable (BaseError (EnvironmentError address))
': Resumable (BaseError (UnspecializedError (Value address (UtilEff address rest))))
': Resumable (BaseError (LoadError address))
': Fresh
': State (Heap address (Value address (UtilEff address rest)))
': rest
) a
}
checking checking
= runM @_ @IO = runM @_ @IO
. runPrintingTrace . runPrintingTrace
@ -125,11 +99,11 @@ evaluateProject' (TaskConfig config logger statter) proxy parser paths = either
package <- fmap (quieterm . snd) <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) []) package <- fmap (quieterm . snd) <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) [])
modules <- topologicalSort <$> runImportGraphToModules proxy package modules <- topologicalSort <$> runImportGraphToModules proxy package
trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules) trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules)
pure (runTermEvaluator @_ @_ @(Value Precise (UtilEff Precise _)) pure (runTermEvaluator @_ @_ @(Value Precise (ConcreteEff Precise _))
(runReader (packageInfo package)
(runReader (lowerBound @Span)
(runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise))))) (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise)))))
(raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
(runReader (packageInfo package)
(runReader (lowerBound @Span)
(evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runFunction coerce coerce) modules)))))) (evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runFunction coerce coerce) modules))))))

9
test/SpecHelpers.hs
View File

@ -73,6 +73,7 @@ import qualified Data.ByteString as B
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Semantic.IO as IO import qualified Semantic.IO as IO
import Semantic.Config (Config) import Semantic.Config (Config)
import Semantic.Graph (ConcreteEff)
import Semantic.Telemetry (LogQueue, StatQueue) import Semantic.Telemetry (LogQueue, StatQueue)
import System.Exit (die) import System.Exit (die)
import Control.Exception (displayException) import Control.Exception (displayException)
@ -97,7 +98,7 @@ readFilePair :: Both FilePath -> IO BlobPair
readFilePair paths = let paths' = fmap file paths in readFilePair paths = let paths' = fmap file paths in
runBothWith IO.readFilePair paths' runBothWith IO.readFilePair paths'
type TestEvaluatingEffects = '[ Resumable (BaseError (ValueError Precise (UtilEff Precise '[Trace, Lift IO]))) type TestEvaluatingEffects = '[ Resumable (BaseError (ValueError Precise (ConcreteEff Precise '[Trace, Lift IO])))
, Resumable (BaseError (AddressError Precise Val)) , Resumable (BaseError (AddressError Precise Val))
, Resumable (BaseError ResolutionError) , Resumable (BaseError ResolutionError)
, Resumable (BaseError EvalError) , Resumable (BaseError EvalError)
@ -109,7 +110,7 @@ type TestEvaluatingEffects = '[ Resumable (BaseError (ValueError Precise (UtilEf
, Trace , Trace
, Lift IO , Lift IO
] ]
type TestEvaluatingErrors = '[ BaseError (ValueError Precise (UtilEff Precise '[Trace, Lift IO])) type TestEvaluatingErrors = '[ BaseError (ValueError Precise (ConcreteEff Precise '[Trace, Lift IO]))
, BaseError (AddressError Precise Val) , BaseError (AddressError Precise Val)
, BaseError ResolutionError , BaseError ResolutionError
, BaseError EvalError , BaseError EvalError
@ -137,9 +138,9 @@ testEvaluating
. runEvalError . runEvalError
. runResolutionError . runResolutionError
. runAddressError . runAddressError
. runValueError @_ @Precise @(UtilEff Precise _) . runValueError @_ @Precise @(ConcreteEff Precise _)
type Val = Value Precise (UtilEff Precise '[Trace, Lift IO]) type Val = Value Precise (ConcreteEff Precise '[Trace, Lift IO])
deNamespace :: Heap Precise (Value Precise term) deNamespace :: Heap Precise (Value Precise term)