1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 07:25:44 +03:00

There is no distinction between local and global environment now.

This commit is contained in:
Patrick Thomson 2018-03-16 16:34:39 -04:00
parent 9446684846
commit dcaf4ed61f
8 changed files with 34 additions and 37 deletions

View File

@ -24,7 +24,7 @@ instance ( Effectful (m term value)
, MonadEvaluator term value (m term value effects)
)
=> MonadEvaluator term value (Collecting m term value effects) where
getConfiguration term = Configuration term <$> askRoots <*> askLocalEnv <*> getHeap
getConfiguration term = Configuration term <$> askRoots <*> getEnv <*> getHeap
instance ( Effectful (m term value)

View File

@ -99,19 +99,18 @@ instance Members '[Fail, State (IntMap.IntMap term)] effects => MonadControl ter
goto label = IntMap.lookup label <$> raise get >>= maybe (fail ("unknown label: " <> show label)) pure
instance Members '[State (ExportsFor value), State (EnvironmentFor value)] effects => MonadEnvironment value (Evaluating term value effects) where
getGlobalEnv = raise get
putGlobalEnv = raise . put
withGlobalEnv s = raise . localState s . lower
getEnv = raise get
putEnv = raise . put
withEnv s = raise . localState s . lower
getExports = raise get
putExports = raise . put
withExports s = raise . localState s . lower
askLocalEnv = raise get
localEnv f a = do
modifyGlobalEnv (f . Env.push)
modifyEnv (f . Env.push)
result <- a
result <$ modifyGlobalEnv Env.pop
result <$ modifyEnv Env.pop
instance Member (State (HeapFor value)) effects => MonadHeap value (Evaluating term value effects) where
getHeap = raise get
@ -125,7 +124,7 @@ instance Members '[Reader (ModuleTable [term]), State (ModuleTable (EnvironmentF
localModuleTable f a = raise (local f (lower a))
instance Members (EvaluatingEffects term value) effects => MonadEvaluator term value (Evaluating term value effects) where
getConfiguration term = Configuration term mempty <$> askLocalEnv <*> getHeap
getConfiguration term = Configuration term mempty <$> getEnv <*> getHeap
instance ( Evaluatable (Base term)
, FreeVariables term

View File

@ -25,7 +25,7 @@ lookupOrAlloc :: ( MonadAddressable (LocationFor value) value m
)
=> Name
-> m (Address (LocationFor value) value)
lookupOrAlloc name = lookupLocalEnv name >>= maybe (alloc name) pure
lookupOrAlloc name = lookupEnv name >>= maybe (alloc name) pure
letrec :: ( MonadAddressable (LocationFor value) value m

View File

@ -45,7 +45,7 @@ class (MonadEvaluator term value m, Recursive term) => MonadAnalysis term value
-- | Isolate the given action with an empty global environment and exports.
isolate :: m a -> m a
isolate = withGlobalEnv mempty . withExports mempty
isolate = withEnv mempty . withExports mempty
-- | Evaluate a term to a value using the semantics of the current analysis.
--
@ -79,7 +79,7 @@ load name = askModuleTable >>= maybe notFound evalAndCache . moduleTableLookup n
evalAndCache [] = pure mempty
evalAndCache (x:xs) = do
void $ evaluateModule x
env <- filterEnv <$> getExports <*> getGlobalEnv
env <- filterEnv <$> getExports <*> getEnv
modifyModuleTable (moduleTableInsert name env)
(env <>) <$> evalAndCache xs

View File

@ -2,7 +2,7 @@
module Control.Abstract.Evaluator
( MonadEvaluator(..)
, MonadEnvironment(..)
, modifyGlobalEnv
, modifyEnv
, modifyExports
, addExport
, MonadHeap(..)
@ -45,12 +45,12 @@ class ( MonadControl term m
-- | A 'Monad' abstracting local and global environments.
class Monad m => MonadEnvironment value m | m -> value where
-- | Retrieve the global environment.
getGlobalEnv :: m (EnvironmentFor value)
-- | Set the global environment
putGlobalEnv :: EnvironmentFor value -> m ()
-- | Sets the global environment for the lifetime of the given action.
withGlobalEnv :: EnvironmentFor value -> m a -> m a
-- | Retrieve the environment.
getEnv :: m (EnvironmentFor value)
-- | Set the environment.
putEnv :: EnvironmentFor value -> m ()
-- | Sets the environment for the lifetime of the given action.
withEnv :: EnvironmentFor value -> m a -> m a
-- | Get the global export state.
getExports :: m (ExportsFor value)
@ -59,19 +59,17 @@ class Monad m => MonadEnvironment value m | m -> value where
-- | Sets the global export state for the lifetime of the given action.
withExports :: ExportsFor value -> m a -> m a
-- | Retrieve the local environment.
askLocalEnv :: m (EnvironmentFor value)
-- | Run an action with a locally-modified environment.
localEnv :: (EnvironmentFor value -> EnvironmentFor value) -> m a -> m a
-- | Look a 'Name' up in the local environment.
lookupLocalEnv :: Name -> m (Maybe (Address (LocationFor value) value))
lookupLocalEnv name = Env.lookup name <$> askLocalEnv
-- | Look a 'Name' up in the environment.
lookupEnv :: Name -> m (Maybe (Address (LocationFor value) value))
lookupEnv name = Env.lookup name <$> getEnv
-- | Look up a 'Name' in the local environment, running an action with the resolved address (if any).
-- | Look up a 'Name' in the environment, running an action with the resolved address (if any).
lookupWith :: (Address (LocationFor value) value -> m value) -> Name -> m (Maybe value)
lookupWith with name = do
addr <- lookupLocalEnv name
addr <- lookupEnv name
maybe (pure Nothing) (fmap Just . with) addr
-- | Run a computation in a new local environment.
@ -80,10 +78,10 @@ localize = localEnv id
-- | Update the global environment.
-- TODO: RENAME ME BECAUSE MY NAME IS A LIE
modifyGlobalEnv :: MonadEnvironment value m => (EnvironmentFor value -> EnvironmentFor value) -> m ()
modifyGlobalEnv f = do
env <- getGlobalEnv
putGlobalEnv $! f env
modifyEnv :: MonadEnvironment value m => (EnvironmentFor value -> EnvironmentFor value) -> m ()
modifyEnv f = do
env <- getEnv
putEnv $! f env
-- | Update the global export state.
modifyExports :: MonadEnvironment value m => (ExportsFor value -> ExportsFor value) -> m ()

View File

@ -221,7 +221,7 @@ instance ( Monad m
abstract names (Subterm body _) = do
l <- label body
injValue . Closure names l . Env.bindEnv (foldr Set.delete (freeVariables body) names) <$> askLocalEnv
injValue . Closure names l . Env.bindEnv (foldr Set.delete (freeVariables body) names) <$> getEnv
apply op params = do
Closure names label env <- maybe (fail ("expected a closure, got: " <> show op)) pure (prjValue op)

View File

@ -23,7 +23,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Function where
eval Function{..} = do
(v, addr) <- letrec name (abstract (paramNames functionParameters) functionBody)
modifyGlobalEnv (Env.insert name addr)
modifyEnv (Env.insert name addr)
pure v
where paramNames = foldMap (pure . freeVariable . subterm)
name = freeVariable (subterm functionName)
@ -44,7 +44,7 @@ instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Method where
eval Method{..} = do
(v, addr) <- letrec name (abstract (paramNames methodParameters) methodBody)
modifyGlobalEnv (Env.insert name addr)
modifyEnv (Env.insert name addr)
pure v
where paramNames = foldMap (pure . freeVariable . subterm)
name = freeVariable (subterm methodName)
@ -148,9 +148,9 @@ instance Evaluatable Class where
let name = freeVariable (subterm classIdentifier)
(v, addr) <- letrec name $ do
void $ subtermValue classBody
classEnv <- Env.head <$> askLocalEnv
classEnv <- Env.head <$> getEnv
klass name classEnv
v <$ modifyGlobalEnv (Env.insert name addr)
v <$ modifyEnv (Env.insert name addr)
data Module a = Module { moduleIdentifier :: !a, moduleScope :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
@ -277,7 +277,7 @@ instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable QualifiedImport where
eval (QualifiedImport from alias xs) = do
importedEnv <- isolate (require moduleName)
modifyGlobalEnv (mappend (Env.rename (renames importedEnv) importedEnv))
modifyEnv (mappend (Env.rename (renames importedEnv) importedEnv))
unit
where
moduleName = freeVariable (subterm from)
@ -300,7 +300,7 @@ instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Import where
eval (Import from xs _) = do
importedEnv <- isolate (require moduleName)
modifyGlobalEnv (mappend (renamed importedEnv))
modifyEnv (mappend (renamed importedEnv))
unit
where
moduleName = freeVariable (subterm from)

View File

@ -96,7 +96,7 @@ instance Evaluatable Assignment where
v <- subtermValue assignmentValue
addr <- lookupOrAlloc name
assign addr v
modifyGlobalEnv (Env.insert name addr)
modifyEnv (Env.insert name addr)
pure v
where name = freeVariable (subterm assignmentTarget)