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 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
|
||||||
|
@ -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 = "
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user