From dd43ebd9941ab18a79f1a2b7d87dbbcbb7e732ac Mon Sep 17 00:00:00 2001 From: Robbie Gleichman Date: Sat, 17 Dec 2016 17:13:36 -0800 Subject: [PATCH] Delete BranchIcon and BranchNode. --- app/Icons.hs | 3 +-- app/Translate.hs | 20 +++++++++++--------- app/TranslateCore.hs | 16 ---------------- app/Types.hs | 4 +--- test/UnitTests.hs | 1 - test/VisualGraphAlgorithmTests.hs | 5 ++++- test/VisualRenderingTests.hs | 4 ++-- test/VisualTranslateTests.hs | 2 -- todo.txt | 2 -- 9 files changed, 19 insertions(+), 38 deletions(-) diff --git a/app/Icons.hs b/app/Icons.hs index 10984b8..a73a267 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -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 diff --git a/app/Translate.hs b/app/Translate.hs index 68f0808..2e0354e 100644 --- a/app/Translate.hs +++ b/app/Translate.hs @@ -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) ++ " :: " diff --git a/app/TranslateCore.hs b/app/TranslateCore.hs index 59a5cbe..99082d8 100644 --- a/app/TranslateCore.hs +++ b/app/TranslateCore.hs @@ -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) diff --git a/app/Types.hs b/app/Types.hs index 5df0832..468893e 100644 --- a/app/Types.hs +++ b/app/Types.hs @@ -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) diff --git a/test/UnitTests.hs b/test/UnitTests.hs index 9c8eeb0..ac370df 100644 --- a/test/UnitTests.hs +++ b/test/UnitTests.hs @@ -314,7 +314,6 @@ enumTests = TestList [ patternTests :: Test patternTests = TestList [ - -- TODO Remove branch icon assertEqualSyntaxGraphs [ "y (F x) = x", "y = (\\(F x) -> x)" diff --git a/test/VisualGraphAlgorithmTests.hs b/test/VisualGraphAlgorithmTests.hs index a76e9f2..7478963 100644 --- a/test/VisualGraphAlgorithmTests.hs +++ b/test/VisualGraphAlgorithmTests.hs @@ -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 diff --git a/test/VisualRenderingTests.hs b/test/VisualRenderingTests.hs index 007d4d0..76c5a6c 100644 --- a/test/VisualRenderingTests.hs +++ b/test/VisualRenderingTests.hs @@ -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) ] diff --git a/test/VisualTranslateTests.hs b/test/VisualTranslateTests.hs index 0712c40..86479d7 100644 --- a/test/VisualTranslateTests.hs +++ b/test/VisualTranslateTests.hs @@ -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", diff --git a/todo.txt b/todo.txt index 53976b3..8dc8288 100644 --- a/todo.txt +++ b/todo.txt @@ -1,6 +1,4 @@ -- TODO Now -- --- Eliminate BranchIcon in Alts. --- Eliminate BranchIcon for the identity function "y x = x" Consider adding binding variable names to the lambda icon and match icon. Don't display the name if it is only one character.