Change emEmbedded in Embedder from a list to a Set.

This commit is contained in:
Robbie Gleichman 2019-07-25 00:45:20 -07:00
parent 91b4a6545a
commit 164d837a10
4 changed files with 12 additions and 10 deletions

View File

@ -8,6 +8,7 @@ module GraphAlgorithms(
import qualified Data.Graph.Inductive as ING import qualified Data.Graph.Inductive as ING
import Data.List(foldl', find) import Data.List(foldl', find)
import qualified Data.Set as Set
import Data.Tuple(swap) import Data.Tuple(swap)
import GHC.Stack(HasCallStack) import GHC.Stack(HasCallStack)
@ -179,7 +180,7 @@ changeNodeLabel node newLabel graph = case ING.match node graph of
addChildToNodeLabel :: addChildToNodeLabel ::
(NodeName, Edge) -> EmbedderSyntaxNode -> EmbedderSyntaxNode (NodeName, Edge) -> EmbedderSyntaxNode -> EmbedderSyntaxNode
addChildToNodeLabel child (Embedder existingNodes oldSyntaxNode) addChildToNodeLabel child (Embedder existingNodes oldSyntaxNode)
= Embedder (child : existingNodes) oldSyntaxNode = Embedder (Set.insert child existingNodes) oldSyntaxNode
-- | Change the node label of the parent to be nested. -- | Change the node label of the parent to be nested.
embedChildSyntaxNode :: ING.DynGraph gr => embedChildSyntaxNode :: ING.DynGraph gr =>

View File

@ -34,6 +34,7 @@ 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 Data.Semigroup(Semigroup, (<>)) import Data.Semigroup(Semigroup, (<>))
import qualified Data.Set as Set
import Icons(inputPort, resultPort, argumentPorts, multiIfRhsPorts import Icons(inputPort, resultPort, argumentPorts, multiIfRhsPorts
, multiIfBoolPorts) , multiIfBoolPorts)
@ -303,12 +304,12 @@ findArg currentPort
| argName == toName = maybeBoolToBool $ fmap (== currentPort) fromPort | argName == toName = maybeBoolToBool $ fmap (== currentPort) fromPort
| otherwise = False -- This case should never happen | otherwise = False -- This case should never happen
makeArg :: [(NodeName, Edge)] -> Port -> Maybe NodeName makeArg :: Set.Set (NodeName, Edge) -> Port -> Maybe NodeName
makeArg args port = fst <$> find (findArg port) args makeArg args port = fst <$> find (findArg port) args
nestedApplySyntaxNodeToIcon :: LikeApplyFlavor nestedApplySyntaxNodeToIcon :: LikeApplyFlavor
-> Int -> Int
-> [(NodeName, Edge)] -> Set.Set (NodeName, Edge)
-> Icon -> Icon
nestedApplySyntaxNodeToIcon flavor numArgs args = nestedApplySyntaxNodeToIcon flavor numArgs args =
NestedApply flavor headIcon argList NestedApply flavor headIcon argList
@ -319,7 +320,7 @@ nestedApplySyntaxNodeToIcon flavor numArgs args =
argList = fmap (makeArg args) argPorts argList = fmap (makeArg args) argPorts
nestedLambdaToIcon :: [String] -- labels nestedLambdaToIcon :: [String] -- labels
-> [(NodeName, Edge)] -- embedded icons -> Set.Set (NodeName, Edge) -- embedded icons
-> [NodeName] -- body nodes -> [NodeName] -- body nodes
-> Icon -> Icon
nestedLambdaToIcon labels embeddedNodes = nestedLambdaToIcon labels embeddedNodes =
@ -331,7 +332,7 @@ nestedLambdaToIcon labels embeddedNodes =
nestedCaseOrMultiIfNodeToIcon :: nestedCaseOrMultiIfNodeToIcon ::
CaseOrMultiIfTag CaseOrMultiIfTag
-> Int -> Int
-> [(NodeName, Edge)] -> Set.Set (NodeName, Edge)
-> Icon -> Icon
nestedCaseOrMultiIfNodeToIcon tag numArgs args = case tag of nestedCaseOrMultiIfNodeToIcon tag numArgs args = case tag of
CaseTag -> NestedCaseIcon argList CaseTag -> NestedCaseIcon argList

View File

@ -38,9 +38,9 @@ import Diagrams.TwoD.Text(Text)
import Control.Applicative(Applicative(..)) import Control.Applicative(Applicative(..))
import qualified Data.Graph.Inductive as ING import qualified Data.Graph.Inductive as ING
import qualified Data.IntMap as IM import qualified Data.IntMap as IM
import Data.Set(Set, empty)
import Data.Typeable(Typeable) import Data.Typeable(Typeable)
newtype NodeName = NodeName Int deriving (Typeable, Eq, Ord, Show) newtype NodeName = NodeName Int deriving (Typeable, Eq, Ord, Show)
instance IsName NodeName instance IsName NodeName
@ -91,13 +91,13 @@ data CaseOrMultiIfTag = CaseTag | MultiIfTag deriving (Show, Eq, Ord)
-- TODO The full edge does not need to be included, just the port. -- TODO The full edge does not need to be included, just the port.
data Embedder a = Embedder { data Embedder a = Embedder {
emEmbedded :: [(NodeName, Edge)] -- ^ Set of embedded nodes emEmbedded :: Set (NodeName, Edge) -- ^ Set of embedded nodes
, emNode :: a , emNode :: a
} }
deriving (Show, Eq, Ord, Functor) deriving (Show, Eq, Ord, Functor)
mkEmbedder :: a -> Embedder a mkEmbedder :: a -> Embedder a
mkEmbedder = Embedder [] mkEmbedder = Embedder empty
type EmbedderSyntaxNode = Embedder SyntaxNode type EmbedderSyntaxNode = Embedder SyntaxNode

View File

@ -9,7 +9,7 @@ import Data.List(foldl', sort, sortOn)
import Translate(translateStringToSyntaxGraph) import Translate(translateStringToSyntaxGraph)
import TranslateCore(SyntaxGraph(..), SgBind(..)) import TranslateCore(SyntaxGraph(..), SgBind(..))
import Types(Embedder(..), Labeled(..), SgNamedNode, Edge(..), SyntaxNode(..), import Types(Embedder(..), Labeled(..), SgNamedNode, Edge(..), SyntaxNode(..),
NodeName(..), NameAndPort(..), Named(..)) NodeName(..), NameAndPort(..), Named(..), mkEmbedder)
import Util(fromMaybeError) import Util(fromMaybeError)
-- Unit Test Helpers -- -- Unit Test Helpers --
@ -30,7 +30,7 @@ type NameMap = [(NodeName, NodeName)]
renameNode renameNode
:: NameMap -> Int -> SgNamedNode -> (SgNamedNode, NameMap, Int) :: NameMap -> Int -> SgNamedNode -> (SgNamedNode, NameMap, Int)
renameNode nameMap counter (Named nodeName syntaxNode) renameNode nameMap counter (Named nodeName syntaxNode)
= (fmap (Embedder []) newNamedNode, nameMap3, newCounter) where = (fmap mkEmbedder newNamedNode, nameMap3, newCounter) where
newNodeName = NodeName counter newNodeName = NodeName counter
nameMap2 = (nodeName, newNodeName) : nameMap nameMap2 = (nodeName, newNodeName) : nameMap
(newSyntaxNode, nameMap3, newCounter) = renameSyntaxNode nameMap2 (emNode syntaxNode) (counter + 1) (newSyntaxNode, nameMap3, newCounter) = renameSyntaxNode nameMap2 (emNode syntaxNode) (counter + 1)