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

cut State Environment over to Env effect

Browse Source
This commit is contained in:
Charlie Somerville 2018-05-30 09:48:16 -05:00
parent 90ad5bc45e
commit 12c6c39861
9 changed files with 20 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Analysis/Abstract/Caching.hs
View File

@ -62,7 +62,7 @@ cachingTerms :: ( Cacheable term address (Cell address) value
, Member (Reader (Cache term address (Cell address) value)) effects
, Member (Reader (Live address)) effects
, Member (State (Cache term address (Cell address) value)) effects
, Member (State (Environment address)) effects
, Member (Env address) effects
, Member (State (Heap address (Cell address) value)) effects
)
=> SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef value))
@ -86,7 +86,7 @@ convergingModules :: ( AbstractValue address value effects
, Member (Reader (Live address)) effects
, Member (Resumable (EnvironmentError address)) effects
, Member (State (Cache term address (Cell address) value)) effects
, Member (State (Environment address)) effects
, Member (Env address) effects
, Member (State (Heap address (Cell address) value)) effects
)
=> SubtermAlgebra Module term (TermEvaluator term address value effects value)

4
src/Analysis/Abstract/Evaluating.hs
View File

@ -23,7 +23,7 @@ deriving instance (Show (Cell address value), Show address, Show value) => Show
evaluating :: Evaluator address value
( Fail
': Fresh
': State (Environment address)
': Env address
': State (Heap address (Cell address) value)
': State (ModuleTable (Maybe (Environment address, value)))
': State (Exports address)
@ -34,6 +34,6 @@ evaluating
. runState lowerBound -- State (Exports address)
. runState lowerBound -- State (ModuleTable (Maybe (Environment address, value)))
. runState lowerBound -- State (Heap address (Cell address) value)
. runState lowerBound -- State (Environment address)
. runState lowerBound -- Env address
. runFresh 0
. runFail

4
src/Analysis/Abstract/Graph.hs
View File

@ -54,7 +54,7 @@ style = (defaultStyle (byteString . vertexName))
graphingTerms :: ( Element Syntax.Identifier syntax
, Member (Reader (Environment (Hole (Located address)))) effects
, Member (Reader ModuleInfo) effects
, Member (State (Environment (Hole (Located address)))) effects
, Member (Env (Hole (Located address))) effects
, Member (State (Graph Vertex)) effects
, term ~ Term (Sum syntax) ann
)
@ -122,7 +122,7 @@ moduleInclusion v = do
-- | Add an edge from the passed variable name to the module it originated within.
variableDefinition :: ( Member (Reader (Environment (Hole (Located address)))) effects
, Member (State (Environment (Hole (Located address)))) effects
, Member (Env (Hole (Located address))) effects
, Member (State (Graph Vertex)) effects
)
=> Name

2
src/Analysis/Abstract/Tracing.hs
View File

@ -14,7 +14,7 @@ import Prologue
-- Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis.
tracingTerms :: ( Corecursive term
, Member (Reader (Live address)) effects
, Member (State (Environment address)) effects
, Member (Env address) effects
, Member (State (Heap address (Cell address) value)) effects
, Member (Writer (trace (Configuration term address (Cell address) value))) effects
, Reducer (Configuration term address (Cell address) value) (trace (Configuration term address (Cell address) value))

2
src/Control/Abstract/Configuration.hs
View File

@ -12,5 +12,5 @@ import Control.Abstract.TermEvaluator
import Data.Abstract.Configuration
-- | Get the current 'Configuration' with a passed-in term.
getConfiguration :: (Member (Reader (Live address)) effects, Member (State (Environment address)) effects, Member (State (Heap address (Cell address) value)) effects) => term -> TermEvaluator term address value effects (Configuration term address (Cell address) value)
getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address (Cell address) value)) effects) => term -> TermEvaluator term address value effects (Configuration term address (Cell address) value)
getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap

16
src/Control/Abstract/Environment.hs
View File

