rgleichman/glance
1
1
Fork 0
mirror of https://github.com/rgleichman/glance.git synced 2024-11-27 03:02:44 +03:00
Code Issues Projects Releases Wiki Activity

Refactor evalCase to use applicative instead of monad.

Browse Source
This commit is contained in:
Robbie Gleichman 2016-12-31 19:44:43 -08:00
parent eaa90e5a9f
commit f94265e8f2
2 changed files with 50 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
app/Translate.hs
View File

@ -490,16 +490,14 @@ evalPatAndRhs c pat rhs maybeWhereBinds = do
evalAlt :: EvalContext -> Exts.Alt -> State IDState (Bool, SyntaxGraph, Reference, Reference, Maybe String)
evalAlt c (Exts.Alt _ pat rhs maybeBinds) = evalPatAndRhs c pat rhs maybeBinds
-- TODO Split out the non-stateful part so that it can be done with an applicative
evalCase :: EvalContext -> Exp -> [Alt] -> State IDState (SyntaxGraph, NameAndPort)
evalCase c e alts = do
evaledAlts <- mapM (evalAlt c) alts
GraphAndRef expGraph expRef <- evalExp c e
caseIconName <- getUniqueName
let
numAlts = length alts
resultIconNames <- replicateM numAlts getUniqueName
let
evalCaseHelper ::
Int
-> NodeName
-> [NodeName]
-> GraphAndRef
-> [(Bool, SyntaxGraph, Reference, Reference, Maybe String)]
-> (SyntaxGraph, NameAndPort)
evalCaseHelper numAlts caseIconName resultIconNames (GraphAndRef expGraph expRef) evaledAlts = result where
(patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts
combindedAltGraph = mconcat altGraphs
caseNode = CaseNode numAlts
@ -526,7 +524,23 @@ evalCase c e alts = do
bindGraph = makeAsBindGraph expRef asNames
finalGraph = deleteBindings $ makeEdges $ mconcat [bindGraph, patternEdgesGraph, caseResultGraphs, expGraph, caseEdgeGraph, caseGraph, combindedAltGraph]
pure (finalGraph, nameAndPort caseIconName (resultPort caseNode))
result = (finalGraph, nameAndPort caseIconName (resultPort caseNode))
evalCase :: EvalContext -> Exp -> [Alt] -> State IDState (SyntaxGraph, NameAndPort)
evalCase c e alts =
let
numAlts = length alts
in
evalCaseHelper (length alts)
<$>
getUniqueName
<*>
replicateM numAlts getUniqueName
<*>
evalExp c e
<*>
mapM (evalAlt c) alts
-- END evalCase
@ -543,7 +557,6 @@ evalTupleSection c mExps =
exps = catMaybes mExps
expIsJustList = fmap isJust mExps
in
-- TODO move the int parameter of makeApplyGraph to the beginning
makeApplyGraph (length exps) ApplyNodeFlavor False
<$>
getUniqueName

4
app/TranslateCore.hs
View File

@ -122,6 +122,7 @@ getId = state incrementer where
getUniqueName :: State IDState NodeName
getUniqueName = fmap NodeName getId
-- TODO Should getUniqueString prepend an illegal character?
getUniqueString :: String -> State IDState String
getUniqueString base = fmap ((base ++). show) getId
@ -150,9 +151,6 @@ combineExpressions inPattern portExpPairs = mconcat $ fmap makeGraph portExpPair
else sinksToSyntaxGraph [SgSink str port]
Right resPort -> edgesToSyntaxGraph [Edge edgeOpts noEnds (resPort, port)]
-- qualifyNameAndPort :: String -> NameAndPort -> NameAndPort
-- qualifyNameAndPort s (NameAndPort n p) = NameAndPort (s DIA..> n) p
makeApplyGraph :: Int -> LikeApplyFlavor -> Bool -> NodeName -> GraphAndRef -> [GraphAndRef] -> (SyntaxGraph, NameAndPort)
makeApplyGraph numArgs applyFlavor inPattern applyIconName funVal argVals = (newGraph <> combinedGraph, nameAndPort applyIconName (resultPort applyNode))
where