mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-17 10:50:24 +03:00
Create a function resultPort for getting the result port number.
This commit is contained in:
parent
a71500b099
commit
7873645ef1
12
app/Icons.hs
12
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 --
|
||||
|
||||
|
||||
|
@ -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.
|
||||
|
Loading…
Reference in New Issue
Block a user