mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Remove parameter from getUniqueName.
This commit is contained in:
parent
f2f54d9c3b
commit
959be858a7
@ -152,7 +152,7 @@ evalPApp :: QName -> [Pat] -> State IDState (SyntaxGraph, NameAndPort)
|
|||||||
evalPApp name patterns = case patterns of
|
evalPApp name patterns = case patterns of
|
||||||
[] -> makeBox constructorName
|
[] -> makeBox constructorName
|
||||||
_ -> do
|
_ -> do
|
||||||
patName <- getUniqueName "pat"
|
patName <- getUniqueName
|
||||||
evaledPatterns <- mapM evalPattern patterns
|
evaledPatterns <- mapM evalPattern patterns
|
||||||
pure $ makePatternGraph patName constructorName evaledPatterns (length evaledPatterns)
|
pure $ makePatternGraph patName constructorName evaledPatterns (length evaledPatterns)
|
||||||
where
|
where
|
||||||
@ -256,7 +256,7 @@ evalApp :: EvalContext -> LikeApplyFlavor -> (Exp, [Exp]) -> State IDState (Synt
|
|||||||
evalApp c flavor (funExp, argExps) = do
|
evalApp c flavor (funExp, argExps) = do
|
||||||
funVal <- evalExp c funExp
|
funVal <- evalExp c funExp
|
||||||
argVals <- mapM (evalExp c) argExps
|
argVals <- mapM (evalExp c) argExps
|
||||||
applyIconName <- getUniqueName "app0"
|
applyIconName <- getUniqueName
|
||||||
pure $ makeApplyGraph flavor False applyIconName funVal argVals (length argExps)
|
pure $ makeApplyGraph flavor False applyIconName funVal argVals (length argExps)
|
||||||
|
|
||||||
-- END apply and compose helper functions
|
-- END apply and compose helper functions
|
||||||
@ -268,7 +268,7 @@ evalPureCompose c functions = do
|
|||||||
let reversedFunctios = reverse functions
|
let reversedFunctios = reverse functions
|
||||||
evaluatedFunctions <- mapM (evalExp c) reversedFunctios
|
evaluatedFunctions <- mapM (evalExp c) reversedFunctios
|
||||||
neverUsedPort <- Left <$> getUniqueString "unusedArgument"
|
neverUsedPort <- Left <$> getUniqueString "unusedArgument"
|
||||||
applyIconName <- getUniqueName "compose"
|
applyIconName <- getUniqueName
|
||||||
pure $ makeApplyGraph ComposeNodeFlavor False applyIconName
|
pure $ makeApplyGraph ComposeNodeFlavor False applyIconName
|
||||||
(GraphAndRef mempty neverUsedPort) evaluatedFunctions (length evaluatedFunctions)
|
(GraphAndRef mempty neverUsedPort) evaluatedFunctions (length evaluatedFunctions)
|
||||||
|
|
||||||
@ -359,7 +359,7 @@ evalIf c e1 e2 e3 = do
|
|||||||
e1Val <- evalExp c e1
|
e1Val <- evalExp c e1
|
||||||
e2Val <- evalExp c e2
|
e2Val <- evalExp c e2
|
||||||
e3Val <- evalExp c e3
|
e3Val <- evalExp c e3
|
||||||
guardName <- getUniqueName "if"
|
guardName <- getUniqueName
|
||||||
let
|
let
|
||||||
icons = [SgNamedNode guardName (GuardNode 2)]
|
icons = [SgNamedNode guardName (GuardNode 2)]
|
||||||
combinedGraph =
|
combinedGraph =
|
||||||
@ -417,7 +417,7 @@ evalGuaredRhs c (GuardedRhs _ stmts e) = do
|
|||||||
|
|
||||||
evalGuardedRhss :: EvalContext -> [GuardedRhs] -> State IDState (SyntaxGraph, NameAndPort)
|
evalGuardedRhss :: EvalContext -> [GuardedRhs] -> State IDState (SyntaxGraph, NameAndPort)
|
||||||
evalGuardedRhss c rhss = do
|
evalGuardedRhss c rhss = do
|
||||||
guardName <- getUniqueName "guard"
|
guardName <- getUniqueName
|
||||||
evaledRhss <- mapM (evalGuaredRhs c) rhss
|
evaledRhss <- mapM (evalGuaredRhs c) rhss
|
||||||
let
|
let
|
||||||
(bools, exps) = unzip evaledRhss
|
(bools, exps) = unzip evaledRhss
|
||||||
@ -467,7 +467,7 @@ evalCase :: EvalContext -> Exp -> [Alt] -> State IDState (SyntaxGraph, NameAndPo
|
|||||||
evalCase c e alts = do
|
evalCase c e alts = do
|
||||||
evaledAlts <- mapM (evalAlt c) alts
|
evaledAlts <- mapM (evalAlt c) alts
|
||||||
GraphAndRef expGraph expRef <- evalExp c e
|
GraphAndRef expGraph expRef <- evalExp c e
|
||||||
caseIconName <- getUniqueName "case"
|
caseIconName <- getUniqueName
|
||||||
let
|
let
|
||||||
(patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts
|
(patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts
|
||||||
combindedAltGraph = mconcat altGraphs
|
combindedAltGraph = mconcat altGraphs
|
||||||
@ -478,7 +478,7 @@ evalCase c e alts = do
|
|||||||
patEdges = zip patRefs $ map (nameAndPort caseIconName . Port) [2,4..]
|
patEdges = zip patRefs $ map (nameAndPort caseIconName . Port) [2,4..]
|
||||||
rhsEdges = zip patRhsConnected $ zip rhsRefs $ map (nameAndPort caseIconName . Port) [3,5..]
|
rhsEdges = zip patRhsConnected $ zip rhsRefs $ map (nameAndPort caseIconName . Port) [3,5..]
|
||||||
(connectedRhss, unConnectedRhss) = partition fst rhsEdges
|
(connectedRhss, unConnectedRhss) = partition fst rhsEdges
|
||||||
resultIconNames <- replicateM numAlts (getUniqueName "caseResult")
|
resultIconNames <- replicateM numAlts getUniqueName
|
||||||
let
|
let
|
||||||
makeCaseResult :: NodeName -> Reference -> SyntaxGraph
|
makeCaseResult :: NodeName -> Reference -> SyntaxGraph
|
||||||
makeCaseResult resultIconName rhsRef = case rhsRef of
|
makeCaseResult resultIconName rhsRef = case rhsRef of
|
||||||
@ -503,7 +503,7 @@ evalTuple :: EvalContext -> [Exp] -> State IDState (SyntaxGraph, NameAndPort)
|
|||||||
evalTuple c exps = do
|
evalTuple c exps = do
|
||||||
argVals <- mapM (evalExp c) exps
|
argVals <- mapM (evalExp c) exps
|
||||||
funVal <- makeBox $ nTupleString (length exps)
|
funVal <- makeBox $ nTupleString (length exps)
|
||||||
applyIconName <- getUniqueName "tupleApp"
|
applyIconName <- getUniqueName
|
||||||
pure $ makeApplyGraph ApplyNodeFlavor False applyIconName (grNamePortToGrRef funVal) argVals (length exps)
|
pure $ makeApplyGraph ApplyNodeFlavor False applyIconName (grNamePortToGrRef funVal) argVals (length exps)
|
||||||
|
|
||||||
evalListExp :: EvalContext -> [Exp] -> State IDState (SyntaxGraph, NameAndPort)
|
evalListExp :: EvalContext -> [Exp] -> State IDState (SyntaxGraph, NameAndPort)
|
||||||
@ -517,7 +517,7 @@ evalRightSection :: EvalContext -> QOp -> Exp -> State IDState (SyntaxGraph, Nam
|
|||||||
evalRightSection c op e = do
|
evalRightSection c op e = do
|
||||||
expVal <- evalExp c e
|
expVal <- evalExp c e
|
||||||
funVal <- evalExp c (qOpToExp op)
|
funVal <- evalExp c (qOpToExp op)
|
||||||
applyIconName <- getUniqueName "tupleApp"
|
applyIconName <- getUniqueName
|
||||||
-- TODO: A better option would be for makeApplyGraph to take the list of expressions as Maybes.
|
-- TODO: A better option would be for makeApplyGraph to take the list of expressions as Maybes.
|
||||||
neverUsedPort <- Left <$> getUniqueString "unusedArgument"
|
neverUsedPort <- Left <$> getUniqueString "unusedArgument"
|
||||||
pure $ makeApplyGraph ApplyNodeFlavor False applyIconName funVal [GraphAndRef mempty neverUsedPort, expVal] 2
|
pure $ makeApplyGraph ApplyNodeFlavor False applyIconName funVal [GraphAndRef mempty neverUsedPort, expVal] 2
|
||||||
@ -546,7 +546,7 @@ asBindGraphZipper asName nameNPort = makeAsBindGraph (Right nameNPort) [asName]
|
|||||||
|
|
||||||
generalEvalLambda :: EvalContext -> [Pat] -> (EvalContext -> State IDState GraphAndRef) -> State IDState (SyntaxGraph, NameAndPort)
|
generalEvalLambda :: EvalContext -> [Pat] -> (EvalContext -> State IDState GraphAndRef) -> State IDState (SyntaxGraph, NameAndPort)
|
||||||
generalEvalLambda context patterns rhsEvalFun = do
|
generalEvalLambda context patterns rhsEvalFun = do
|
||||||
lambdaName <- getUniqueName "lam"
|
lambdaName <- getUniqueName
|
||||||
patternValsWithAsNames <- mapM evalPattern patterns
|
patternValsWithAsNames <- mapM evalPattern patterns
|
||||||
let
|
let
|
||||||
patternVals = fmap fst patternValsWithAsNames
|
patternVals = fmap fst patternValsWithAsNames
|
||||||
@ -703,7 +703,7 @@ showTopLevelBinds gr = do
|
|||||||
binds = sgBinds gr
|
binds = sgBinds gr
|
||||||
addBind (SgBind _ (Left _)) = pure mempty
|
addBind (SgBind _ (Left _)) = pure mempty
|
||||||
addBind (SgBind patName (Right port)) = do
|
addBind (SgBind patName (Right port)) = do
|
||||||
uniquePatName <- getUniqueName patName
|
uniquePatName <- getUniqueName
|
||||||
let
|
let
|
||||||
icons = [SgNamedNode uniquePatName (BindNameNode patName)]
|
icons = [SgNamedNode uniquePatName (BindNameNode patName)]
|
||||||
edges = [makeSimpleEdge (port, justName uniquePatName)]
|
edges = [makeSimpleEdge (port, justName uniquePatName)]
|
||||||
|
@ -48,6 +48,8 @@ import Icons(Icon(..))
|
|||||||
|
|
||||||
type Reference = Either String NameAndPort
|
type Reference = Either String NameAndPort
|
||||||
|
|
||||||
|
type EvalContext = [String]
|
||||||
|
|
||||||
data SgBind = SgBind String Reference deriving (Eq, Show, Ord)
|
data SgBind = SgBind String Reference deriving (Eq, Show, Ord)
|
||||||
|
|
||||||
data SgSink = SgSink String NameAndPort deriving (Eq, Ord, Show)
|
data SgSink = SgSink String NameAndPort deriving (Eq, Ord, Show)
|
||||||
@ -72,7 +74,6 @@ instance Monoid SyntaxGraph where
|
|||||||
mempty = SyntaxGraph mempty mempty mempty mempty mempty
|
mempty = SyntaxGraph mempty mempty mempty mempty mempty
|
||||||
mappend = (<>)
|
mappend = (<>)
|
||||||
|
|
||||||
type EvalContext = [String]
|
|
||||||
data GraphAndRef = GraphAndRef SyntaxGraph Reference
|
data GraphAndRef = GraphAndRef SyntaxGraph Reference
|
||||||
|
|
||||||
-- BEGIN Constructors and Destructors
|
-- BEGIN Constructors and Destructors
|
||||||
@ -103,9 +104,8 @@ graphAndRefToGraph (GraphAndRef g _) = g
|
|||||||
|
|
||||||
-- END Constructors and Destructors
|
-- END Constructors and Destructors
|
||||||
|
|
||||||
-- TODO Remove string parameter
|
getUniqueName :: State IDState NodeName
|
||||||
getUniqueName :: String -> State IDState NodeName
|
getUniqueName = fmap NodeName getId
|
||||||
getUniqueName _ = fmap NodeName getId
|
|
||||||
|
|
||||||
getUniqueString :: String -> State IDState String
|
getUniqueString :: String -> State IDState String
|
||||||
getUniqueString base = fmap ((base ++). show) getId
|
getUniqueString base = fmap ((base ++). show) getId
|
||||||
@ -191,7 +191,7 @@ makeEdges (SyntaxGraph icons edges sinks bindings eMap) = newGraph where
|
|||||||
-- TODO: remove / change due toSyntaxGraph
|
-- TODO: remove / change due toSyntaxGraph
|
||||||
makeBox :: String -> State IDState (SyntaxGraph, NameAndPort)
|
makeBox :: String -> State IDState (SyntaxGraph, NameAndPort)
|
||||||
makeBox str = do
|
makeBox str = do
|
||||||
name <- getUniqueName str
|
name <- getUniqueName
|
||||||
let graph = syntaxGraphFromNodes [SgNamedNode name (LiteralNode str)]
|
let graph = syntaxGraphFromNodes [SgNamedNode name (LiteralNode str)]
|
||||||
pure (graph, justName name)
|
pure (graph, justName name)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user