Make the embedMap a Map.

This commit is contained in:
Robbie Gleichman 2019-07-31 12:01:37 -07:00
parent aa63e6107a
commit ff761f8db8
3 changed files with 14 additions and 8 deletions

View File

@ -13,6 +13,7 @@ import Control.Monad.State(State, evalState)
import Data.Either(partitionEithers) import Data.Either(partitionEithers)
import qualified Data.Graph.Inductive.PatriciaTree as FGR import qualified Data.Graph.Inductive.PatriciaTree as FGR
import Data.List(unzip5, partition, intercalate) import Data.List(unzip5, partition, intercalate)
import qualified Data.Map as Map
import Data.Maybe(fromMaybe, mapMaybe) import Data.Maybe(fromMaybe, mapMaybe)
import qualified Data.Set as Set import qualified Data.Set as Set
@ -132,13 +133,14 @@ patternArgumentMapper (asGraphAndRef@(graphAndRef, _), port)
graphToTuple :: graphToTuple ::
SyntaxGraph SyntaxGraph
-> ([SgNamedNode], [Edge], [SgSink], [SgBind], [(NodeName, NodeName)]) -> ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
graphToTuple (SyntaxGraph a b c d e) = (a, b, c, d, e) graphToTuple (SyntaxGraph a b c d e) = (a, b, c, d, e)
graphsToComponents :: graphsToComponents ::
[SyntaxGraph] [SyntaxGraph]
-> ([SgNamedNode], [Edge], [SgSink], [SgBind], [(NodeName, NodeName)]) -> ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
graphsToComponents graphs = (concat a, concat b, concat c, concat d, concat e) graphsToComponents graphs
= (mconcat a, mconcat b, mconcat c, mconcat d, mconcat e)
where where
(a, b, c, d, e) = unzip5 $ fmap graphToTuple graphs (a, b, c, d, e) = unzip5 $ fmap graphToTuple graphs
@ -175,7 +177,8 @@ makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
asNameBinds = mapMaybe asNameBind argVals asNameBinds = mapMaybe asNameBind argVals
allBinds = nestedBinds <> asNameBinds allBinds = nestedBinds <> asNameBinds
newEMap = ((\(Named n _) -> (n, applyIconName)) <$> nestedArgs) newEMap = Map.fromList
((\(Named n _) -> (n, applyIconName)) <$> nestedArgs)
<> nestedEMaps <> nestedEMaps
newGraph = SyntaxGraph newGraph = SyntaxGraph

View File

@ -33,6 +33,7 @@ import Data.Either(partitionEithers)
import qualified Data.Graph.Inductive.Graph as ING import qualified Data.Graph.Inductive.Graph as ING
import qualified Data.Graph.Inductive.PatriciaTree as FGR import qualified Data.Graph.Inductive.PatriciaTree as FGR
import Data.List(find) import Data.List(find)
import qualified Data.Map as Map
import Data.Semigroup(Semigroup, (<>)) import Data.Semigroup(Semigroup, (<>))
import qualified Data.Set as Set import qualified Data.Set as Set
@ -71,7 +72,7 @@ data SyntaxGraph = SyntaxGraph {
sgBinds :: [SgBind], sgBinds :: [SgBind],
-- sgEmbedMap keeps track of nodes embedded in other nodes. If (child, parent) -- sgEmbedMap keeps track of nodes embedded in other nodes. If (child, parent)
-- is in the Map, then child is embedded inside parent. -- is in the Map, then child is embedded inside parent.
sgEmbedMap :: [(NodeName, NodeName)] sgEmbedMap :: Map.Map NodeName NodeName
} deriving (Show, Eq) } deriving (Show, Eq)
instance Semigroup SyntaxGraph where instance Semigroup SyntaxGraph where
@ -351,9 +352,9 @@ nestedPatternNodeToIcon str children = NestedPApp
makeLNode :: SgNamedNode -> ING.LNode SgNamedNode makeLNode :: SgNamedNode -> ING.LNode SgNamedNode
makeLNode namedNode@(Named (NodeName name) _) = (name, namedNode) makeLNode namedNode@(Named (NodeName name) _) = (name, namedNode)
lookupInEmbeddingMap :: NodeName -> [(NodeName, NodeName)] -> NodeName lookupInEmbeddingMap :: NodeName -> Map.Map NodeName NodeName -> NodeName
lookupInEmbeddingMap origName eMap = lookupHelper origName where lookupInEmbeddingMap origName eMap = lookupHelper origName where
lookupHelper name = case lookup name eMap of lookupHelper name = case Map.lookup name eMap of
Nothing -> name Nothing -> name
Just parent -> if parent == origName Just parent -> if parent == origName
then error $ "lookupInEmbeddingMap: Found cycle. Node = " then error $ "lookupInEmbeddingMap: Found cycle. Node = "

View File

@ -5,6 +5,7 @@ module UnitTests(
import Test.HUnit import Test.HUnit
import Data.List(foldl', sort, sortOn) import Data.List(foldl', sort, sortOn)
import qualified Data.Map as Map
import Translate(translateStringToSyntaxGraph) import Translate(translateStringToSyntaxGraph)
import TranslateCore(SyntaxGraph(..), SgBind(..)) import TranslateCore(SyntaxGraph(..), SgBind(..))
@ -100,7 +101,8 @@ renameGraph (SyntaxGraph nodes edges sinks sources embedMap) =
(renamedNodes, nameMap, _) = foldl' renameNodeFolder ([], [], 0) $ sortOn removeNames nodes (renamedNodes, nameMap, _) = foldl' renameNodeFolder ([], [], 0) $ sortOn removeNames nodes
renamedEdges = sort $ fmap (renameEdge nameMap) edges renamedEdges = sort $ fmap (renameEdge nameMap) edges
renamedSources = sort $ fmap (renameSource nameMap) sources renamedSources = sort $ fmap (renameSource nameMap) sources
renamedEmbedMap = sort $ fmap (renameEmbed nameMap) embedMap renamedEmbedMap
= Map.fromList $ sort $ renameEmbed nameMap <$> Map.toList embedMap
-- END renameGraph -- END renameGraph