github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-15 01:51:39 +03:00
Code Issues Projects Releases Wiki Activity

Generalize foldrGraph to foldGraph producing a Monoidal value.

Browse Source 
Co-Authored-By: Rick Winfrey <rick.winfrey@gmail.com>
This commit is contained in:
Rob Rix 2018-12-06 15:42:36 -05:00
parent 664877024d
commit a4ec6dc3a8
1 changed files with 11 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/Data/Abstract/ScopeGraph.hs
View File

@ -31,6 +31,7 @@ module Data.Abstract.ScopeGraph
import Control.Abstract.Hole import Control.Abstract.Hole
import Data.Abstract.Name import Data.Abstract.Name
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Monoid (Alt(..))
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Span import Data.Span
@ -142,23 +143,23 @@ lookupScopePath :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeA
lookupScopePath declaration currentAddress g = findPath (flip (lookupReference declaration) g) (Declaration declaration) currentAddress g lookupScopePath declaration currentAddress g = findPath (flip (lookupReference declaration) g) (Declaration declaration) currentAddress g
findPath :: Ord scopeAddress => (scopeAddress -> Maybe (Path scopeAddress)) -> Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress) findPath :: Ord scopeAddress => (scopeAddress -> Maybe (Path scopeAddress)) -> Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
findPath extra decl currentAddress g = snd <$> foldrGraph combine currentAddress g findPath extra decl currentAddress g = snd <$> getAlt (foldGraph combine currentAddress g)
where combine address path = fmap (address, ) where combine address path = fmap (address, )
$ pathToDeclaration decl address g $ Alt (pathToDeclaration decl address g)
<|> extra address <|> Alt (extra address)
<|> uncurry (EPath Superclass) <$> path Superclass <|> uncurry (EPath Superclass) <$> path Superclass
<|> uncurry (EPath Import) <$> path Import <|> uncurry (EPath Import) <$> path Import
<|> uncurry (EPath Export) <$> path Export <|> uncurry (EPath Export) <$> path Export
<|> uncurry (EPath Lexical) <$> path Lexical <|> uncurry (EPath Lexical) <$> path Lexical
foldrGraph :: Ord scopeAddress => (scopeAddress -> (EdgeLabel -> Maybe a) -> Maybe a) -> scopeAddress -> ScopeGraph scopeAddress -> Maybe a foldGraph :: (Ord scopeAddress, Monoid a) => (scopeAddress -> (EdgeLabel -> a) -> a) -> scopeAddress -> ScopeGraph scopeAddress -> a
foldrGraph combine address graph = go lowerBound address foldGraph combine address graph = go lowerBound address
where go visited address where go visited address
| address `Set.member` visited = Nothing | address `Set.notMember` visited
| otherwise = do , Just edges <- linksOfScope address graph = combine address (recur edges)
edges <- linksOfScope address graph | otherwise = mempty
let visited' = Set.insert address visited where visited' = Set.insert address visited
combine address (flip Map.lookup edges >=> foldMapA (go visited')) recur edges edge = maybe mempty (foldMap (go visited')) (Map.lookup edge edges)
pathToDeclaration :: Ord scopeAddress => Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress) pathToDeclaration :: Ord scopeAddress => Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress)
pathToDeclaration decl address g = DPath decl . snd <$> lookupDeclaration (unDeclaration decl) address g pathToDeclaration decl address g = DPath decl . snd <$> lookupDeclaration (unDeclaration decl) address g