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