mirror of
https://github.com/rgleichman/glance.git
synced 2024-11-22 05:38:23 +03:00
Make the embedMap a Map.
This commit is contained in:
parent
aa63e6107a
commit
ff761f8db8
@ -13,6 +13,7 @@ import Control.Monad.State(State, evalState)
|
||||
import Data.Either(partitionEithers)
|
||||
import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
import Data.List(unzip5, partition, intercalate)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe(fromMaybe, mapMaybe)
|
||||
import qualified Data.Set as Set
|
||||
|
||||
@ -132,13 +133,14 @@ patternArgumentMapper (asGraphAndRef@(graphAndRef, _), port)
|
||||
|
||||
graphToTuple ::
|
||||
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)
|
||||
|
||||
graphsToComponents ::
|
||||
[SyntaxGraph]
|
||||
-> ([SgNamedNode], [Edge], [SgSink], [SgBind], [(NodeName, NodeName)])
|
||||
graphsToComponents graphs = (concat a, concat b, concat c, concat d, concat e)
|
||||
-> ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
|
||||
graphsToComponents graphs
|
||||
= (mconcat a, mconcat b, mconcat c, mconcat d, mconcat e)
|
||||
where
|
||||
(a, b, c, d, e) = unzip5 $ fmap graphToTuple graphs
|
||||
|
||||
@ -175,7 +177,8 @@ makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
|
||||
asNameBinds = mapMaybe asNameBind argVals
|
||||
allBinds = nestedBinds <> asNameBinds
|
||||
|
||||
newEMap = ((\(Named n _) -> (n, applyIconName)) <$> nestedArgs)
|
||||
newEMap = Map.fromList
|
||||
((\(Named n _) -> (n, applyIconName)) <$> nestedArgs)
|
||||
<> nestedEMaps
|
||||
|
||||
newGraph = SyntaxGraph
|
||||
|
@ -33,6 +33,7 @@ import Data.Either(partitionEithers)
|
||||
import qualified Data.Graph.Inductive.Graph as ING
|
||||
import qualified Data.Graph.Inductive.PatriciaTree as FGR
|
||||
import Data.List(find)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Semigroup(Semigroup, (<>))
|
||||
import qualified Data.Set as Set
|
||||
|
||||
@ -71,7 +72,7 @@ data SyntaxGraph = SyntaxGraph {
|
||||
sgBinds :: [SgBind],
|
||||
-- sgEmbedMap keeps track of nodes embedded in other nodes. If (child, parent)
|
||||
-- is in the Map, then child is embedded inside parent.
|
||||
sgEmbedMap :: [(NodeName, NodeName)]
|
||||
sgEmbedMap :: Map.Map NodeName NodeName
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Semigroup SyntaxGraph where
|
||||
@ -351,9 +352,9 @@ nestedPatternNodeToIcon str children = NestedPApp
|
||||
makeLNode :: SgNamedNode -> ING.LNode SgNamedNode
|
||||
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
|
||||
lookupHelper name = case lookup name eMap of
|
||||
lookupHelper name = case Map.lookup name eMap of
|
||||
Nothing -> name
|
||||
Just parent -> if parent == origName
|
||||
then error $ "lookupInEmbeddingMap: Found cycle. Node = "
|
||||
|
@ -5,6 +5,7 @@ module UnitTests(
|
||||
import Test.HUnit
|
||||
|
||||
import Data.List(foldl', sort, sortOn)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Translate(translateStringToSyntaxGraph)
|
||||
import TranslateCore(SyntaxGraph(..), SgBind(..))
|
||||
@ -100,7 +101,8 @@ renameGraph (SyntaxGraph nodes edges sinks sources embedMap) =
|
||||
(renamedNodes, nameMap, _) = foldl' renameNodeFolder ([], [], 0) $ sortOn removeNames nodes
|
||||
renamedEdges = sort $ fmap (renameEdge nameMap) edges
|
||||
renamedSources = sort $ fmap (renameSource nameMap) sources
|
||||
renamedEmbedMap = sort $ fmap (renameEmbed nameMap) embedMap
|
||||
renamedEmbedMap
|
||||
= Map.fromList $ sort $ renameEmbed nameMap <$> Map.toList embedMap
|
||||
|
||||
-- END renameGraph
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user