mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-17 02:40:28 +03:00
Remove coerceExpressionResult from evalPatAndRhs. This removes branch icons from cases.
This commit is contained in:
parent
d61c9bf6e9
commit
04787c62ff
@ -364,22 +364,23 @@ evalLet :: EvalContext -> Binds -> Exp -> State IDState (SyntaxGraph, Reference)
|
||||
evalLet context binds e = evalGeneralLet (`evalExp` e) context binds
|
||||
|
||||
-- TODO: Refactor this with evalPatBind
|
||||
evalPatAndRhs :: EvalContext -> Pat -> Rhs -> Maybe Binds -> State IDState (Bool, SyntaxGraph, Reference, NameAndPort)
|
||||
evalPatAndRhs :: EvalContext -> Pat -> Rhs -> Maybe Binds -> State IDState (Bool, SyntaxGraph, Reference, Reference)
|
||||
evalPatAndRhs c pat rhs maybeWhereBinds = do
|
||||
patternNames <- namesInPattern <$> evalPattern pat
|
||||
let rhsContext = patternNames <> c
|
||||
-- TODO: remove coerceExpressionResult
|
||||
(rhsGraph, rhsRef) <- rhsWithBinds maybeWhereBinds rhs rhsContext >>= coerceExpressionResult
|
||||
(rhsGraph, rhsRef) <- rhsWithBinds maybeWhereBinds rhs rhsContext
|
||||
(patGraph, patRef) <- evalPattern pat
|
||||
let
|
||||
grWithEdges = makeEdges (rhsGraph <> patGraph)
|
||||
-- The pattern and rhs are conneted if makeEdges added extra edges.
|
||||
patRhsAreConnected =
|
||||
lookedUpRhsRef = lookupReference (sgSources grWithEdges) rhsRef
|
||||
-- The pattern and rhs are conneted if makeEdges added extra edges, or if the rhsRef refers to a source
|
||||
-- in the pattern
|
||||
patRhsAreConnected = (rhsRef /= lookedUpRhsRef) ||
|
||||
length (sgEdges grWithEdges) > (length (sgEdges rhsGraph) + length (sgEdges patGraph))
|
||||
pure (patRhsAreConnected, deleteBindings grWithEdges, patRef, rhsRef)
|
||||
pure (patRhsAreConnected, deleteBindings grWithEdges, patRef, lookedUpRhsRef)
|
||||
|
||||
-- returns (combined graph, pattern reference, rhs reference)
|
||||
evalAlt :: EvalContext -> Exts.Alt -> State IDState (Bool, SyntaxGraph, Reference, NameAndPort)
|
||||
evalAlt :: EvalContext -> Exts.Alt -> State IDState (Bool, SyntaxGraph, Reference, Reference)
|
||||
evalAlt c (Exts.Alt _ pat rhs maybeBinds) = evalPatAndRhs c pat rhs maybeBinds
|
||||
|
||||
evalCase :: EvalContext -> Exp -> [Alt] -> State IDState (SyntaxGraph, NameAndPort)
|
||||
@ -399,12 +400,15 @@ evalCase c e alts = do
|
||||
(connectedRhss, unConnectedRhss) = partition fst rhsEdges
|
||||
resultIconNames <- replicateM numAlts (getUniqueName "caseResult")
|
||||
let
|
||||
makeCaseResult resultIconName rhsPort = syntaxGraphFromNodesEdges rhsNewIcons rhsNewEdges
|
||||
where
|
||||
rhsNewIcons = [(resultIconName, CaseResultNode)]
|
||||
rhsNewEdges = [makeSimpleEdge (rhsPort, justName resultIconName)]
|
||||
makeCaseResult :: NodeName -> Reference -> SyntaxGraph
|
||||
makeCaseResult resultIconName rhsRef = case rhsRef of
|
||||
Left _ -> mempty
|
||||
Right rhsPort -> syntaxGraphFromNodesEdges rhsNewIcons rhsNewEdges
|
||||
where
|
||||
rhsNewIcons = [(resultIconName, CaseResultNode)]
|
||||
rhsNewEdges = [makeSimpleEdge (rhsPort, justName resultIconName)]
|
||||
caseResultGraphs = mconcat $ zipWith makeCaseResult resultIconNames (fmap (fst . snd) connectedRhss)
|
||||
filteredRhsEdges = mapFst Right $ fmap snd unConnectedRhss
|
||||
filteredRhsEdges = fmap snd unConnectedRhss
|
||||
patternEdgesGraph = edgesForRefPortList True patEdges
|
||||
caseEdgeGraph = edgesForRefPortList False (expEdge : filteredRhsEdges)
|
||||
finalGraph = mconcat [patternEdgesGraph, caseResultGraphs, expGraph, caseEdgeGraph, caseGraph, combindedAltGraph]
|
||||
|
@ -48,7 +48,6 @@ data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
|
||||
data LikeApplyFlavor = ApplyNodeFlavor | ComposeNodeFlavor deriving (Show, Eq, Ord)
|
||||
|
||||
-- TODO remove Ints from SyntaxNode data constructors.
|
||||
-- TODO Add NestedApplyNode, and NestedPatternApplyNode
|
||||
data SyntaxNode =
|
||||
LikeApplyNode LikeApplyFlavor Int -- Function application, composition, and applying to a composition
|
||||
| NestedApplyNode LikeApplyFlavor Int [(SgNamedNode, Edge)]
|
||||
|
@ -115,7 +115,8 @@ caseTests = [
|
||||
"y = case x of {Foo a -> f a; Bar a -> f a}",
|
||||
"y = case x of {F x -> x; G x -> x}",
|
||||
"y = case x of {F -> 0; G -> 1}",
|
||||
"z = case x of {0 -> 1; y -> y}"
|
||||
"z = case x of {0 -> 1; y -> y}",
|
||||
"y x = case f x of {0 -> x; Foo x -> x}"
|
||||
]
|
||||
|
||||
guardTests :: [String]
|
||||
|
Loading…
Reference in New Issue
Block a user