Fix edge transfer for embedded pattern apply.

This commit is contained in:
Robbie Gleichman 2016-11-27 18:07:14 -08:00
parent 02446b5b15
commit 860e00a724
3 changed files with 4 additions and 7 deletions

View File

@ -166,11 +166,9 @@ childCanBeEmbedded parentNode graph child =
findChildEdgesToTransfer :: ING.Graph gr => ING.Node -> [ING.Node] -> gr a b-> [ING.LEdge b]
findChildEdgesToTransfer parentNode nodes graph = concatMap makeLabelledGraphEdges nodes where
makeLabelledGraphEdges childNode = changeEdgeToParent parentNode childNode <$>
-- TODO FIX ME. Does not work for pattern apply.
--filter (not . edgeGoesToParent parentNode)
--(ING.inn graph childNode ++ ING.out graph childNode)
ING.inn graph childNode
++
filter (not. edgeGoesToParent parentNode) (ING.out graph childNode)
edgeGoesToParent :: ING.Node -> ING.LEdge b -> Bool
edgeGoesToParent parentNode (fromNode, toNode, _)

View File

@ -497,13 +497,13 @@ collapseTestStrings = [
makeCollapseTest :: String -> IO (Diagram B)
makeCollapseTest str = do
before <- renderFglGraph fglGraph
after <- renderFglGraph collapsedGraph
afterCollapse <- renderFglGraph collapsedGraph
pure $ vsep 1 [
expressionText,
beforeText,
before,
afterText,
after]
afterCollapse]
where
fglGraph = syntaxGraphToFglGraph $ stringToSyntaxGraph str
collapsedGraph = collapseNodes fglGraph

View File

@ -1,5 +1,4 @@
-- TODO Now --
Fix child edge transfer for embedded pattern apply.
-- TODO Later --
-- Add documentation.