mirror of
https://github.com/rgleichman/glance.git
synced 2024-11-26 09:07:01 +03:00
Simplify and rename SyntaxNodes.
This commit is contained in:
parent
21e0091743
commit
96be8aa835
@ -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
|
||||||
|
@ -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 _ -> []
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
|
||||||
|
13
app/Types.hs
13
app/Types.hs
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user