Simplify and rename SyntaxNodes.

This commit is contained in:
Robbie Gleichman 2019-02-25 01:48:17 -08:00
parent 21e0091743
commit 96be8aa835
7 changed files with 34 additions and 55 deletions

View File

@ -43,20 +43,20 @@ syntaxNodeIsEmbeddable :: ParentType
-> Bool -> Bool
syntaxNodeIsEmbeddable parentType n mParentPort _mChildPort syntaxNodeIsEmbeddable parentType n mParentPort _mChildPort
= case (parentType, n) of = case (parentType, n) of
(ApplyParent, LikeApplyNode _ _) -> parentPortNotResult (ApplyParent, ApplyNode _ _ _) -> parentPortNotResult
(ApplyParent, LiteralNode _) -> parentPortNotResult (ApplyParent, LiteralNode _) -> parentPortNotResult
-- TODO Embedded FunctionDefNodes are missing their enclosures. -- TODO Embedded FunctionDefNodes are missing their enclosures.
-- (ApplyParent, FunctionDefNode _ _) -- (ApplyParent, FunctionDefNode _ _)
-- -> isInput mParentPort && isResult mChildPort -- -> isInput mParentPort && isResult mChildPort
(CaseParent, LiteralNode _) -> parentPortNotResult (CaseParent, LiteralNode _) -> parentPortNotResult
(CaseParent, LikeApplyNode _ _) (CaseParent, ApplyNode _ _ _)
-> parentPortNotResult && parentPortNotInput -> parentPortNotResult && parentPortNotInput
(CaseParent, NestedPatternApplyNode _ _) (CaseParent, PatternApplyNode _ _)
-> parentPortNotResult && parentPortNotInput -> parentPortNotResult && parentPortNotInput
(MultiIfParent, LiteralNode _) -> parentPortNotResult (MultiIfParent, LiteralNode _) -> parentPortNotResult
(MultiIfParent, LikeApplyNode _ _) (MultiIfParent, ApplyNode _ _ _)
-> parentPortNotResult && parentPortNotInput -> parentPortNotResult && parentPortNotInput
_ -> False _ -> False
@ -75,12 +75,9 @@ syntaxNodeIsEmbeddable parentType n mParentPort _mChildPort
parentTypeForNode :: SyntaxNode -> ParentType parentTypeForNode :: SyntaxNode -> ParentType
parentTypeForNode n = case n of parentTypeForNode n = case n of
LikeApplyNode _ _ -> ApplyParent ApplyNode _ _ _ -> ApplyParent
NestedApplyNode _ _ _ -> ApplyParent CaseOrMultiIfNode CaseTag _ _ -> CaseParent
CaseNode _ -> CaseParent CaseOrMultiIfNode MultiIfTag _ _ -> MultiIfParent
MultiIfNode _ -> MultiIfParent
NestedCaseOrMultiIfNode CaseTag _ _ -> CaseParent
NestedCaseOrMultiIfNode MultiIfTag _ _ -> MultiIfParent
_ -> NotAParent _ -> NotAParent
lookupSyntaxNode :: ING.Graph gr => lookupSyntaxNode :: ING.Graph gr =>
@ -181,18 +178,12 @@ embedChildSyntaxNode parentNode childNode oldGraph = newGraph
SgNamedNode nodeName oldSyntaxNode = oldNodeLabel SgNamedNode nodeName oldSyntaxNode = oldNodeLabel
newNodeLabel = SgNamedNode nodeName newSyntaxNode newNodeLabel = SgNamedNode nodeName newSyntaxNode
newSyntaxNode = case oldSyntaxNode of newSyntaxNode = case oldSyntaxNode of
LikeApplyNode flavor x ApplyNode flavor x existingNodes
-> NestedApplyNode flavor x childrenAndEdgesToParent -> ApplyNode flavor x
NestedApplyNode flavor x existingNodes
-> NestedApplyNode flavor x
(childrenAndEdgesToParent <> existingNodes) (childrenAndEdgesToParent <> existingNodes)
CaseNode x CaseOrMultiIfNode tag x existingNodes
-> NestedCaseOrMultiIfNode CaseTag x childrenAndEdgesToParent -> CaseOrMultiIfNode tag x
NestedCaseOrMultiIfNode tag x existingNodes
-> NestedCaseOrMultiIfNode tag x
(childrenAndEdgesToParent <> existingNodes) (childrenAndEdgesToParent <> existingNodes)
MultiIfNode x
-> NestedCaseOrMultiIfNode MultiIfTag x childrenAndEdgesToParent
_ -> oldSyntaxNode _ -> oldSyntaxNode
changeEdgeToParent :: ING.Node -> ING.Node -> ING.LEdge b -> ING.LEdge b changeEdgeToParent :: ING.Node -> ING.Node -> ING.LEdge b -> ING.LEdge b

