8000 Merge pull request #524 from github/crossroads · github/semantic@c671d17 · GitHub
[go: up one dir, main page]
Skip to content
This repository was archived by the owner on Apr 1, 2025. It is now read-only.

Commit c671d17

Browse files
joshverajoshvera
authored
Merge pull request #524 from github/crossroads
Implement concatenation algorithm for paths.
2 parents 15e982d + b2fd702 commit c671d17

File tree

2 files changed

+113
-4
lines changed

2 files changed

+113
-4
lines changed

‎semantic-scope-graph/src/Data/Functor/Tagged.hs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ module Data.Functor.Tagged
1313
-- * Monadic creation functions
1414
, taggedM
1515
, taggedIO
16+
, unsafeTagged
1617
-- * Reexports
1718
, extract
1819
) where
@@ -21,6 +22,7 @@ import Control.Comonad
2122
import Control.Effect.Fresh
2223
import Control.Lens.Getter
2324
import Control.Lens.Lens
25+
import System.IO.Unsafe
2426
import Data.Function
2527
import Data.Generics.Product
2628
import Data.Unique
@@ -63,3 +65,8 @@ taggedM a = (a :#) <$> fresh
6365
-- ordered, but are guaranteed to be unique throughout the life of the program.
6466
taggedIO :: a -> IO (Tagged a)
6567
taggedIO a = (a :#) . hashUnique <$> newUnique
68+
69+
-- This is bad. Don't use it.
70+
unsafeTagged :: a -> Tagged a
71+
unsafeTagged = unsafePerformIO . taggedIO
72+
{-# NOINLINE unsafeTagged #-}

‎semantic-scope-graph/src/Stack/Path.hs

Lines changed: 106 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,14 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE TypeApplications #-}
14
{-# LANGUAGE NamedFieldPuns #-}
25
{-# LANGUAGE OverloadedLists #-}
6+
{-# LANGUAGE OverloadedStrings #-}
37
module Stack.Path
48
( Path (..)
9+
, Compatibility (..)
10+
, compatibility
11+
, concatenate
512
, Edge (..)
613
, StartingSize (..)
714
, PathInvariantError (..)
@@ -12,15 +19,20 @@ module Stack.Path
1219
, Completion (..)
1320
, completion
1421
, isIncremental
22+
1523
) where
1624

1725

1826
import Data.Functor.Tagged
1927
import Data.Monoid
2028
import Data.Semigroup (sconcat)
21-
import Data.Sequence (Seq (..))
29+
import Data.Sequence (Seq (..), (|>))
2230
import Data.Text (Text)
2331
import Stack.Graph (Node (..), Symbol)
32+
import Data.Generics.Product
33+
import Control.Lens.Getter ((^.))
34+
import GHC.Generics
35+
import Data.List (isPrefixOf)
2436

2537
-- | A partial path through a stack graph. These will be generated
2638
-- from walks through the stack graph, and can be thought of as
@@ -34,7 +46,7 @@ data Path = Path
3446
, endingSymbolStack :: [Symbol]
3547
, startingScopeStackSize :: StartingSize
3648
, endingScopeStack :: [Tag]
37-
} deriving (Eq, Show)
49+
} deriving (Eq, Show, Generic)
3850

3951
data Edge = Edge
4052
{ sourceNode :: Tagged Node
@@ -45,7 +57,7 @@ data Edge = Edge
4557
data StartingSize
4658
= Zero
4759
| One
48-
deriving (Eq, Show)
60+
deriving (Eq, Show, Ord, Enum)
4961

5062
data PathInvariantError
5163
= ExpectedEqual (Tagged Node) (Tagged Node)
@@ -120,7 +132,10 @@ validity p = sconcat [vStart, vEnd, vSize]
120132
(One, _) -> Invalid
121133
_otherwise -> Valid
122134

123-
data Completion = Partial | Complete
135+
data Completion
136+
= Partial
137+
| Complete
138+
deriving (Eq, Show)
124139

125140
-- | A path is complete if its starting node is a reference node and its ending node is a definition node. Otherwise it is partial.
126141
completion :: Path -> Completion
@@ -130,3 +145,90 @@ completion _
130145
-- | A path is incremental if the source node and sink node of every edge in the path belongs to the same file.
131146
isIncremental :: Path -> Bool
132147
isIncremental = error "TODO: need file support to implement this"
148+
149+
data Compatibility
150+
= Compatible
151+
| Incompatible
152+
deriving (Eq, Show)
153+
154+
compatibility :: Path -> Path -> Compatibility
155+
compatibility left right
156+
-- Two paths 'left' and 'right' are compatible with each other if all the following are true:
157+
| and @[] [nodesCompatible, stackPrefix, hasElements] = Compatible
158+
| otherwise = Incompatible
159+
where
160+
-- Any of the following are true:
161+
nodesCompatible =
162+
-- The ending node of 'left' and the starting node of 'right' are both the root node.
163+
let bothRootNode = left ^. field @"endingNode".contents == Root && right ^. field @"startingNode".contents == Root
164+
-- The ending node of 'left' and the starting node of 'right' are both scope references, and both refer to the same scope
165+
bothSameScope = case (endingNode left, startingNode right) of
166+
-- TODO: determining "same scope" by symbol comparison is rough
167+
-- should we be comparing tags as well?
168+
(Scope s1 :# _, Scope s2 :# _) -> s1 == s2
169+
_ -> False
170+
in bothRootNode || bothSameScope
171+
-- The starting symbol stack of 'right' is a prefix of the ending symbol stack of 'left'.
172+
stackPrefix = startingSymbolStack right `isPrefixOf` endingSymbolStack left
173+
-- The ending scope stack of 'left' has at least as many elements as the starting scope stack size of 'right'.
174+
hasElements = length (endingScopeStack left) >= fromEnum (startingScopeStackSize right)
175+
176+
concatenate :: Path -> Path -> Maybe Path
177+
concatenate left right
178+
-- Incompatible paths cannot be concatenated.
179+
| compatibility left right == Incompatible = Nothing
180+
-- If left and right are compatible with each other, you can concatenate them together, yielding a new path:
181+
| otherwise =
182+
-- The new path's starting node, starting symbol stack, and starting scope stack size are the same as left.
183+
let (newStartingNode, newStartingSymbolStack, newStartingScopeStackSize) = (startingNode left, startingSymbolStack left, startingScopeStackSize left)
184+
-- The new path's edge list is the concatenation of left's and right's edge lists.
185+
allEdges = edges left <> edges right
186+
-- The new path's ending symbol stack is the value of new symbol stack after doing the following:
187+
newEndingSymbolStack =
188+
-- Let new symbol stack be a copy of left's ending symbol stack.
189+
let newSymbolStack = endingSymbolStack left
190+
-- Remove right's starting symbol stack from the beginning of new symbol stack. (This must succeed because the two input paths are compatible.)
191+
withoutRight = drop (length (startingSymbolStack right)) newSymbolStack
192+
in -- Prepend a copy of right's ending symbol stack to the beginning of new symbol stack.
193+
endingSymbolStack right <> withoutRight
194+
-- The new path's ending scope stack is the value of new scope stack after doing the following:
195+
newEndingScopeStack =
196+
-- Let new scope stack be a copy of left's ending scope stack.
197+
let newScopeStack = endingScopeStack left
198+
-- If right's starting scope stack size is 1, pop resolved scope identifier from the beginning of new scope stack.
199+
popped = if startingScopeStackSize right == One then drop 1 newScopeStack else newScopeStack
200+
in -- Prepend a copy of right's ending scope stack to the beginning of new scope stack.
201+
endingScopeStack right <> popped
202+
-- The new path's ending node is the same as right's.
203+
newEndingNode = endingNode right
204+
newEdges = case newEndingNode of
205+
-- If right's ending node is a jump to scope node node, then:
206+
JumpToScope :# _ ->
207+
-- Let jump edge be a new edge whose:
208+
let jumpEdge =
209+
Edge
210+
{ sourceNode = newEndingNode, -- source node is node
211+
212+
-- PT TODO: we don't appear to have scope identifiers attached to exported scope nodes
213+
-- Also: calling unsafeTagged here is a sin, but this function should be pure, so whatever.
214+
-- If anyone haa a better idea, hit me up.
215+
216+
-- sink node is an exported scope node whose scope identifier is resolved scope identifier
217+
sinkNode = unsafeTagged ExportedScope,
218+
-- label is `jump``
219+
label = "jump"
220+
}
221+
in -- Append jump edge to the new path.
222+
(allEdges |> jumpEdge)
223+
-- Otherwise, do nothing
224+
_ -> allEdges
225+
in Just
226+
Path
227+
{ startingNode = newStartingNode,
228+
endingNode = newEndingNode,
229+
edges = newEdges,
230+
startingSymbolStack = newStartingSymbolStack,
231+
endingSymbolStack = newEndingSymbolStack,
232+
startingScopeStackSize = newStartingScopeStackSize,
233+
endingScopeStack = newEndingScopeStack
234+
}

0 commit comments

Comments
 (0)
0