mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-17 10:50:24 +03:00
Delete BranchIcon and BranchNode.
This commit is contained in:
parent
04787c62ff
commit
dd43ebd994
@ -46,7 +46,6 @@ iconToDiagram (ApplyAIcon n) = identDiaFunc $ applyADia n
|
||||
iconToDiagram (ComposeIcon n) = identDiaFunc $ composeDia n
|
||||
iconToDiagram (PAppIcon n str) = pAppDia n str
|
||||
iconToDiagram ResultIcon = identDiaFunc resultIcon
|
||||
iconToDiagram BranchIcon = identDiaFunc branchIcon
|
||||
iconToDiagram (TextBoxIcon s) = textBox s
|
||||
iconToDiagram (BindTextBoxIcon s) = identDiaFunc $ bindTextBox s
|
||||
iconToDiagram (GuardIcon n) = identDiaFunc $ guardIcon n
|
||||
@ -100,7 +99,6 @@ getPortAngles icon port maybeNodeName = case icon of
|
||||
ComposeIcon _ -> applyPortAngles port
|
||||
PAppIcon _ _ -> applyPortAngles port
|
||||
ResultIcon -> []
|
||||
BranchIcon -> []
|
||||
TextBoxIcon _ -> []
|
||||
BindTextBoxIcon _ -> []
|
||||
GuardIcon _ -> guardPortAngles port
|
||||
@ -315,6 +313,7 @@ resultIcon :: SpecialBackend b n => SpecialQDiagram b n
|
||||
resultIcon = lw none $ fc (lamArgResC colorScheme) unitSquare
|
||||
|
||||
-- BRANCH ICON --
|
||||
-- Currently not used
|
||||
branchIcon :: SpecialBackend b n => SpecialQDiagram b n
|
||||
branchIcon = lw none $ lc lineCol $ fc lineCol $ circle circleRadius
|
||||
|
||||
|
@ -24,12 +24,12 @@ import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef, Sink,
|
||||
syntaxGraphFromNodes, syntaxGraphFromNodesEdges, getUniqueName, combineExpressions,
|
||||
edgesForRefPortList, makeApplyGraph,
|
||||
namesInPattern, lookupReference, deleteBindings, makeEdges,
|
||||
coerceExpressionResult, makeBox, nTupleString, nListString,
|
||||
makeBox, nTupleString, nListString,
|
||||
syntaxGraphToFglGraph, getUniqueString)
|
||||
import Types(NameAndPort(..), IDState,
|
||||
initialIdState, Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..), SgNamedNode,
|
||||
LikeApplyFlavor(..))
|
||||
import Util(makeSimpleEdge, nameAndPort, justName, mapFst)
|
||||
import Util(makeSimpleEdge, nameAndPort, justName)
|
||||
|
||||
-- OVERVIEW --
|
||||
-- The core functions and data types used in this module are in TranslateCore.
|
||||
@ -523,14 +523,15 @@ generalEvalLambda context patterns rhsEvalFun = do
|
||||
|
||||
(patternEdges, newBinds) =
|
||||
partitionEithers $ zipWith makePatternEdges patternVals lambdaPorts
|
||||
numParameters = length patterns
|
||||
-- TODO remove coerceExpressionResult here
|
||||
(rhsRawGraph, rhsResult) <- rhsEvalFun rhsContext >>= coerceExpressionResult
|
||||
|
||||
(rhsRawGraph, rhsRef) <- rhsEvalFun rhsContext
|
||||
let
|
||||
icons = [(lambdaName, FunctionDefNode numParameters)]
|
||||
resultIconEdge = makeSimpleEdge (rhsResult, nameAndPort lambdaName (Port 0))
|
||||
finalGraph = SyntaxGraph icons (resultIconEdge:patternEdges)
|
||||
mempty newBinds mempty
|
||||
icons = [(lambdaName, FunctionDefNode (length patterns))]
|
||||
returnPort = nameAndPort lambdaName (Port 0)
|
||||
(newEdges, newSinks) = case rhsRef of
|
||||
Left s -> (patternEdges, [(s, returnPort)])
|
||||
Right rhsPort -> (makeSimpleEdge (rhsPort, returnPort) : patternEdges, mempty)
|
||||
finalGraph = SyntaxGraph icons newEdges newSinks newBinds mempty
|
||||
pure (deleteBindings . makeEdges $ (rhsRawGraph <> patternGraph <> finalGraph), nameAndPort lambdaName (Port 1))
|
||||
where
|
||||
-- TODO Like evalPatBind, this edge should have an indicator that it is the input to a pattern.
|
||||
@ -587,6 +588,7 @@ evalMatches c (firstMatch:restOfMatches) = matchesToCase firstMatch restOfMatche
|
||||
|
||||
-- Pretty printing the entire type sig results in extra whitespace in the middle
|
||||
-- TODO May want to trim whitespace from (prettyPrint typeForNames)
|
||||
evalTypeSig :: Decl -> State IDState (SyntaxGraph, NameAndPort)
|
||||
evalTypeSig (TypeSig _ names typeForNames) = makeBox
|
||||
(intercalate "," (fmap prettyPrint names)
|
||||
++ " :: "
|
||||
|
@ -17,7 +17,6 @@ module TranslateCore(
|
||||
deleteBindings,
|
||||
makeEdges,
|
||||
--makeEdgesCore,
|
||||
coerceExpressionResult,
|
||||
makeBox,
|
||||
nTupleString,
|
||||
nListString,
|
||||
@ -149,20 +148,6 @@ makeEdges (SyntaxGraph icons edges sinks bindings eMap) = newGraph where
|
||||
(newSinks, newEdges) = makeEdgesCore sinks bindings
|
||||
newGraph = SyntaxGraph icons (newEdges <> edges) newSinks bindings eMap
|
||||
|
||||
-- TODO: Remove BranchNode
|
||||
-- | This is used by the rhs for identity (eg. y x = x)
|
||||
coerceExpressionResult :: (SyntaxGraph, Reference) -> State IDState (SyntaxGraph, NameAndPort)
|
||||
coerceExpressionResult (_, Left str) = makeDummyRhs str where
|
||||
makeDummyRhs :: String -> State IDState (SyntaxGraph, NameAndPort)
|
||||
makeDummyRhs s = do
|
||||
iconName <- getUniqueName s
|
||||
let
|
||||
graph = SyntaxGraph icons mempty [(s, port)] mempty mempty
|
||||
icons = [(iconName, BranchNode)]
|
||||
port = justName iconName
|
||||
pure (graph, port)
|
||||
coerceExpressionResult (g, Right x) = pure (g, x)
|
||||
|
||||
-- TODO: remove / change due toSyntaxGraph
|
||||
makeBox :: String -> State IDState (SyntaxGraph, NameAndPort)
|
||||
makeBox str = do
|
||||
@ -191,7 +176,6 @@ nodeToIcon (LiteralNode s) = TextBoxIcon s
|
||||
nodeToIcon (FunctionDefNode n) = FlatLambdaIcon n
|
||||
nodeToIcon (GuardNode n) = GuardIcon n
|
||||
nodeToIcon (CaseNode n) = CaseIcon n
|
||||
nodeToIcon BranchNode = BranchIcon
|
||||
nodeToIcon CaseResultNode = CaseResultIcon
|
||||
|
||||
makeArg :: [(SgNamedNode, Edge)] -> Int -> Maybe (NodeName, Icon)
|
||||
|
@ -32,11 +32,10 @@ import Data.Typeable(Typeable)
|
||||
|
||||
-- TYPES --
|
||||
-- | A datatype that represents an icon.
|
||||
-- The BranchIcon is used as a branching point for a line.
|
||||
-- The TextBoxIcon's data is the text that appears in the text box.
|
||||
-- The LambdaRegionIcon's data is the number of lambda ports, and the name of it's
|
||||
-- subdrawing.
|
||||
data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
|
||||
data Icon = ResultIcon | TextBoxIcon String | GuardIcon Int
|
||||
| FlatLambdaIcon Int | ApplyAIcon Int | ComposeIcon Int
|
||||
| PAppIcon Int String | CaseIcon Int | CaseResultIcon
|
||||
| BindTextBoxIcon String
|
||||
@ -60,7 +59,6 @@ data SyntaxNode =
|
||||
| FunctionDefNode Int-- Function definition (ie. lambda expression)
|
||||
| GuardNode Int
|
||||
| CaseNode Int
|
||||
| BranchNode -- TODO remove BranchNode
|
||||
| CaseResultNode -- TODO remove caseResultNode
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
|
@ -314,7 +314,6 @@ enumTests = TestList [
|
||||
|
||||
patternTests :: Test
|
||||
patternTests = TestList [
|
||||
-- TODO Remove branch icon
|
||||
assertEqualSyntaxGraphs [
|
||||
"y (F x) = x",
|
||||
"y = (\\(F x) -> x)"
|
||||
|
@ -32,7 +32,10 @@ renderFglGraph fglGraph = do
|
||||
pure $ DiaGV.drawGraph
|
||||
nodeFunc
|
||||
--(\_ _ _ _ _ p -> lc white $ stroke p)
|
||||
(\_ point1 _ point2 _ _ -> lcA (withOpacity white 0.5) $ arrowBetween (scaleFactor *^ point1) (scaleFactor *^ point2))
|
||||
-- TODO Draw some type of arrow if point1 == point2
|
||||
(\_ point1 _ point2 _ _ -> if point1 == point2
|
||||
then mempty
|
||||
else lcA (withOpacity white 0.5) $ arrowBetween (scaleFactor *^ point1) (scaleFactor *^ point2))
|
||||
layedOutGraph
|
||||
where
|
||||
scaleFactor = 0.12
|
||||
|
@ -56,7 +56,7 @@ fact0Drawing = Drawing fact0Icons fact0Edges where
|
||||
(fTimes, TextBoxIcon "*"),
|
||||
(fRecurAp, ApplyAIcon 1),
|
||||
(fTimesAp, ApplyAIcon 2),
|
||||
(fArg, BranchIcon),
|
||||
-- (fArg, BranchIcon),
|
||||
(fRes, ResultIcon)
|
||||
]
|
||||
fact0Edges = [
|
||||
@ -85,7 +85,7 @@ fact1Icons =
|
||||
(fTimes, TextBoxIcon "*"),
|
||||
(fRecurAp, ApplyAIcon 1),
|
||||
(fTimesAp, ApplyAIcon 2),
|
||||
(fArg, BranchIcon),
|
||||
-- (fArg, BranchIcon),
|
||||
(fRes, ResultIcon)
|
||||
]
|
||||
|
||||
|
@ -110,7 +110,6 @@ caseTests :: [String]
|
||||
caseTests = [
|
||||
"y = case x of {0 -> 1; 2 -> 3}",
|
||||
"y = case f x of {0 -> 1; 2 -> 3}",
|
||||
-- TODO Remove the branch icon
|
||||
"y = case x of {Foo a -> a}",
|
||||
"y = case x of {Foo a -> f a; Bar a -> f a}",
|
||||
"y = case x of {F x -> x; G x -> x}",
|
||||
@ -132,7 +131,6 @@ patternTests :: [String]
|
||||
patternTests = [
|
||||
"Foo _ x = 3",
|
||||
|
||||
-- TODO Remove branch icon
|
||||
"y (F x) = x",
|
||||
|
||||
"y = let {g = 3; F x y = h g} in x y",
|
||||
|
Loading…
Reference in New Issue
Block a user