mirror of
https://github.com/github/semantic.git
synced 2024-12-15 18:13:38 +03:00
Merge branch 'heap-frames' of https://github.com/github/semantic into heap-frames
This commit is contained in:
commit
eee533a010
@ -157,7 +157,7 @@ withFrame :: forall term address value sig m a. (
|
|||||||
=> address
|
=> address
|
||||||
-> Evaluator term address value m a -- Not sure about this `sig` here (substituting `sig` for `effects`)
|
-> Evaluator term address value m a -- Not sure about this `sig` here (substituting `sig` for `effects`)
|
||||||
-> Evaluator term address value m a
|
-> Evaluator term address value m a
|
||||||
withFrame address action = local @(address, address) (second (const address)) action
|
withFrame address = local @(address, address) (second (const address))
|
||||||
|
|
||||||
-- | Define a declaration and assign the value of an action in the current frame.
|
-- | Define a declaration and assign the value of an action in the current frame.
|
||||||
define :: forall value sig address m term. ( HasCallStack
|
define :: forall value sig address m term. ( HasCallStack
|
||||||
|
@ -1,40 +1,40 @@
|
|||||||
{-# LANGUAGE FunctionalDependencies, UndecidableInstances, ScopedTypeVariables, TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
module Control.Abstract.Primitive
|
module Control.Abstract.Primitive
|
||||||
( defineClass
|
( defineClass
|
||||||
, defineNamespace
|
, defineNamespace
|
||||||
, defineBuiltIn
|
, defineBuiltIn
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Abstract.Context
|
import Control.Abstract.Context
|
||||||
import Control.Abstract.Evaluator
|
import Control.Abstract.Evaluator
|
||||||
import Control.Abstract.Heap
|
import Control.Abstract.Heap
|
||||||
import Control.Abstract.ScopeGraph
|
import Control.Abstract.ScopeGraph
|
||||||
import Control.Abstract.Value
|
import Control.Abstract.Value
|
||||||
import Data.Abstract.BaseError
|
import Data.Abstract.BaseError
|
||||||
import Data.Map.Strict as Map
|
|
||||||
import Data.Abstract.Ref
|
|
||||||
import Data.Abstract.Name
|
import Data.Abstract.Name
|
||||||
|
import Data.Abstract.Ref
|
||||||
|
import Data.Map.Strict as Map
|
||||||
import Data.Span
|
import Data.Span
|
||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
defineBuiltIn :: forall value sig address m term. ( HasCallStack
|
defineBuiltIn :: ( HasCallStack
|
||||||
, Member (Deref value) sig
|
, Member (Deref value) sig
|
||||||
, Member (Reader ModuleInfo) sig
|
, Member (Reader ModuleInfo) sig
|
||||||
, Member (Reader Span) sig
|
, Member (Reader Span) sig
|
||||||
, Member (Reader (address, address)) sig
|
, Member (Reader (address, address)) sig
|
||||||
, Member (State (Heap address address value)) sig
|
, Member (State (Heap address address value)) sig
|
||||||
, Member (State (ScopeGraph address)) sig
|
, Member (State (ScopeGraph address)) sig
|
||||||
, Member (Resumable (BaseError (ScopeError address))) sig
|
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||||
, Member (Resumable (BaseError (HeapError address))) sig
|
, Member (Resumable (BaseError (HeapError address))) sig
|
||||||
, Member (Function term address value) sig
|
, Member (Function term address value) sig
|
||||||
, Member (Allocator address) sig
|
, Member (Allocator address) sig
|
||||||
, Member Fresh sig
|
, Member Fresh sig
|
||||||
, Ord address
|
, Ord address
|
||||||
, Carrier sig m
|
, Carrier sig m
|
||||||
)
|
)
|
||||||
=> Declaration
|
=> Declaration
|
||||||
-> BuiltIn
|
-> BuiltIn
|
||||||
-> Evaluator term address value m (ValueRef address value)
|
-> Evaluator term address value m (ValueRef address value)
|
||||||
defineBuiltIn declaration value = withCurrentCallStack callStack $ do
|
defineBuiltIn declaration value = withCurrentCallStack callStack $ do
|
||||||
currentScope' <- currentScope
|
currentScope' <- currentScope
|
||||||
let lexicalEdges = Map.singleton Lexical [ currentScope' ]
|
let lexicalEdges = Map.singleton Lexical [ currentScope' ]
|
||||||
@ -72,9 +72,7 @@ defineClass :: ( AbstractValue term address value m
|
|||||||
defineClass declaration superclasses body = void . define declaration $ do
|
defineClass declaration superclasses body = void . define declaration $ do
|
||||||
currentScope' <- currentScope
|
currentScope' <- currentScope
|
||||||
|
|
||||||
superScopes <- for superclasses $ \superclass -> do
|
superScopes <- for superclasses associatedScope
|
||||||
scope <- associatedScope superclass
|
|
||||||
pure scope
|
|
||||||
|
|
||||||
let superclassEdges = (Superclass, ) <$> (fmap pure . catMaybes $ superScopes)
|
let superclassEdges = (Superclass, ) <$> (fmap pure . catMaybes $ superScopes)
|
||||||
current = fmap (Lexical, ) . pure . pure $ currentScope'
|
current = fmap (Lexical, ) . pure . pure $ currentScope'
|
||||||
@ -83,7 +81,7 @@ defineClass declaration superclasses body = void . define declaration $ do
|
|||||||
putDeclarationScope declaration childScope
|
putDeclarationScope declaration childScope
|
||||||
|
|
||||||
withScope childScope $ do
|
withScope childScope $ do
|
||||||
void $ body
|
void body
|
||||||
|
|
||||||
pure unit
|
pure unit
|
||||||
|
|
||||||
|
@ -69,7 +69,7 @@ putDeclarationScope decl assocScope = do
|
|||||||
modify (ScopeGraph.insertDeclarationScope decl assocScope currentAddress)
|
modify (ScopeGraph.insertDeclarationScope decl assocScope currentAddress)
|
||||||
|
|
||||||
putDeclarationSpan :: forall address sig m term value. (Ord address, Member (State (ScopeGraph address)) sig, Carrier sig m) => Declaration -> Span -> Evaluator term address value m ()
|
putDeclarationSpan :: forall address sig m term value. (Ord address, Member (State (ScopeGraph address)) sig, Carrier sig m) => Declaration -> Span -> Evaluator term address value m ()
|
||||||
putDeclarationSpan decl = modify @(ScopeGraph address) . (ScopeGraph.insertDeclarationSpan decl)
|
putDeclarationSpan decl = modify @(ScopeGraph address) . ScopeGraph.insertDeclarationSpan decl
|
||||||
|
|
||||||
reference :: forall address sig m term value
|
reference :: forall address sig m term value
|
||||||
. ( Ord address
|
. ( Ord address
|
||||||
@ -182,8 +182,7 @@ maybeLookupScopePath ::
|
|||||||
-> Evaluator term address value m (Maybe (ScopeGraph.Path address))
|
-> Evaluator term address value m (Maybe (ScopeGraph.Path address))
|
||||||
maybeLookupScopePath Declaration{..} = do
|
maybeLookupScopePath Declaration{..} = do
|
||||||
currentAddress <- currentScope
|
currentAddress <- currentScope
|
||||||
scopeGraph <- get
|
gets (ScopeGraph.lookupScopePath unDeclaration currentAddress)
|
||||||
pure (ScopeGraph.lookupScopePath unDeclaration currentAddress scopeGraph)
|
|
||||||
|
|
||||||
lookupScopePath :: ( Member (Resumable (BaseError (ScopeError address))) sig
|
lookupScopePath :: ( Member (Resumable (BaseError (ScopeError address))) sig
|
||||||
, Member (Reader ModuleInfo) sig
|
, Member (Reader ModuleInfo) sig
|
||||||
@ -222,7 +221,7 @@ withScope :: forall sig m address term value a. ( Carrier sig m
|
|||||||
=> address
|
=> address
|
||||||
-> Evaluator term address value m a
|
-> Evaluator term address value m a
|
||||||
-> Evaluator term address value m a
|
-> Evaluator term address value m a
|
||||||
withScope scope action = local @(address, address) (first (const scope)) action
|
withScope scope = local @(address, address) (first (const scope))
|
||||||
|
|
||||||
throwScopeError :: ( Member (Resumable (BaseError (ScopeError address))) sig
|
throwScopeError :: ( Member (Resumable (BaseError (ScopeError address))) sig
|
||||||
, Member (Reader ModuleInfo) sig
|
, Member (Reader ModuleInfo) sig
|
||||||
|
@ -28,10 +28,9 @@ module Control.Abstract.Value
|
|||||||
, rvalBox
|
, rvalBox
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Abstract.ScopeGraph (Declaration, ScopeGraph)
|
|
||||||
import Control.Abstract.Evaluator
|
import Control.Abstract.Evaluator
|
||||||
import Control.Abstract.Heap
|
import Control.Abstract.Heap
|
||||||
import Control.Abstract.ScopeGraph (Allocator)
|
import Control.Abstract.ScopeGraph (Allocator, Declaration, ScopeGraph)
|
||||||
import Control.Effect.Carrier
|
import Control.Effect.Carrier
|
||||||
import Data.Abstract.BaseError
|
import Data.Abstract.BaseError
|
||||||
import Data.Abstract.Module
|
import Data.Abstract.Module
|
||||||
@ -172,7 +171,7 @@ forLoop :: ( Carrier sig m
|
|||||||
-> Evaluator term address value m value -- ^ Increment/stepper
|
-> Evaluator term address value m value -- ^ Increment/stepper
|
||||||
-> Evaluator term address value m value -- ^ Body
|
-> Evaluator term address value m value -- ^ Body
|
||||||
-> Evaluator term address value m (ValueRef address value)
|
-> Evaluator term address value m (ValueRef address value)
|
||||||
forLoop initial cond step body = initial *> while cond ((withLexicalScopeAndFrame body) *> step)
|
forLoop initial cond step body = initial *> while cond (withLexicalScopeAndFrame body *> step)
|
||||||
|
|
||||||
data While address value m k
|
data While address value m k
|
||||||
= While (m value) (m value) (ValueRef address value -> k)
|
= While (m value) (m value) (ValueRef address value -> k)
|
||||||
@ -303,7 +302,7 @@ value :: ( Member (Deref value) sig
|
|||||||
)
|
)
|
||||||
=> ValueRef address value
|
=> ValueRef address value
|
||||||
-> Evaluator term address value m value
|
-> Evaluator term address value m value
|
||||||
value (Rval val) = pure val
|
value (Rval val) = pure val
|
||||||
value (LvalMember slot) = deref slot
|
value (LvalMember slot) = deref slot
|
||||||
|
|
||||||
-- | Convenience function for boxing a raw value and wrapping it in an Rval
|
-- | Convenience function for boxing a raw value and wrapping it in an Rval
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE GADTs, KindSignatures, RankNTypes, TypeOperators, UndecidableInstances, ScopedTypeVariables, InstanceSigs, ScopedTypeVariables #-}
|
{-# LANGUAGE GADTs, KindSignatures, RankNTypes, TypeOperators, UndecidableInstances, InstanceSigs #-}
|
||||||
module Data.Abstract.Evaluatable
|
module Data.Abstract.Evaluatable
|
||||||
( module X
|
( module X
|
||||||
, Evaluatable(..)
|
, Evaluatable(..)
|
||||||
@ -118,10 +118,7 @@ instance HasPrelude 'Python where
|
|||||||
|
|
||||||
instance HasPrelude 'Ruby where
|
instance HasPrelude 'Ruby where
|
||||||
definePrelude _ = do
|
definePrelude _ = do
|
||||||
let self = Declaration $ X.name "__self"
|
defineSelf
|
||||||
declare self emptySpan Nothing
|
|
||||||
slot <- lookupDeclaration self
|
|
||||||
assign slot =<< object =<< currentFrame
|
|
||||||
|
|
||||||
void $ defineBuiltIn (Declaration $ X.name "puts") Print
|
void $ defineBuiltIn (Declaration $ X.name "puts") Print
|
||||||
|
|
||||||
@ -129,21 +126,33 @@ instance HasPrelude 'Ruby where
|
|||||||
void $ defineBuiltIn (Declaration $ X.name "inspect") Show
|
void $ defineBuiltIn (Declaration $ X.name "inspect") Show
|
||||||
|
|
||||||
instance HasPrelude 'TypeScript where
|
instance HasPrelude 'TypeScript where
|
||||||
definePrelude _ = do
|
definePrelude _ = defineSelf
|
||||||
let self = Declaration $ X.name "__self"
|
-- defineNamespace (Declaration (X.name "console")) $ defineBuiltIn (Declaration $ X.name "log") Print
|
||||||
declare self emptySpan Nothing
|
|
||||||
slot <- lookupDeclaration self
|
|
||||||
assign slot =<< object =<< currentFrame
|
|
||||||
-- defineNamespace (Declaration (X.name "console")) (builtIn (X.name "log") Print)
|
|
||||||
|
|
||||||
instance HasPrelude 'JavaScript where
|
instance HasPrelude 'JavaScript where
|
||||||
definePrelude _ = do
|
definePrelude _ = do
|
||||||
let self = Declaration $ X.name "__self"
|
defineSelf
|
||||||
declare self emptySpan Nothing
|
|
||||||
slot <- lookupDeclaration self
|
|
||||||
assign slot =<< object =<< currentFrame
|
|
||||||
defineNamespace (Declaration (X.name "console")) $ defineBuiltIn (Declaration $ X.name "log") Print
|
defineNamespace (Declaration (X.name "console")) $ defineBuiltIn (Declaration $ X.name "log") Print
|
||||||
|
|
||||||
|
defineSelf :: ( AbstractValue term address value m
|
||||||
|
, Carrier sig m
|
||||||
|
, Member (State (ScopeGraph address)) sig
|
||||||
|
, Member (Resumable (BaseError (ScopeError address))) sig
|
||||||
|
, Member (Resumable (BaseError (HeapError address))) sig
|
||||||
|
, Member (Deref value) sig
|
||||||
|
, Member (Reader ModuleInfo) sig
|
||||||
|
, Member (Reader Span) sig
|
||||||
|
, Member (State (Heap address address value)) sig
|
||||||
|
, Member (Reader (address, address)) sig
|
||||||
|
, Ord address
|
||||||
|
)
|
||||||
|
=> Evaluator term address value m ()
|
||||||
|
defineSelf = do
|
||||||
|
let self = Declaration $ X.name "__self"
|
||||||
|
declare self emptySpan Nothing
|
||||||
|
slot <- lookupDeclaration self
|
||||||
|
assign slot =<< object =<< currentFrame
|
||||||
|
|
||||||
|
|
||||||
-- Effects
|
-- Effects
|
||||||
|
|
||||||
|
@ -114,7 +114,7 @@ initFrame :: (Ord address) => scope -> address -> Map EdgeLabel (Map scope addre
|
|||||||
initFrame scope address links slots = fillFrame address slots . newFrame scope address links
|
initFrame scope address links slots = fillFrame address slots . newFrame scope address links
|
||||||
|
|
||||||
insertFrame :: Ord address => address -> Frame scope address value -> Heap scope address value -> Heap scope address value
|
insertFrame :: Ord address => address -> Frame scope address value -> Heap scope address value -> Heap scope address value
|
||||||
insertFrame address frame h@Heap{..} = h { heap = (Map.insert address frame heap) }
|
insertFrame address frame h@Heap{..} = h { heap = Map.insert address frame heap }
|
||||||
|
|
||||||
fillFrame :: Ord address => address -> IntMap (Set value) -> Heap scope address value -> Heap scope address value
|
fillFrame :: Ord address => address -> IntMap (Set value) -> Heap scope address value -> Heap scope address value
|
||||||
fillFrame address slots heap =
|
fillFrame address slots heap =
|
||||||
@ -139,7 +139,7 @@ heapRestrict :: Ord address => Heap address address value -> Live address -> Hea
|
|||||||
heapRestrict (Heap m) roots = Heap (Map.filterWithKey (\ address _ -> address `liveMember` roots) m)
|
heapRestrict (Heap m) roots = Heap (Map.filterWithKey (\ address _ -> address `liveMember` roots) m)
|
||||||
|
|
||||||
isHeapEmpty :: (Eq address, Eq value) => Heap scope address value -> Bool
|
isHeapEmpty :: (Eq address, Eq value) => Heap scope address value -> Bool
|
||||||
isHeapEmpty h@Heap{..} = (heapSize h) == 1 &&
|
isHeapEmpty h@Heap{..} = heapSize h == 1 &&
|
||||||
(toEmptyFrame <$> Map.elems heap) == [ Frame () mempty mempty ]
|
(toEmptyFrame <$> Map.elems heap) == [ Frame () mempty mempty ]
|
||||||
where
|
where
|
||||||
toEmptyFrame Frame{..} = Frame () (Map.mapKeysMonotonic (const ()) <$> links) slots
|
toEmptyFrame Frame{..} = Frame () (Map.mapKeysMonotonic (const ()) <$> links) slots
|
||||||
|
@ -42,8 +42,8 @@ data Slot address = Slot { frameAddress :: address, position :: Position }
|
|||||||
deriving (Eq, Show, Ord, Generic, NFData)
|
deriving (Eq, Show, Ord, Generic, NFData)
|
||||||
|
|
||||||
-- Offsets and frame addresses in the heap should be addresses?
|
-- Offsets and frame addresses in the heap should be addresses?
|
||||||
data Scope scopeAddress = Scope {
|
data Scope scopeAddress = Scope
|
||||||
edges :: Map EdgeLabel [scopeAddress] -- Maybe Map EdgeLabel [Path scope]?
|
{ edges :: Map EdgeLabel [scopeAddress] -- Maybe Map EdgeLabel [Path scope]?
|
||||||
, references :: Map Reference (Path scopeAddress)
|
, references :: Map Reference (Path scopeAddress)
|
||||||
, declarations :: Seq (Declaration, (Span, Maybe scopeAddress))
|
, declarations :: Seq (Declaration, (Span, Maybe scopeAddress))
|
||||||
} deriving (Eq, Show, Ord, Generic, NFData)
|
} deriving (Eq, Show, Ord, Generic, NFData)
|
||||||
@ -60,7 +60,7 @@ instance AbstractHole address => AbstractHole (Slot address) where
|
|||||||
newtype Position = Position { unPosition :: Int }
|
newtype Position = Position { unPosition :: Int }
|
||||||
deriving (Eq, Show, Ord, Generic, NFData)
|
deriving (Eq, Show, Ord, Generic, NFData)
|
||||||
|
|
||||||
newtype ScopeGraph scope = ScopeGraph { graph :: Map scope (Scope scope) }
|
newtype ScopeGraph scope = ScopeGraph { unScopeGraph :: Map scope (Scope scope) }
|
||||||
|
|
||||||
instance Ord scope => Lower (ScopeGraph scope) where
|
instance Ord scope => Lower (ScopeGraph scope) where
|
||||||
lowerBound = ScopeGraph mempty
|
lowerBound = ScopeGraph mempty
|
||||||
@ -109,91 +109,76 @@ pathPosition (EPath _ _ p) = pathPosition p
|
|||||||
|
|
||||||
-- Returns the reference paths of a scope in a scope graph.
|
-- Returns the reference paths of a scope in a scope graph.
|
||||||
pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference (Path scope))
|
pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference (Path scope))
|
||||||
pathsOfScope scope = fmap references . Map.lookup scope . graph
|
pathsOfScope scope = fmap references . Map.lookup scope . unScopeGraph
|
||||||
|
|
||||||
-- Returns the declaration data of a scope in a scope graph.
|
-- Returns the declaration data of a scope in a scope graph.
|
||||||
ddataOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Seq (Declaration, (Span, Maybe scope)))
|
ddataOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Seq (Declaration, (Span, Maybe scope)))
|
||||||
ddataOfScope scope = fmap declarations . Map.lookup scope . graph
|
ddataOfScope scope = fmap declarations . Map.lookup scope . unScopeGraph
|
||||||
|
|
||||||
-- Returns the edges of a scope in a scope graph.
|
-- Returns the edges of a scope in a scope graph.
|
||||||
linksOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map EdgeLabel [scope])
|
linksOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map EdgeLabel [scope])
|
||||||
linksOfScope scope = fmap edges . Map.lookup scope . graph
|
linksOfScope scope = fmap edges . Map.lookup scope . unScopeGraph
|
||||||
|
|
||||||
-- Lookup a scope in the scope graph.
|
-- Lookup a scope in the scope graph.
|
||||||
lookupScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Scope scope)
|
lookupScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Scope scope)
|
||||||
lookupScope scope = Map.lookup scope . graph
|
lookupScope scope = Map.lookup scope . unScopeGraph
|
||||||
|
|
||||||
-- Declare a declaration with a span and an associated scope in the scope graph.
|
-- Declare a declaration with a span and an associated scope in the scope graph.
|
||||||
-- TODO: Return the whole value in Maybe or Either.
|
-- TODO: Return the whole value in Maybe or Either.
|
||||||
declare :: Ord scope => Declaration -> Span -> Maybe scope -> scope -> ScopeGraph scope -> (ScopeGraph scope, Maybe Position)
|
declare :: Ord scope => Declaration -> Span -> Maybe scope -> scope -> ScopeGraph scope -> (ScopeGraph scope, Maybe Position)
|
||||||
declare declaration ddata assocScope currentScope g@ScopeGraph{..} = fromMaybe (g, Nothing) $ do
|
declare declaration ddata assocScope currentScope g@(ScopeGraph graph) = fromMaybe (g, Nothing) $ do
|
||||||
scope <- lookupScope currentScope g
|
scope <- lookupScope currentScope g
|
||||||
|
|
||||||
dataSeq <- ddataOfScope currentScope g
|
dataSeq <- ddataOfScope currentScope g
|
||||||
case Seq.findIndexR (\(decl, (span, _)) -> decl == declaration && ddata == span) dataSeq of
|
case Seq.findIndexR (\(decl, (span, _)) -> decl == declaration && ddata == span) dataSeq of
|
||||||
Just index -> pure (g, Just $ Position index)
|
Just index -> pure (g, Just (Position index))
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
let newScope = scope { declarations = (declarations scope) Seq.|> (declaration, (ddata, assocScope)) }
|
let newScope = scope { declarations = declarations scope Seq.|> (declaration, (ddata, assocScope)) }
|
||||||
pure $ (g { graph = Map.insert currentScope newScope graph }, Just . Position $ length (declarations newScope))
|
pure (ScopeGraph (Map.insert currentScope newScope graph), Just (Position (length (declarations newScope))))
|
||||||
|
|
||||||
-- | Add a reference to a declaration in the scope graph.
|
-- | Add a reference to a declaration in the scope graph.
|
||||||
-- Returns the original scope graph if the declaration could not be found.
|
-- Returns the original scope graph if the declaration could not be found.
|
||||||
reference :: Ord scope => Reference -> Declaration -> scope -> ScopeGraph scope -> ScopeGraph scope
|
reference :: Ord scope => Reference -> Declaration -> scope -> ScopeGraph scope -> ScopeGraph scope
|
||||||
reference ref decl@Declaration{..} currentAddress g@ScopeGraph{..} = fromMaybe g $ do
|
reference ref decl@Declaration{..} currentAddress g@(ScopeGraph graph) = fromMaybe g $ do
|
||||||
-- Start from the current address
|
-- Start from the current address
|
||||||
currentScope' <- lookupScope currentAddress g
|
currentScope' <- lookupScope currentAddress g
|
||||||
-- Build a path up to the declaration
|
-- Build a path up to the declaration
|
||||||
go currentScope' currentAddress id
|
go currentScope' currentAddress id
|
||||||
where
|
where
|
||||||
go currentScope address path =
|
go currentScope address path
|
||||||
case lookupDeclaration unDeclaration address g of
|
= ScopeGraph . flip (Map.insert currentAddress) graph . modifyReferences currentScope . Map.insert ref . path . DPath decl . snd <$> lookupDeclaration unDeclaration address g
|
||||||
Just (_, index) ->
|
<|> traverseEdges' Superclass <|> traverseEdges' Import <|> traverseEdges' Lexical
|
||||||
let newScope = currentScope { references = Map.insert ref (path (DPath decl index)) (references currentScope) }
|
where traverseEdges' edge = linksOfScope address g >>= Map.lookup edge >>= traverseEdges path (go currentScope) edge
|
||||||
in Just (g { graph = Map.insert currentAddress newScope graph })
|
|
||||||
Nothing -> let
|
|
||||||
traverseEdges edge = do
|
|
||||||
linkMap <- linksOfScope address g
|
|
||||||
scopes <- Map.lookup edge linkMap
|
|
||||||
-- Return the first path to the declaration through the scopes.
|
|
||||||
getFirst (foldMap (First . ap (go currentScope) ((path .) . EPath edge)) scopes)
|
|
||||||
in traverseEdges Superclass <|> traverseEdges Import <|> traverseEdges Lexical
|
|
||||||
|
|
||||||
-- | Insert a reference into the given scope by constructing a resolution path to the declaration within the given scope graph.
|
-- | Insert a reference into the given scope by constructing a resolution path to the declaration within the given scope graph.
|
||||||
insertImportReference :: Ord address => Reference -> Declaration -> address -> ScopeGraph address -> Scope address -> Maybe (Scope address)
|
insertImportReference :: Ord address => Reference -> Declaration -> address -> ScopeGraph address -> Scope address -> Maybe (Scope address)
|
||||||
insertImportReference ref decl@Declaration{..} currentAddress g@ScopeGraph{..} scope = do
|
insertImportReference ref decl@Declaration{..} currentAddress g scope = go currentAddress (EPath Import currentAddress)
|
||||||
go currentAddress (EPath Import currentAddress)
|
|
||||||
where
|
where
|
||||||
go address path =
|
go address path
|
||||||
case lookupDeclaration unDeclaration address g of
|
= modifyReferences scope . Map.insert ref . path . DPath decl . snd <$> lookupDeclaration unDeclaration address g
|
||||||
Just (_, index) ->
|
<|> traverseEdges' Superclass <|> traverseEdges' Export <|> traverseEdges' Import <|> traverseEdges' Lexical
|
||||||
Just $ scope { references = Map.insert ref (path (DPath decl index)) (references scope) }
|
where traverseEdges' edge = linksOfScope address g >>= Map.lookup edge >>= traverseEdges path go edge
|
||||||
Nothing -> traverseEdges Superclass <|> traverseEdges Export <|> traverseEdges Import <|> traverseEdges Lexical
|
|
||||||
where
|
|
||||||
traverseEdges edge = do
|
|
||||||
linkMap <- linksOfScope address g
|
|
||||||
scopes <- Map.lookup edge linkMap
|
|
||||||
-- Return the first path to the declaration through the scopes.
|
|
||||||
getFirst (foldMap (First . (\scope -> go scope (path . EPath edge scope))) scopes)
|
|
||||||
|
|
||||||
lookupScopePath :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
lookupScopePath :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||||
lookupScopePath declaration currentAddress g@ScopeGraph{..} = do
|
lookupScopePath declaration currentAddress g = go currentAddress id
|
||||||
go currentAddress id
|
|
||||||
where
|
where
|
||||||
go address path =
|
go address path
|
||||||
case lookupDeclaration declaration address g of
|
= path . DPath (Declaration declaration) . snd <$> lookupDeclaration declaration address g
|
||||||
Just (_, index) -> Just $ path (DPath (Declaration declaration) index)
|
<|> path <$> lookupReference declaration address g
|
||||||
Nothing -> maybe Nothing (Just . path) (lookupReference declaration address g)
|
<|> traverseEdges' Superclass <|> traverseEdges' Export <|> traverseEdges' Import <|> traverseEdges' Lexical
|
||||||
<|> traverseEdges Superclass <|> traverseEdges Export <|> traverseEdges Import <|> traverseEdges Lexical
|
where traverseEdges' edge = linksOfScope address g >>= Map.lookup edge >>= traverseEdges path go edge
|
||||||
where
|
|
||||||
traverseEdges edge = do
|
modifyReferences :: Scope scopeAddress -> (Map Reference (Path scopeAddress) -> Map Reference (Path scopeAddress)) -> Scope scopeAddress
|
||||||
linkMap <- linksOfScope address g
|
modifyReferences scope f = scope { references = f (references scope) }
|
||||||
scopes <- Map.lookup edge linkMap
|
|
||||||
getFirst (foldMap (First . (\scope -> go scope (path . EPath edge scope))) scopes)
|
traverseEdges :: Foldable t => (Path scopeAddress -> Path scopeAddress) -> (scopeAddress -> (Path scopeAddress -> Path scopeAddress) -> Maybe a) -> EdgeLabel -> t scopeAddress -> Maybe a
|
||||||
|
-- Return the first path to the declaration through the scopes.
|
||||||
|
traverseEdges path go edge = getFirst . foldMap (First . (go <*> fmap path . EPath edge))
|
||||||
|
|
||||||
lookupDeclaration :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe ((Declaration, (Span, Maybe scopeAddress)), Position)
|
lookupDeclaration :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe ((Declaration, (Span, Maybe scopeAddress)), Position)
|
||||||
lookupDeclaration declaration scope g = do
|
lookupDeclaration declaration scope g = do
|
||||||
dataSeq <- ddataOfScope scope g
|
dataSeq <- ddataOfScope scope g
|
||||||
index <- Seq.findIndexR (((Declaration declaration) ==) . fst) dataSeq
|
index <- Seq.findIndexR ((Declaration declaration ==) . fst) dataSeq
|
||||||
(, Position index) <$> Seq.lookup index dataSeq
|
(, Position index) <$> Seq.lookup index dataSeq
|
||||||
|
|
||||||
declarationNames :: Ord address => [EdgeLabel] -> Scope address -> ScopeGraph address -> Set Declaration
|
declarationNames :: Ord address => [EdgeLabel] -> Scope address -> ScopeGraph address -> Set Declaration
|
||||||
@ -204,48 +189,48 @@ declarationNames edgeLabels scope scopeGraph = localDeclarations <> edgeNames
|
|||||||
|
|
||||||
|
|
||||||
putDeclarationScopeAtPosition :: Ord scopeAddress => scopeAddress -> Position -> Maybe scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
putDeclarationScopeAtPosition :: Ord scopeAddress => scopeAddress -> Position -> Maybe scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||||
putDeclarationScopeAtPosition scope position assocScope g = fromMaybe g $ do
|
putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = fromMaybe g $ do
|
||||||
dataSeq <- ddataOfScope scope g
|
dataSeq <- ddataOfScope scope g
|
||||||
let seq = Seq.adjust' (\(d, (span, _)) -> (d, (span, assocScope))) (unPosition position) dataSeq
|
let seq = Seq.adjust' (\(d, (span, _)) -> (d, (span, assocScope))) (unPosition position) dataSeq
|
||||||
pure $ g { graph = Map.adjust (\s -> s { declarations = seq }) scope (graph g) }
|
pure $ ScopeGraph (Map.adjust (\s -> s { declarations = seq }) scope graph)
|
||||||
|
|
||||||
lookupReference :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
lookupReference :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
|
||||||
lookupReference name scope g = Map.lookup (Reference name) =<< pathsOfScope scope g
|
lookupReference name scope g = Map.lookup (Reference name) =<< pathsOfScope scope g
|
||||||
|
|
||||||
insertEdge :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
insertEdge :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||||
insertEdge label target currentAddress g@ScopeGraph{..} = fromMaybe g $ do
|
insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do
|
||||||
currentScope' <- lookupScope currentAddress g
|
currentScope' <- lookupScope currentAddress g
|
||||||
scopes <- maybe (Just mempty) pure (Map.lookup label (edges currentScope'))
|
scopes <- maybeM (Just mempty) (Map.lookup label (edges currentScope'))
|
||||||
let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') }
|
let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') }
|
||||||
pure (g { graph = Map.insert currentAddress newScope graph })
|
pure (ScopeGraph (Map.insert currentAddress newScope graph))
|
||||||
|
|
||||||
|
|
||||||
-- | Insert associate the given associated scope into the declaration in the scope graph.
|
-- | Insert associate the given associated scope into the declaration in the scope graph.
|
||||||
insertDeclarationScope :: Ord scopeAddress => Declaration -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
insertDeclarationScope :: Ord scopeAddress => Declaration -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||||
insertDeclarationScope decl@Declaration{..} address currentAddress g@ScopeGraph{..} = fromMaybe g $ do
|
insertDeclarationScope decl@Declaration{..} address currentAddress g@(ScopeGraph graph) = fromMaybe g $ do
|
||||||
declScope <- pathDeclarationScope currentAddress =<< lookupScopePath unDeclaration currentAddress g
|
declScope <- pathDeclarationScope currentAddress =<< lookupScopePath unDeclaration currentAddress g
|
||||||
(span, position) <- (fst . snd . fst &&& unPosition . snd) <$> lookupDeclaration unDeclaration declScope g
|
(span, position) <- (fst . snd . fst &&& unPosition . snd) <$> lookupDeclaration unDeclaration declScope g
|
||||||
scope <- lookupScope declScope g
|
scope <- lookupScope declScope g
|
||||||
pure $ g { graph = Map.insert declScope (scope { declarations = Seq.adjust (const (decl, (span, Just address))) position (declarations scope) }) graph }
|
pure $ ScopeGraph (Map.insert declScope (scope { declarations = Seq.adjust (const (decl, (span, Just address))) position (declarations scope) }) graph)
|
||||||
|
|
||||||
-- | Insert a declaration span into the declaration in the scope graph.
|
-- | Insert a declaration span into the declaration in the scope graph.
|
||||||
insertDeclarationSpan :: Ord scopeAddress => Declaration -> Span -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
insertDeclarationSpan :: Ord scopeAddress => Declaration -> Span -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
|
||||||
insertDeclarationSpan decl@Declaration{..} span g@ScopeGraph{..} = fromMaybe g $ do
|
insertDeclarationSpan decl@Declaration{..} span g@(ScopeGraph graph) = fromMaybe g $ do
|
||||||
declScope <- scopeOfDeclaration decl g
|
declScope <- scopeOfDeclaration decl g
|
||||||
(associatedScope, position) <- (snd . snd . fst &&& unPosition . snd) <$> lookupDeclaration unDeclaration declScope g
|
(associatedScope, position) <- (snd . snd . fst &&& unPosition . snd) <$> lookupDeclaration unDeclaration declScope g
|
||||||
scope <- lookupScope declScope g
|
scope <- lookupScope declScope g
|
||||||
pure $ g { graph = Map.insert declScope (scope { declarations = Seq.adjust (const (decl, (span, associatedScope))) position (declarations scope) }) graph }
|
pure $ ScopeGraph (Map.insert declScope (scope { declarations = Seq.adjust (const (decl, (span, associatedScope))) position (declarations scope) }) graph)
|
||||||
|
|
||||||
-- | Insert a new scope with the given address and edges into the scope graph.
|
-- | Insert a new scope with the given address and edges into the scope graph.
|
||||||
newScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address
|
newScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address
|
||||||
newScope address edges = insertScope address (Scope edges mempty mempty)
|
newScope address edges = insertScope address (Scope edges mempty mempty)
|
||||||
|
|
||||||
insertScope :: Ord address => address -> Scope address -> ScopeGraph address -> ScopeGraph address
|
insertScope :: Ord address => address -> Scope address -> ScopeGraph address -> ScopeGraph address
|
||||||
insertScope address scope g@ScopeGraph{..} = g { graph = Map.insert address scope graph }
|
insertScope address scope = ScopeGraph . Map.insert address scope . unScopeGraph
|
||||||
|
|
||||||
-- | Returns the scope of a reference in the scope graph.
|
-- | Returns the scope of a reference in the scope graph.
|
||||||
scopeOfRef :: Ord scope => Reference -> ScopeGraph scope -> Maybe scope
|
scopeOfRef :: Ord scope => Reference -> ScopeGraph scope -> Maybe scope
|
||||||
scopeOfRef ref g@ScopeGraph{..} = go (Map.keys graph)
|
scopeOfRef ref g@(ScopeGraph graph) = go (Map.keys graph)
|
||||||
where
|
where
|
||||||
go (s : scopes') = fromMaybe (go scopes') $ do
|
go (s : scopes') = fromMaybe (go scopes') $ do
|
||||||
pathMap <- pathsOfScope s g
|
pathMap <- pathsOfScope s g
|
||||||
@ -262,17 +247,15 @@ pathOfRef ref graph = do
|
|||||||
|
|
||||||
-- Returns the scope the declaration was declared in.
|
-- Returns the scope the declaration was declared in.
|
||||||
scopeOfDeclaration :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
|
scopeOfDeclaration :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
|
||||||
scopeOfDeclaration Declaration{..} g@ScopeGraph{..} = go (Map.keys graph)
|
scopeOfDeclaration Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph)
|
||||||
where
|
where
|
||||||
go (scope : scopes') = fromMaybe (go scopes') $ lookupDeclaration unDeclaration scope g >> pure (Just scope)
|
go = foldr (\ scope -> (scope <$ lookupDeclaration unDeclaration scope g <|>)) Nothing
|
||||||
go [] = Nothing
|
|
||||||
|
|
||||||
-- | Returns the scope associated with a declaration (the child scope if any exists).
|
-- | Returns the scope associated with a declaration (the child scope if any exists).
|
||||||
associatedScope :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
|
associatedScope :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope
|
||||||
associatedScope Declaration{..} g@ScopeGraph{..} = go (Map.keys graph)
|
associatedScope Declaration{..} g@(ScopeGraph graph) = go (Map.keys graph)
|
||||||
where
|
where
|
||||||
go (scope : scopes') = fromMaybe (go scopes') $ snd . snd . fst <$> lookupDeclaration unDeclaration scope g
|
go = foldr (\ scope -> ((lookupDeclaration unDeclaration scope g >>= snd . snd . fst) <|>)) Nothing
|
||||||
go [] = Nothing
|
|
||||||
|
|
||||||
newtype Reference = Reference { unReference :: Name }
|
newtype Reference = Reference { unReference :: Name }
|
||||||
deriving (Eq, Ord, Show, Generic, NFData)
|
deriving (Eq, Ord, Show, Generic, NFData)
|
||||||
|
@ -38,9 +38,9 @@ data Value term address
|
|||||||
| String Text
|
| String Text
|
||||||
| Symbol Text
|
| Symbol Text
|
||||||
| Regex Text
|
| Regex Text
|
||||||
| Tuple [(Value term address)]
|
| Tuple [Value term address]
|
||||||
| Array [(Value term address)]
|
| Array [Value term address]
|
||||||
| Class Declaration [(Value term address)] address
|
| Class Declaration [Value term address] address
|
||||||
| Object address
|
| Object address
|
||||||
| Namespace Name address
|
| Namespace Name address
|
||||||
| KVPair (Value term address) (Value term address)
|
| KVPair (Value term address) (Value term address)
|
||||||
@ -350,7 +350,7 @@ data ValueError term address resume where
|
|||||||
BitwiseError :: Value term address -> ValueError term address (Value term address)
|
BitwiseError :: Value term address -> ValueError term address (Value term address)
|
||||||
Bitwise2Error :: Value term address -> Value term address -> ValueError term address (Value term address)
|
Bitwise2Error :: Value term address -> Value term address -> ValueError term address (Value term address)
|
||||||
KeyValueError :: Value term address -> ValueError term address (Value term address, Value term address)
|
KeyValueError :: Value term address -> ValueError term address (Value term address, Value term address)
|
||||||
ArrayError :: Value term address -> ValueError term address [(Value term address)]
|
ArrayError :: Value term address -> ValueError term address [Value term address]
|
||||||
-- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching.
|
-- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching.
|
||||||
ArithmeticError :: ArithException -> ValueError term address (Value term address)
|
ArithmeticError :: ArithException -> ValueError term address (Value term address)
|
||||||
-- Out-of-bounds error
|
-- Out-of-bounds error
|
||||||
|
@ -153,7 +153,7 @@ instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec
|
|||||||
instance Evaluatable VariableDeclaration where
|
instance Evaluatable VariableDeclaration where
|
||||||
eval _ (VariableDeclaration []) = rvalBox unit
|
eval _ (VariableDeclaration []) = rvalBox unit
|
||||||
eval eval (VariableDeclaration decs) = do
|
eval eval (VariableDeclaration decs) = do
|
||||||
_ <- for decs $ \declaration -> do
|
for_ decs $ \declaration -> do
|
||||||
name <- maybeM (throwEvalError NoNameError) (declaredName declaration)
|
name <- maybeM (throwEvalError NoNameError) (declaredName declaration)
|
||||||
declare (Declaration name) emptySpan Nothing
|
declare (Declaration name) emptySpan Nothing
|
||||||
(span, _) <- do
|
(span, _) <- do
|
||||||
@ -242,8 +242,8 @@ instance Evaluatable Class where
|
|||||||
(Just scope, Just frame) -> Just (scope, frame)
|
(Just scope, Just frame) -> Just (scope, frame)
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
let superclassEdges = fmap (Superclass, ) . fmap (pure . fst) . catMaybes $ superScopes
|
let superclassEdges = (Superclass, ) . pure . fst <$> catMaybes superScopes
|
||||||
current = fmap (Lexical, ) . pure . pure $ currentScope'
|
current = (Lexical, ) <$> pure (pure currentScope')
|
||||||
edges = Map.fromList (superclassEdges <> current)
|
edges = Map.fromList (superclassEdges <> current)
|
||||||
childScope <- newScope edges
|
childScope <- newScope edges
|
||||||
declare (Declaration name) span (Just childScope)
|
declare (Declaration name) span (Just childScope)
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE DeriveAnyClass, LambdaCase #-}
|
{-# LANGUAGE DeriveAnyClass #-}
|
||||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||||
module Language.Go.Syntax where
|
module Language.Go.Syntax where
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user