mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
New evalMatch handles complex patterns.
This commit is contained in:
parent
52e34df6b4
commit
eed23189f2
@ -12,8 +12,10 @@ import Types(Icon(..), Drawing(..), EdgeEnd(..))
|
||||
import Translate(translateString)
|
||||
|
||||
-- TODO Now --
|
||||
-- Refactor evalMatch to use a simplified version of makeEdges (makeEdgesCore)
|
||||
-- - that does not use IconGraph as the data structure.
|
||||
-- Rewrite and refactor evalLambda to use the new evalMatch
|
||||
-- Destructuring pattern binds
|
||||
-- Add mode extra part to EvalContext that tells evalQName to make a binding instead of a sink.
|
||||
|
||||
-- TODO Later --
|
||||
-- Eliminate BranchIcon for the identity funciton "y x = x"
|
||||
@ -263,6 +265,8 @@ main3 = do
|
||||
]
|
||||
|
||||
patternTests = [
|
||||
"y = let {z = (\\x -> y x)} in z",
|
||||
"y = let {z x = y x} in z ",
|
||||
"y (F x) = x",
|
||||
"y = (\\(F x) -> x)",
|
||||
"y = let {g = 3; F x y = h g} in x y",
|
||||
|
@ -355,12 +355,13 @@ evalLambda c patterns e = do
|
||||
|
||||
makePatternEdges :: String -> GraphAndRef -> NameAndPort -> Either IconGraph (String, Reference)
|
||||
makePatternEdges lambdaName (_, Right patPort) lamPort =
|
||||
Left $ IconGraph mempty [Edge (lamPort, qualifyNameAndPort lambdaName patPort) noEnds] mempty mempty mempty
|
||||
-- TODO case where pattern is a String
|
||||
Left $ iconGraphFromIconsEdges mempty
|
||||
[Edge (lamPort, qualifyNameAndPort lambdaName patPort) noEnds]
|
||||
makePatternEdges _ (_, Left str) lamPort = Right (str, Right lamPort)
|
||||
-- TODO handle inner function definitions.
|
||||
evalMatch :: EvalContext -> Match -> State IDState IconGraph
|
||||
evalMatch c (Match _ name patterns _ rhs _) = do
|
||||
|
||||
evalMatch' :: EvalContext -> Match -> State IDState IconGraph
|
||||
evalMatch' c (Match _ name patterns _ rhs _) = do
|
||||
lambdaName <- getUniqueName "lam"
|
||||
let
|
||||
nameString = nameToString name
|
||||
@ -380,43 +381,44 @@ evalMatch c (Match _ name patterns _ rhs _) = do
|
||||
--externalEdges = [Edge (justName nameString, justName lambdaName) noEnds]
|
||||
(internalEdges, unmatchedBoundVars) =
|
||||
makeInternalEdges lambdaName rhsGraph patternStrings patternStringMap
|
||||
drawing = IconGraph icons (internalEdges)
|
||||
[(rhsDrawingName, rhsDrawing)] unmatchedBoundVars [(nameString, Right $ justName lambdaName)]
|
||||
drawing = IconGraph icons internalEdges [(rhsDrawingName, rhsDrawing)]
|
||||
unmatchedBoundVars [(nameString, Right $ justName lambdaName)]
|
||||
pure drawing
|
||||
|
||||
|
||||
-- -- TODO handle inner function definitions.
|
||||
-- -- TODO: Make sure that any remaining sinks are qualified.
|
||||
-- evalMatch :: EvalContext -> Match -> State IDState IconGraph
|
||||
-- evalMatch c (Match _ name patterns _ rhs _) = do
|
||||
-- lambdaName <- getUniqueName "lam"
|
||||
-- patternVals <- mapM evalPattern patterns
|
||||
-- let
|
||||
-- patternStrings = concatMap namesInPattern patternVals
|
||||
-- rhsContext = nameString : patternStrings <> c
|
||||
-- lambdaPorts = map (nameAndPort lambdaName) [0,1..]
|
||||
-- patternGraph = mconcat $ map fst patternVals
|
||||
-- nameString = nameToString name
|
||||
-- (patternEdgeGraphs, rawNewBinds) = partitionEithers $ zipWith (makePatternEdges lambdaName) patternVals lambdaPorts
|
||||
-- patternEdgeGraph = mconcat patternEdgeGraphs
|
||||
-- newBinds = (nameString, Right $ justName lambdaName): rawNewBinds
|
||||
-- numParameters = length patterns
|
||||
-- -- TODO remove coerceExpressionResult here
|
||||
-- (rhsRawGraph, rhsResult) <- coerceExpressionResult <$> evalRhs rhs rhsContext
|
||||
-- resultIconName <- getUniqueName "res"
|
||||
-- rhsDrawingName <- DIA.toName <$> getUniqueName "rhsDraw"
|
||||
-- let
|
||||
-- rhsAndPatternGraph@(IconGraph _ _ _ sinks _) = makeEdges $ patternGraph <> rhsRawGraph
|
||||
-- qualifiedSinks = fmap (fmap (qualifyNameAndPort lambdaName)) sinks
|
||||
-- (IconGraph _ internalEdges _ newSinks _) = makeEdges (IconGraph mempty mempty mempty qualifiedSinks newBinds)
|
||||
-- rhsDrawing = makeRhsDrawing resultIconName (rhsAndPatternGraph, rhsResult)
|
||||
-- icons = toNames [
|
||||
-- (lambdaName, LambdaRegionIcon numParameters rhsDrawingName),
|
||||
-- (nameString, TextBoxIcon nameString)
|
||||
-- ]
|
||||
-- externalEdges = [Edge (justName nameString, justName lambdaName) noEnds]
|
||||
-- finalGraph = IconGraph icons (internalEdges <> externalEdges) [(rhsDrawingName, rhsDrawing)] newSinks mempty
|
||||
-- pure $ patternEdgeGraph <> finalGraph
|
||||
-- TODO handle inner function definitions.
|
||||
-- TODO: Make sure that any remaining sinks are qualified.
|
||||
evalMatch :: EvalContext -> Match -> State IDState IconGraph
|
||||
evalMatch c (Match _ name patterns _ rhs _) = do
|
||||
lambdaName <- getUniqueName "lam"
|
||||
patternVals <- mapM evalPattern patterns
|
||||
let
|
||||
matchFunNameString = nameToString name
|
||||
patternStrings = concatMap namesInPattern patternVals
|
||||
rhsContext = matchFunNameString : patternStrings <> c
|
||||
lambdaPorts = map (nameAndPort lambdaName) [0,1..]
|
||||
patternGraph = mconcat $ map fst patternVals
|
||||
|
||||
(patternEdgeGraphs, rawNewBinds) =
|
||||
partitionEithers $ zipWith (makePatternEdges lambdaName) patternVals lambdaPorts
|
||||
patternEdgeGraph = mconcat patternEdgeGraphs
|
||||
|
||||
lambdaNameRef = Right $ justName lambdaName
|
||||
newBinds = (matchFunNameString, lambdaNameRef): rawNewBinds
|
||||
numParameters = length patterns
|
||||
-- TODO remove coerceExpressionResult here
|
||||
(rhsRawGraph, rhsResult) <- coerceExpressionResult <$> evalRhs rhs rhsContext
|
||||
resultIconName <- getUniqueName "res"
|
||||
rhsDrawingName <- DIA.toName <$> getUniqueName "rhsDraw"
|
||||
let
|
||||
rhsAndPatternGraph@(IconGraph _ _ _ sinks _) = makeEdges $ patternGraph <> rhsRawGraph
|
||||
qualifiedSinks = fmap (fmap (qualifyNameAndPort lambdaName)) sinks
|
||||
(IconGraph _ internalEdges _ newSinks _) = makeEdges (IconGraph mempty mempty mempty qualifiedSinks newBinds)
|
||||
rhsDrawing = makeRhsDrawing resultIconName (rhsAndPatternGraph, rhsResult)
|
||||
icons = toNames [(lambdaName, LambdaRegionIcon numParameters rhsDrawingName)]
|
||||
finalGraph = IconGraph icons internalEdges [(rhsDrawingName, rhsDrawing)]
|
||||
newSinks [(matchFunNameString, lambdaNameRef)]
|
||||
pure $ patternEdgeGraph <> finalGraph
|
||||
|
||||
|
||||
evalMatches :: EvalContext -> [Match] -> State IDState IconGraph
|
||||
|
Loading…
Reference in New Issue
Block a user