@ -25,19 +25,19 @@ import Data.Abstract.Name
import Prologue
-- | Retrieve the environment.
getEnv :: Member (State (Environment address)) effects => Evaluator address value effects (Environment address)
getEnv :: Member (Env address) effects => Evaluator address value effects (Environment address)
getEnv = get
-- | Set the environment.
putEnv :: Member (State (Environment address)) effects => Environment address -> Evaluator address value effects ()
putEnv :: Member (Env address) effects => Environment address -> Evaluator address value effects ()
putEnv = put
-- | Update the global environment.
modifyEnv :: Member (State (Environment address)) effects => (Environment address -> Environment address) -> Evaluator address value effects ()
modifyEnv :: Member (Env address) effects => (Environment address -> Environment address) -> Evaluator address value effects ()
modifyEnv = modify'
-- | Sets the environment for the lifetime of the given action.
withEnv :: Member (State (Environment address)) effects => Environment address -> Evaluator address value effects a -> Evaluator address value effects a
withEnv :: Member (Env address) effects => Environment address -> Evaluator address value effects a -> Evaluator address value effects a
withEnv = localState . const
@ -66,12 +66,12 @@ close = send . Close
data Env address return where
Lookup :: Name -> Env address (Maybe address)
Bind :: Name -> address -> Env address ()
Bind :: Name -> address -> Env address ()
Close :: Set Name -> Env address (Environment address)
Push :: Env address ()
Pop :: Env address ()
handleEnv :: Member (State (Environment address)) effects => Environment address -> Env address result -> Evaluator address value effects result
handleEnv :: Member (Env address) effects => Environment address -> Env address result -> Evaluator address value effects result
handleEnv defaultEnvironment = \case
Lookup name -> maybe (Env.lookup name defaultEnvironment) Just . Env.lookup name <$> getEnv
Bind name addr -> modifyEnv (Env.insert name addr)
@ -79,10 +79,10 @@ handleEnv defaultEnvironment = \case
Push -> modifyEnv Env.push
Pop -> modifyEnv Env.pop
runEnv :: Member (State (Environment address)) effects => Environment address -> Evaluator address value (Env address ': effects) a -> Evaluator address value effects a
runEnv :: Member (Env address) effects => Environment address -> Evaluator address value (Env address ': effects) a -> Evaluator address value effects a
runEnv defaultEnvironment = interpret (handleEnv defaultEnvironment)
reinterpretEnv :: Environment address -> Evaluator address value (Env address ': effects) a -> Evaluator address value (State (Environment address) ': effects) a
reinterpretEnv :: Environment address -> Evaluator address value (Env address ': effects) a -> Evaluator address value (Env address ': effects) a
reinterpretEnv defaultEnvironment = reinterpret (handleEnv defaultEnvironment)

2
src/Control/Abstract/Value.hs
View File

@ -187,7 +187,7 @@ doWhile body cond = loop $ \ continue -> body *> do
ifthenelse this continue (pure unit)
makeNamespace :: ( AbstractValue address value effects
, Member (State (Environment address)) effects
, Member (Env address) effects
, Member (State (Heap address (Cell address) value)) effects
, Ord address
, Reducer value (Cell address value)

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

@ -85,7 +85,7 @@ evaluatePackageWith :: forall address term value inner inner' inner'' outer
, Member Fresh outer
, Member (Resumable (AddressError address value)) outer
, Member (Resumable (LoadError address value)) outer
, Member (State (Environment address)) outer
, Member (Env address) outer
, Member (State (Exports address)) outer
, Member (State (Heap address (Cell address) value)) outer
, Member (State (ModuleTable (Maybe (Environment address, value)))) outer
@ -147,7 +147,7 @@ evaluatePackageWith analyzeModule analyzeTerm package
-- | Isolate the given action with an empty global environment and exports.
isolate :: (Member (State (Environment address)) effects, Member (State (Exports address)) effects) => Evaluator address value effects a -> Evaluator address value effects a
isolate :: (Member (Env address) effects, Member (State (Exports address)) effects) => Evaluator address value effects a -> Evaluator address value effects a
isolate = withEnv lowerBound . withExports lowerBound
traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator address value effects ()

2
src/Semantic/Graph.hs
View File

@ -129,7 +129,7 @@ resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> s
UnallocatedAddress _ -> pure lowerBound
UninitializedAddress _ -> pure hole)
resumingValueError :: (Member (State (Environment address)) effects, Member Trace effects, Show address) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a
resumingValueError :: (Member (Env address) effects, Member Trace effects, Show address) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a
resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of
CallError val -> pure val
StringError val -> pure (pack (show val))