From 7873645ef13be10128e353f310a5ac770905afbc Mon Sep 17 00:00:00 2001 From: Robbie Gleichman Date: Tue, 27 Dec 2016 21:02:11 -0800 Subject: [PATCH] Create a function resultPort for getting the result port number. --- app/Icons.hs | 12 +++++++++++- app/Translate.hs | 34 +++++++++++++++++++++------------- 2 files changed, 32 insertions(+), 14 deletions(-) diff --git a/app/Icons.hs b/app/Icons.hs index 88cee2e..07eaca3 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -5,6 +5,7 @@ module Icons TransformableDia, getPortAngles, iconToDiagram, + resultPort, textBox, multilineComment, defaultLineWidth, @@ -20,7 +21,8 @@ import Data.Maybe(catMaybes, listToMaybe, isJust, fromJust) import Data.Either(partitionEithers) import qualified Control.Arrow as Arrow -import Types(Icon(..), SpecialQDiagram, SpecialBackend, SpecialNum, NodeName, Port(..), LikeApplyFlavor(..)) +import Types(Icon(..), SpecialQDiagram, SpecialBackend, SpecialNum, NodeName, Port(..), LikeApplyFlavor(..), + SyntaxNode) import DrawingColors(colorScheme, ColorStyle(..)) -- TYPES -- @@ -147,6 +149,14 @@ getPortAngles icon port maybeNodeName = case icon of -- END getPortAngles -- +-- BEGIN Port numbers + +-- TODO It's a bit strange that the parameter is a SyntaxNode, not an Icon. +resultPort :: SyntaxNode -> Port +resultPort = const (Port 1) + +-- END Port numbers + -- END Exported icon functions -- diff --git a/app/Translate.hs b/app/Translate.hs index 7717f77..05738fb 100644 --- a/app/Translate.hs +++ b/app/Translate.hs @@ -31,6 +31,7 @@ import Types(NameAndPort(..), IDState, Edge, SyntaxNode(..), IngSyntaxGraph, NodeName, Port(..), SgNamedNode(..), LikeApplyFlavor(..)) import Util(makeSimpleEdge, nameAndPort, justName) +import Icons(resultPort) -- OVERVIEW -- -- The core functions and data types used in this module are in TranslateCore. @@ -141,7 +142,8 @@ makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult argList = fmap argListMapper mappedArgs combinedGraph = combineExpressions True unnestedArgsAndPort - icons = [SgNamedNode applyIconName (NestedPatternApplyNode funStr argList)] + pAppNode = NestedPatternApplyNode funStr argList + icons = [SgNamedNode applyIconName pAppNode] asNameBinds = catMaybes $ fmap asNameBind argVals allBinds = nestedBinds <> asNameBinds @@ -149,14 +151,16 @@ makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult newEMap = ((\(SgNamedNode n _) -> (n, applyIconName)) <$> nestedArgs) <> nestedEMaps newGraph = SyntaxGraph icons [] nestedSinks allBinds newEMap - nestedApplyResult = (newGraph <> combinedGraph, nameAndPort applyIconName (Port 1)) + nestedApplyResult = (newGraph <> combinedGraph, nameAndPort applyIconName (resultPort pAppNode)) -makePatternGraph' :: NodeName -> String -> [GraphAndRef] -> Int -> (SyntaxGraph, NameAndPort) -makePatternGraph' applyIconName funStr argVals numArgs = (newGraph <> combinedGraph, nameAndPort applyIconName (Port 1)) +makePatternGraph' :: NodeName -> String -> [GraphAndRef] -> (SyntaxGraph, NameAndPort) +makePatternGraph' applyIconName funStr argVals = (newGraph <> combinedGraph, nameAndPort applyIconName (resultPort pAppNode)) where argumentPorts = map (nameAndPort applyIconName . Port) [2,3..] combinedGraph = combineExpressions True $ zip argVals argumentPorts - icons = [SgNamedNode applyIconName (PatternApplyNode funStr numArgs)] + numArgs = length argVals + pAppNode = PatternApplyNode funStr numArgs + icons = [SgNamedNode applyIconName pAppNode] newGraph = syntaxGraphFromNodes icons evalPApp :: QName -> [Pat] -> State IDState (SyntaxGraph, NameAndPort) @@ -372,11 +376,12 @@ evalIf c e1 e2 e3 = do e3Val <- evalExp c e3 guardName <- getUniqueName let - icons = [SgNamedNode guardName (GuardNode 2)] + guardNode = GuardNode 2 + icons = [SgNamedNode guardName guardNode] combinedGraph = combineExpressions False $ zip [e1Val, e2Val, e3Val] (map (nameAndPort guardName . Port) [3, 2, 4]) newGraph = syntaxGraphFromNodes icons <> combinedGraph - pure (newGraph, nameAndPort guardName (Port 1)) + pure (newGraph, nameAndPort guardName (resultPort guardNode)) -- BEGIN evalGeneralLet @@ -435,9 +440,10 @@ evalGuardedRhss c rhss = do expsWithPorts = zip exps $ map (nameAndPort guardName . Port) [2,4..] boolsWithPorts = zip bools $ map (nameAndPort guardName . Port) [3,5..] combindedGraph = combineExpressions False $ expsWithPorts <> boolsWithPorts - icons = [SgNamedNode guardName $ GuardNode (length rhss)] + guardNode = GuardNode (length rhss) + icons = [SgNamedNode guardName guardNode] newGraph = syntaxGraphFromNodes icons <> combindedGraph - pure (newGraph, nameAndPort guardName (Port 1)) + pure (newGraph, nameAndPort guardName (resultPort guardNode)) -- | First argument is the right hand side. -- The second arugement is a list of strings that are bound in the environment. @@ -483,7 +489,8 @@ evalCase c e alts = do (patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts combindedAltGraph = mconcat altGraphs numAlts = length alts - icons = [SgNamedNode caseIconName (CaseNode numAlts)] + caseNode = (CaseNode numAlts) + icons = [SgNamedNode caseIconName caseNode] caseGraph = syntaxGraphFromNodes icons expEdge = (expRef, nameAndPort caseIconName (Port 0)) patEdges = zip patRefs $ map (nameAndPort caseIconName . Port) [2,4..] @@ -506,7 +513,7 @@ evalCase c e alts = do bindGraph = makeAsBindGraph expRef asNames finalGraph = deleteBindings $ makeEdges $ mconcat [bindGraph, patternEdgesGraph, caseResultGraphs, expGraph, caseEdgeGraph, caseGraph, combindedAltGraph] - pure (finalGraph, nameAndPort caseIconName (Port 1)) + pure (finalGraph, nameAndPort caseIconName (resultPort caseNode)) -- END evalCase @@ -571,7 +578,8 @@ generalEvalLambda context patterns rhsEvalFun = do GraphAndRef rhsRawGraph rhsRef <- rhsEvalFun rhsContext let - icons = [SgNamedNode lambdaName $ FunctionDefNode (length patterns)] + lambdaNode = FunctionDefNode (length patterns) + icons = [SgNamedNode lambdaName lambdaNode] returnPort = nameAndPort lambdaName (Port 0) (newEdges, newSinks) = case rhsRef of Left s -> (patternEdges, [SgSink s returnPort]) @@ -580,7 +588,7 @@ generalEvalLambda context patterns rhsEvalFun = do asBindGraph = mconcat $ zipWith asBindGraphZipper (fmap snd patternValsWithAsNames) lambdaPorts - pure (deleteBindings . makeEdges $ (asBindGraph <> rhsRawGraph <> patternGraph <> finalGraph), nameAndPort lambdaName (Port 1)) + pure (deleteBindings . makeEdges $ (asBindGraph <> rhsRawGraph <> patternGraph <> finalGraph), nameAndPort lambdaName (resultPort lambdaNode)) where -- TODO Like evalPatBind, this edge should have an indicator that it is the input to a pattern. -- makePatternEdges creates the edges between the patterns and the parameter ports.