View File

@ -211,13 +211,10 @@ multiIfBoolPorts = caseRhsPorts
argumentPorts :: SyntaxNode -> [Port] argumentPorts :: SyntaxNode -> [Port]
argumentPorts n = case n of argumentPorts n = case n of
LikeApplyNode _ _-> defaultPorts ApplyNode _ _ _ -> defaultPorts
NestedApplyNode _ _ _ -> defaultPorts PatternApplyNode _ _-> defaultPorts
NestedPatternApplyNode _ _-> defaultPorts
FunctionDefNode _ _ -> defaultPorts FunctionDefNode _ _ -> defaultPorts
NestedCaseOrMultiIfNode _ _ _-> defaultPorts CaseOrMultiIfNode _ _ _-> defaultPorts
MultiIfNode _ -> defaultPorts
CaseNode _ -> defaultPorts
NameNode _ -> [] NameNode _ -> []
BindNameNode _ -> [] BindNameNode _ -> []
LiteralNode _ -> [] LiteralNode _ -> []

View File

@ -33,8 +33,8 @@ import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef(..)
, getUniqueString, bindsToSyntaxGraph, SgBind(..) , getUniqueString, bindsToSyntaxGraph, SgBind(..)
, graphAndRefToGraph, initialIdState) , graphAndRefToGraph, initialIdState)
import Types(AnnotatedGraph, Labeled(..), NameAndPort(..), IDState, import Types(AnnotatedGraph, Labeled(..), NameAndPort(..), IDState,
Edge, SyntaxNode(..), NodeName, SgNamedNode(..), Edge, SyntaxNode(..), NodeName, SgNamedNode(..),
LikeApplyFlavor(..)) LikeApplyFlavor(..), CaseOrMultiIfTag(..))
import Util(makeSimpleEdge, nameAndPort, justName) import Util(makeSimpleEdge, nameAndPort, justName)
{-# ANN module "HLint: ignore Use record patterns" #-} {-# ANN module "HLint: ignore Use record patterns" #-}
@ -147,7 +147,7 @@ makeNestedPatternGraph ::
-> (SyntaxGraph, NameAndPort) -> (SyntaxGraph, NameAndPort)
makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
where where
dummyNode = NestedPatternApplyNode "" [] dummyNode = PatternApplyNode "" []
argsAndPorts argsAndPorts
= zip argVals $ map (nameAndPort applyIconName) $ argumentPorts dummyNode = zip argVals $ map (nameAndPort applyIconName) $ argumentPorts dummyNode
@ -167,7 +167,7 @@ makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
combinedGraph = combineExpressions True unnestedArgsAndPort combinedGraph = combineExpressions True unnestedArgsAndPort
pAppNode = NestedPatternApplyNode funStr argList pAppNode = PatternApplyNode funStr argList
icons = [SgNamedNode applyIconName pAppNode] icons = [SgNamedNode applyIconName pAppNode]
asNameBinds = catMaybes $ fmap asNameBind argVals asNameBinds = catMaybes $ fmap asNameBind argVals
@ -452,7 +452,7 @@ evalCaseHelper numAlts caseIconName resultIconNames
where where
(patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts (patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts
combindedAltGraph = mconcat altGraphs combindedAltGraph = mconcat altGraphs
caseNode = CaseNode numAlts caseNode = CaseOrMultiIfNode CaseTag numAlts []
icons = [SgNamedNode caseIconName caseNode] icons = [SgNamedNode caseIconName caseNode]
caseGraph = syntaxGraphFromNodes icons caseGraph = syntaxGraphFromNodes icons
expEdge = (expRef, nameAndPort caseIconName (inputPort caseNode)) expEdge = (expRef, nameAndPort caseIconName (inputPort caseNode))
@ -646,7 +646,7 @@ translateStringToSyntaxGraph = translateDeclToSyntaxGraph . stringToSimpDecl
syntaxGraphToCollapsedGraph :: SyntaxGraph -> AnnotatedGraph FGR.Gr syntaxGraphToCollapsedGraph :: SyntaxGraph -> AnnotatedGraph FGR.Gr
syntaxGraphToCollapsedGraph syntaxGraphToCollapsedGraph
= collapseAnnotatedGraph . annotateGraph . syntaxGraphToFglGraph = collapseAnnotatedGraph . annotateGraph . syntaxGraphToFglGraph
-- = annotateGraph . syntaxGraphToFglGraph -- = annotateGraph . syntaxGraphToFglGraph
translateDeclToCollapsedGraph :: Show l => Exts.Decl l -> AnnotatedGraph FGR.Gr translateDeclToCollapsedGraph :: Show l => Exts.Decl l -> AnnotatedGraph FGR.Gr
translateDeclToCollapsedGraph translateDeclToCollapsedGraph

View File

@ -182,7 +182,7 @@ makeApplyGraph numArgs applyFlavor inPattern applyIconName funVal argVals
, nameAndPort applyIconName (resultPort applyNode) , nameAndPort applyIconName (resultPort applyNode)
) )
where where
applyNode = LikeApplyNode applyFlavor numArgs applyNode = ApplyNode applyFlavor numArgs []
argumentNamePorts argumentNamePorts
= map (nameAndPort applyIconName) (argumentPorts applyNode) = map (nameAndPort applyIconName) (argumentPorts applyNode)
functionPort = nameAndPort applyIconName (inputPort applyNode) functionPort = nameAndPort applyIconName (inputPort applyNode)
@ -200,7 +200,7 @@ makeMultiIfGraph ::
makeMultiIfGraph numPairs multiIfName bools exps makeMultiIfGraph numPairs multiIfName bools exps
= (newGraph, nameAndPort multiIfName (resultPort multiIfNode)) = (newGraph, nameAndPort multiIfName (resultPort multiIfNode))
where where
multiIfNode = MultiIfNode numPairs multiIfNode = CaseOrMultiIfNode MultiIfTag numPairs []
expsWithPorts = zip exps $ map (nameAndPort multiIfName) multiIfRhsPorts expsWithPorts = zip exps $ map (nameAndPort multiIfName) multiIfRhsPorts
boolsWithPorts = zip bools $ map (nameAndPort multiIfName) multiIfBoolPorts boolsWithPorts = zip bools $ map (nameAndPort multiIfName) multiIfBoolPorts
combindedGraph = combineExpressions False $ expsWithPorts <> boolsWithPorts combindedGraph = combineExpressions False $ expsWithPorts <> boolsWithPorts
@ -278,20 +278,16 @@ nListString 1 = "[_]"
nListString n = '[' : replicate (n -1) ',' ++ "]" nListString n = '[' : replicate (n -1) ',' ++ "]"
nodeToIcon :: SyntaxNode -> Icon nodeToIcon :: SyntaxNode -> Icon
nodeToIcon (LikeApplyNode flavor n) nodeToIcon (ApplyNode flavor x edges)
= NestedApply flavor Nothing (replicate n Nothing)
nodeToIcon (NestedApplyNode flavor x edges)
= nestedApplySyntaxNodeToIcon flavor x edges = nestedApplySyntaxNodeToIcon flavor x edges
nodeToIcon (NestedPatternApplyNode s children) nodeToIcon (PatternApplyNode s children)
= nestedPatternNodeToIcon s children = nestedPatternNodeToIcon s children
nodeToIcon (NameNode s) = TextBoxIcon s nodeToIcon (NameNode s) = TextBoxIcon s
nodeToIcon (BindNameNode s) = BindTextBoxIcon s nodeToIcon (BindNameNode s) = BindTextBoxIcon s
nodeToIcon (LiteralNode s) = TextBoxIcon s nodeToIcon (LiteralNode s) = TextBoxIcon s
nodeToIcon (FunctionDefNode x names) = FlatLambdaIcon x names nodeToIcon (FunctionDefNode x names) = FlatLambdaIcon x names
nodeToIcon (MultiIfNode n) = MultiIfIcon n
nodeToIcon (CaseNode n) = CaseIcon n
nodeToIcon CaseResultNode = CaseResultIcon nodeToIcon CaseResultNode = CaseResultIcon
nodeToIcon (NestedCaseOrMultiIfNode tag x edges) nodeToIcon (CaseOrMultiIfNode tag x edges)
= nestedCaseOrMultiIfNodeToIcon tag x edges = nestedCaseOrMultiIfNodeToIcon tag x edges
makeArg :: [(SgNamedNode, Edge)] -> Port -> Maybe NamedIcon makeArg :: [(SgNamedNode, Edge)] -> Port -> Maybe NamedIcon
@ -307,7 +303,7 @@ nestedApplySyntaxNodeToIcon :: LikeApplyFlavor
nestedApplySyntaxNodeToIcon flavor numArgs args = nestedApplySyntaxNodeToIcon flavor numArgs args =
NestedApply flavor headIcon argList NestedApply flavor headIcon argList
where where
dummyNode = LikeApplyNode flavor numArgs dummyNode = ApplyNode flavor numArgs []
argPorts = take numArgs (argumentPorts dummyNode) argPorts = take numArgs (argumentPorts dummyNode)
headIcon = makeArg args (inputPort dummyNode) headIcon = makeArg args (inputPort dummyNode)
argList = fmap (makeArg args) argPorts argList = fmap (makeArg args) argPorts
@ -321,7 +317,7 @@ nestedCaseOrMultiIfNodeToIcon tag numArgs args = case tag of
CaseTag -> NestedCaseIcon argList CaseTag -> NestedCaseIcon argList
MultiIfTag -> NestedMultiIfIcon argList MultiIfTag -> NestedMultiIfIcon argList
where where
dummyNode = CaseNode numArgs dummyNode = CaseOrMultiIfNode CaseTag numArgs []
argPorts = take (2 * numArgs) $ argumentPorts dummyNode argPorts = take (2 * numArgs) $ argumentPorts dummyNode
argList = fmap (makeArg args) (inputPort dummyNode : argPorts) argList = fmap (makeArg args) (inputPort dummyNode : argPorts)

View File

@ -84,23 +84,18 @@ data SgNamedNode = SgNamedNode {
-- TODO remove Ints from SyntaxNode data constructors. -- TODO remove Ints from SyntaxNode data constructors.
data SyntaxNode = data SyntaxNode =
-- Function application, composition, and applying to a composition -- Function application, composition, and applying to a composition
LikeApplyNode LikeApplyFlavor Int
-- NestedApplyNode is only created in GraphAlgorithms, not during translation.
-- The list of nodes is unordered (replace with a map?) -- The list of nodes is unordered (replace with a map?)
| NestedApplyNode LikeApplyFlavor Int [(SgNamedNode, Edge)] ApplyNode LikeApplyFlavor Int [(SgNamedNode, Edge)]
| NestedPatternApplyNode String [Labeled (Maybe SgNamedNode)] | PatternApplyNode String [Labeled (Maybe SgNamedNode)]
| NameNode String -- Identifiers or symbols | NameNode String -- Identifiers or symbols
| BindNameNode String | BindNameNode String
| LiteralNode String -- Literal values like the string "Hello World" | LiteralNode String -- Literal values like the string "Hello World"
| FunctionDefNode -- Function definition (ie. lambda expression) | FunctionDefNode -- Function definition (ie. lambda expression)
[String] -- Parameter labels [String] -- Parameter labels
[NodeName] -- Nodes inside the lambda [NodeName] -- Nodes inside the lambda
| MultiIfNode
Int -- Number of alternatives
| CaseNode Int
| CaseResultNode -- TODO remove caseResultNode | CaseResultNode -- TODO remove caseResultNode
| NestedCaseOrMultiIfNode CaseOrMultiIfTag Int [(SgNamedNode, Edge)] | CaseOrMultiIfNode CaseOrMultiIfTag Int [(SgNamedNode, Edge)]
deriving (Show, Eq, Ord) deriving (Show, Eq, Ord)
newtype Port = Port Int deriving (Typeable, Eq, Ord, Show) newtype Port = Port Int deriving (Typeable, Eq, Ord, Show)

View File

@ -47,8 +47,8 @@ maybeRenameNodeFolder (renamedNodes, nameMap, counter) mNode = case mNode of
renameSyntaxNode :: NameMap -> SyntaxNode -> Int -> (SyntaxNode, NameMap, Int) renameSyntaxNode :: NameMap -> SyntaxNode -> Int -> (SyntaxNode, NameMap, Int)
renameSyntaxNode nameMap node counter = case node of renameSyntaxNode nameMap node counter = case node of
-- TODO Keep the Nothing subNodes -- TODO Keep the Nothing subNodes
NestedPatternApplyNode s subNodes PatternApplyNode s subNodes
-> (NestedPatternApplyNode s (reverse renamedSubNodes) -> (PatternApplyNode s (reverse renamedSubNodes)
, newNameMap , newNameMap
, counter2) , counter2)
where where

View File

@ -23,7 +23,7 @@ import Icons(coloredTextBox)
{-# ANN module "HLint: ignore Unnecessary hiding" #-} {-# ANN module "HLint: ignore Unnecessary hiding" #-}
prettyPrintSyntaxNode :: SyntaxNode -> String prettyPrintSyntaxNode :: SyntaxNode -> String
prettyPrintSyntaxNode (NestedApplyNode _ _ namedNodesAndEdges) prettyPrintSyntaxNode (ApplyNode _ _ namedNodesAndEdges)
= concatMap printNameAndEdge namedNodesAndEdges = concatMap printNameAndEdge namedNodesAndEdges
where where
printNameAndEdge (namedNode, edge) printNameAndEdge (namedNode, edge)