mirror of
https://github.com/github/semantic.git
synced 2024-12-20 21:31:48 +03:00
Add class declarations to the scope graph
This commit is contained in:
parent
95ac3655cb
commit
d6e98cc08a
@ -1,11 +1,11 @@
|
||||
{-# LANGUAGE GADTs, KindSignatures, LambdaCase, RankNTypes, ScopedTypeVariables, TypeOperators #-}
|
||||
module Control.Abstract.ScopeGraph (runScopeEnv, ScopeEnv, lookup, declare, reference, create) where
|
||||
module Control.Abstract.ScopeGraph (runScopeEnv, ScopeEnv, lookup, declare, reference, newScope, Declaration(..)) where
|
||||
|
||||
import Control.Abstract.Evaluator
|
||||
import Control.Abstract.Heap
|
||||
import Data.Abstract.Name
|
||||
import Data.Span
|
||||
import Data.Abstract.ScopeGraph (Declaration, Reference, EdgeLabel, ScopeGraph)
|
||||
import Data.Abstract.ScopeGraph (Declaration(..), Reference, EdgeLabel, ScopeGraph)
|
||||
import qualified Data.Abstract.ScopeGraph as ScopeGraph
|
||||
import Prologue
|
||||
import Prelude hiding (lookup)
|
||||
@ -25,8 +25,8 @@ declare = (send .) . Declare @address
|
||||
reference :: forall address value effects. Member (ScopeEnv address) effects => Reference -> Declaration -> Evaluator address value effects ()
|
||||
reference = (send .) . Reference @address
|
||||
|
||||
create :: forall address value effects. Member (ScopeEnv address) effects => Map EdgeLabel [address] -> Evaluator address value effects ()
|
||||
create = send . Create @address
|
||||
newScope :: forall address value effects. Member (ScopeEnv address) effects => Map EdgeLabel [address] -> Evaluator address value effects ()
|
||||
newScope = send . Create @address
|
||||
|
||||
instance PureEffect (ScopeEnv address)
|
||||
instance Effect (ScopeEnv address) where
|
||||
|
@ -3,7 +3,7 @@ module Data.Abstract.ScopeGraph
|
||||
( ScopeGraph(..)
|
||||
, Path
|
||||
, Reference
|
||||
, Declaration
|
||||
, Declaration(..)
|
||||
, EdgeLabel
|
||||
, Heap
|
||||
, frameLookup
|
||||
|
@ -4,6 +4,7 @@ module Data.Syntax.Declaration where
|
||||
|
||||
import qualified Data.Abstract.Environment as Env
|
||||
import Data.Abstract.Evaluatable
|
||||
import Control.Abstract.ScopeGraph
|
||||
import Data.JSON.Fields
|
||||
import qualified Data.Set as Set
|
||||
import Diffing.Algorithm
|
||||
@ -187,6 +188,12 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
|
||||
instance Evaluatable Class where
|
||||
eval Class{..} = do
|
||||
name <- maybeM (throwEvalError NoNameError) (declaredName (subterm classIdentifier))
|
||||
span <- ask @Span
|
||||
-- Add the class to the current scope.
|
||||
declare (Declaration name) span
|
||||
-- Start a new scope.
|
||||
newScope mempty
|
||||
|
||||
supers <- traverse subtermAddress classSuperclasses
|
||||
(_, addr) <- letrec name $ do
|
||||
void $ subtermValue classBody
|
||||
|
@ -274,7 +274,10 @@ instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec
|
||||
instance Evaluatable PredefinedType
|
||||
|
||||
newtype TypeIdentifier a = TypeIdentifier { contents :: T.Text }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
|
||||
deriving (Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
|
||||
|
||||
instance Declarations1 TypeIdentifier where
|
||||
liftDeclaredName _ (TypeIdentifier identifier) = Just (name identifier)
|
||||
|
||||
instance Eq1 TypeIdentifier where liftEq = genericLiftEq
|
||||
instance Ord1 TypeIdentifier where liftCompare = genericLiftCompare
|
||||
|
Loading…
Reference in New Issue
Block a user