mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 23:17:21 +03:00
Embed literal lambda bodies.
This commit is contained in:
parent
ec6837165a
commit
11fbdfebd8
@ -22,6 +22,7 @@ import Util(sgNamedNodeToSyntaxNode)
|
|||||||
data ParentType = ApplyParent
|
data ParentType = ApplyParent
|
||||||
| CaseParent
|
| CaseParent
|
||||||
| MultiIfParent
|
| MultiIfParent
|
||||||
|
| LambdaParent
|
||||||
| NotAParent
|
| NotAParent
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
@ -48,9 +49,14 @@ syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort
|
|||||||
= case (parentType, syntaxNode) of
|
= case (parentType, syntaxNode) of
|
||||||
(ApplyParent, ApplyNode _ _ _) -> parentPortNotResult
|
(ApplyParent, ApplyNode _ _ _) -> parentPortNotResult
|
||||||
(ApplyParent, LiteralNode _) -> parentPortNotResult
|
(ApplyParent, LiteralNode _) -> parentPortNotResult
|
||||||
(ApplyParent, FunctionDefNode _ _)
|
(ApplyParent, FunctionDefNode _ _ _)
|
||||||
-> isInput mParentPort && isResult mChildPort
|
-> isInput mParentPort && isResult mChildPort
|
||||||
|
|
||||||
|
-- (LambdaParent, ApplyNode _ _ _) -> parentPortIsInput
|
||||||
|
(LambdaParent, LiteralNode _) -> parentPortIsInput
|
||||||
|
-- (LambdaParent, FunctionDefNode _ _)
|
||||||
|
-- -> parentPortIsInput
|
||||||
|
|
||||||
(CaseParent, LiteralNode _) -> parentPortNotResult
|
(CaseParent, LiteralNode _) -> parentPortNotResult
|
||||||
(CaseParent, ApplyNode _ _ _)
|
(CaseParent, ApplyNode _ _ _)
|
||||||
-> parentPortNotResult && parentPortNotInput
|
-> parentPortNotResult && parentPortNotInput
|
||||||
@ -72,6 +78,8 @@ syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort
|
|||||||
Just ResultPortConst -> True
|
Just ResultPortConst -> True
|
||||||
Just _ -> False
|
Just _ -> False
|
||||||
|
|
||||||
|
parentPortIsInput = isInput mParentPort
|
||||||
|
|
||||||
parentPortNotInput = not $ isInput mParentPort
|
parentPortNotInput = not $ isInput mParentPort
|
||||||
parentPortNotResult = not $ isResult mParentPort
|
parentPortNotResult = not $ isResult mParentPort
|
||||||
|
|
||||||
@ -80,6 +88,7 @@ parentTypeForNode n = case n of
|
|||||||
ApplyNode _ _ _ -> ApplyParent
|
ApplyNode _ _ _ -> ApplyParent
|
||||||
CaseOrMultiIfNode CaseTag _ _ -> CaseParent
|
CaseOrMultiIfNode CaseTag _ _ -> CaseParent
|
||||||
CaseOrMultiIfNode MultiIfTag _ _ -> MultiIfParent
|
CaseOrMultiIfNode MultiIfTag _ _ -> MultiIfParent
|
||||||
|
FunctionDefNode _ _ _ -> LambdaParent
|
||||||
_ -> NotAParent
|
_ -> NotAParent
|
||||||
|
|
||||||
lookupSyntaxNode :: ING.Graph gr =>
|
lookupSyntaxNode :: ING.Graph gr =>
|
||||||
@ -186,6 +195,11 @@ embedChildSyntaxNode parentNode childNode oldGraph = newGraph
|
|||||||
CaseOrMultiIfNode tag x existingNodes
|
CaseOrMultiIfNode tag x existingNodes
|
||||||
-> CaseOrMultiIfNode tag x
|
-> CaseOrMultiIfNode tag x
|
||||||
(childrenAndEdgesToParent <> existingNodes)
|
(childrenAndEdgesToParent <> existingNodes)
|
||||||
|
FunctionDefNode labels existingNodes innerNodes
|
||||||
|
-> FunctionDefNode
|
||||||
|
labels
|
||||||
|
(childrenAndEdgesToParent <> existingNodes)
|
||||||
|
innerNodes
|
||||||
_ -> oldSyntaxNode
|
_ -> oldSyntaxNode
|
||||||
|
|
||||||
changeEdgeToParent :: ING.Node -> ING.Node -> ING.LEdge b -> ING.LEdge b
|
changeEdgeToParent :: ING.Node -> ING.Node -> ING.LEdge b -> ING.LEdge b
|
||||||
|
27
app/Icons.hs
27
app/Icons.hs
@ -79,7 +79,7 @@ iconToDiagram icon = case icon of
|
|||||||
MultiIfIcon n -> nestedMultiIfDia $ replicate (1 + (2 * n)) Nothing
|
MultiIfIcon n -> nestedMultiIfDia $ replicate (1 + (2 * n)) Nothing
|
||||||
CaseIcon n -> nestedCaseDia $ replicate (1 + (2 * n)) Nothing
|
CaseIcon n -> nestedCaseDia $ replicate (1 + (2 * n)) Nothing
|
||||||
CaseResultIcon -> identDiaFunc caseResult
|
CaseResultIcon -> identDiaFunc caseResult
|
||||||
FlatLambdaIcon x _ -> flatLambda x
|
LambdaIcon x bodyExp _ -> nestedLambda x bodyExp
|
||||||
NestedApply flavor headIcon args -> nestedApplyDia flavor headIcon args
|
NestedApply flavor headIcon args -> nestedApplyDia flavor headIcon args
|
||||||
NestedPApp constructor args
|
NestedPApp constructor args
|
||||||
-> nestedPAppDia (repeat $ patternC colorScheme) constructor args
|
-> nestedPAppDia (repeat $ patternC colorScheme) constructor args
|
||||||
@ -173,7 +173,7 @@ getPortAngles icon port maybeNodeName = case icon of
|
|||||||
MultiIfIcon _ -> multiIfPortAngles port
|
MultiIfIcon _ -> multiIfPortAngles port
|
||||||
CaseIcon _ -> multiIfPortAngles port
|
CaseIcon _ -> multiIfPortAngles port
|
||||||
CaseResultIcon -> []
|
CaseResultIcon -> []
|
||||||
FlatLambdaIcon _ _ -> applyPortAngles port
|
LambdaIcon _ _ _ -> applyPortAngles port
|
||||||
NestedApply _ headIcon args ->
|
NestedApply _ headIcon args ->
|
||||||
generalNestedPortAngles applyPortAngles headIcon args port maybeNodeName
|
generalNestedPortAngles applyPortAngles headIcon args port maybeNodeName
|
||||||
NestedPApp headIcon args ->
|
NestedPApp headIcon args ->
|
||||||
@ -212,7 +212,7 @@ argumentPorts :: SyntaxNode -> [Port]
|
|||||||
argumentPorts n = case n of
|
argumentPorts n = case n of
|
||||||
ApplyNode _ _ _ -> defaultPorts
|
ApplyNode _ _ _ -> defaultPorts
|
||||||
PatternApplyNode _ _-> defaultPorts
|
PatternApplyNode _ _-> defaultPorts
|
||||||
FunctionDefNode _ _ -> defaultPorts
|
FunctionDefNode _ _ _ -> defaultPorts
|
||||||
CaseOrMultiIfNode _ _ _-> defaultPorts
|
CaseOrMultiIfNode _ _ _-> defaultPorts
|
||||||
NameNode _ -> []
|
NameNode _ -> []
|
||||||
BindNameNode _ -> []
|
BindNameNode _ -> []
|
||||||
@ -290,9 +290,9 @@ resultIcon = lw none $ fc (lamArgResC colorScheme) unitSquare
|
|||||||
|
|
||||||
makeAppInnerIcon :: SpecialBackend b n =>
|
makeAppInnerIcon :: SpecialBackend b n =>
|
||||||
TransformParams n ->
|
TransformParams n ->
|
||||||
Bool ->
|
Bool -> -- If False then add one to the nesting level.
|
||||||
Port ->
|
Port -> -- Port number (if the NamedIcon is Nothing)
|
||||||
Labeled (Maybe NamedIcon) ->
|
Labeled (Maybe NamedIcon) -> -- The icon
|
||||||
SpecialQDiagram b n
|
SpecialQDiagram b n
|
||||||
makeAppInnerIcon (TransformParams name _ reflect angle) _ portNum
|
makeAppInnerIcon (TransformParams name _ reflect angle) _ portNum
|
||||||
(Labeled Nothing str)
|
(Labeled Nothing str)
|
||||||
@ -641,9 +641,12 @@ nestedCaseDia = generalNestedMultiIf (patternC colorScheme) caseC caseResult
|
|||||||
-- 0: Result icon
|
-- 0: Result icon
|
||||||
-- 1: The lambda function value
|
-- 1: The lambda function value
|
||||||
-- 2,3.. : The parameters
|
-- 2,3.. : The parameters
|
||||||
flatLambda :: SpecialBackend b n => [String] -> TransformableDia b n
|
nestedLambda :: SpecialBackend b n
|
||||||
flatLambda paramNames (TransformParams name _ reflect angle)
|
=> [String]
|
||||||
= centerXY $ named name finalDia
|
-> Maybe NamedIcon
|
||||||
|
-> TransformableDia b n
|
||||||
|
nestedLambda paramNames mBodyExp (TransformParams name level reflect angle)
|
||||||
|
= centerXY $ bodyExpIcon ||| centerY (named name finalDia)
|
||||||
where
|
where
|
||||||
lambdaCircle
|
lambdaCircle
|
||||||
= lwG defaultLineWidth
|
= lwG defaultLineWidth
|
||||||
@ -654,6 +657,12 @@ flatLambda paramNames (TransformParams name _ reflect angle)
|
|||||||
:
|
:
|
||||||
(portIcons
|
(portIcons
|
||||||
++ [makeQualifiedPort name ResultPortConst <> alignR lambdaCircle])
|
++ [makeQualifiedPort name ResultPortConst <> alignR lambdaCircle])
|
||||||
|
bodyExpIcon = case mBodyExp of
|
||||||
|
Nothing -> mempty
|
||||||
|
Just (NamedIcon bodyNodeName bodyIcon)
|
||||||
|
-> iconToDiagram
|
||||||
|
bodyIcon
|
||||||
|
(TransformParams bodyNodeName level reflect angle)
|
||||||
|
|
||||||
portIcons
|
portIcons
|
||||||
= zipWith (makeLabelledPort name reflect angle) paramNames argPortsConst
|
= zipWith (makeLabelledPort name reflect angle) paramNames argPortsConst
|
||||||
|
@ -367,7 +367,7 @@ drawLambdaRegions placedNodes
|
|||||||
-- Also draw the region around the icon the lambda is in.
|
-- Also draw the region around the icon the lambda is in.
|
||||||
drawRegion :: [NodeName] -> NamedIcon -> SpecialQDiagram b Double
|
drawRegion :: [NodeName] -> NamedIcon -> SpecialQDiagram b Double
|
||||||
drawRegion parentNames icon = case icon of
|
drawRegion parentNames icon = case icon of
|
||||||
NamedIcon _ (FlatLambdaIcon _ enclosedNames)
|
NamedIcon _ (LambdaIcon _ _ enclosedNames)
|
||||||
-> regionRect $ fmap findDia (parentNames <> enclosedNames)
|
-> regionRect $ fmap findDia (parentNames <> enclosedNames)
|
||||||
NamedIcon parentName (NestedApply _ headIcon icons)
|
NamedIcon parentName (NestedApply _ headIcon icons)
|
||||||
-> mconcat
|
-> mconcat
|
||||||
|
@ -531,7 +531,7 @@ evalLambda _ context patterns expr = do
|
|||||||
let
|
let
|
||||||
paramNames = fmap patternName patternValsWithAsNames
|
paramNames = fmap patternName patternValsWithAsNames
|
||||||
enclosedNodeNames = snnName <$> sgNodes combinedGraph
|
enclosedNodeNames = snnName <$> sgNodes combinedGraph
|
||||||
lambdaNode = FunctionDefNode paramNames enclosedNodeNames
|
lambdaNode = FunctionDefNode paramNames [] enclosedNodeNames
|
||||||
lambdaPorts = map (nameAndPort lambdaName) $ argumentPorts lambdaNode
|
lambdaPorts = map (nameAndPort lambdaName) $ argumentPorts lambdaNode
|
||||||
patternGraph = mconcat $ fmap graphAndRefToGraph patternVals
|
patternGraph = mconcat $ fmap graphAndRefToGraph patternVals
|
||||||
|
|
||||||
|
@ -285,7 +285,8 @@ nodeToIcon (PatternApplyNode s children)
|
|||||||
nodeToIcon (NameNode s) = TextBoxIcon s
|
nodeToIcon (NameNode s) = TextBoxIcon s
|
||||||
nodeToIcon (BindNameNode s) = BindTextBoxIcon s
|
nodeToIcon (BindNameNode s) = BindTextBoxIcon s
|
||||||
nodeToIcon (LiteralNode s) = TextBoxIcon s
|
nodeToIcon (LiteralNode s) = TextBoxIcon s
|
||||||
nodeToIcon (FunctionDefNode x names) = FlatLambdaIcon x names
|
nodeToIcon (FunctionDefNode labels embeddedNodes bodyNodes)
|
||||||
|
= nestedLambdaToIcon labels embeddedNodes bodyNodes
|
||||||
nodeToIcon CaseResultNode = CaseResultIcon
|
nodeToIcon CaseResultNode = CaseResultIcon
|
||||||
nodeToIcon (CaseOrMultiIfNode tag x edges)
|
nodeToIcon (CaseOrMultiIfNode tag x edges)
|
||||||
= nestedCaseOrMultiIfNodeToIcon tag x edges
|
= nestedCaseOrMultiIfNodeToIcon tag x edges
|
||||||
@ -308,6 +309,16 @@ nestedApplySyntaxNodeToIcon flavor numArgs args =
|
|||||||
headIcon = makeArg args (inputPort dummyNode)
|
headIcon = makeArg args (inputPort dummyNode)
|
||||||
argList = fmap (makeArg args) argPorts
|
argList = fmap (makeArg args) argPorts
|
||||||
|
|
||||||
|
nestedLambdaToIcon :: [String] -- labels
|
||||||
|
-> [(SgNamedNode, Edge)] -- embedded icons
|
||||||
|
-> [NodeName] -- body nodes
|
||||||
|
-> Icon
|
||||||
|
nestedLambdaToIcon labels embeddedNodes =
|
||||||
|
LambdaIcon labels embeddedBodyNode
|
||||||
|
where
|
||||||
|
dummyNode = FunctionDefNode [] [] []
|
||||||
|
embeddedBodyNode = makeArg embeddedNodes (inputPort dummyNode)
|
||||||
|
|
||||||
nestedCaseOrMultiIfNodeToIcon ::
|
nestedCaseOrMultiIfNodeToIcon ::
|
||||||
CaseOrMultiIfTag
|
CaseOrMultiIfTag
|
||||||
-> Int
|
-> Int
|
||||||
|
@ -54,8 +54,9 @@ instance Applicative Labeled where
|
|||||||
data Icon = TextBoxIcon String
|
data Icon = TextBoxIcon String
|
||||||
| MultiIfIcon
|
| MultiIfIcon
|
||||||
Int -- Number of alternatives
|
Int -- Number of alternatives
|
||||||
| FlatLambdaIcon
|
| LambdaIcon
|
||||||
[String] -- Parameter labels
|
[String] -- Parameter labels
|
||||||
|
(Maybe NamedIcon) -- Function body expression
|
||||||
[NodeName] -- Nodes inside the lambda
|
[NodeName] -- Nodes inside the lambda
|
||||||
| CaseIcon Int
|
| CaseIcon Int
|
||||||
| CaseResultIcon
|
| CaseResultIcon
|
||||||
@ -93,6 +94,7 @@ data SyntaxNode =
|
|||||||
| LiteralNode String -- Literal values like the string "Hello World"
|
| LiteralNode String -- Literal values like the string "Hello World"
|
||||||
| FunctionDefNode -- Function definition (ie. lambda expression)
|
| FunctionDefNode -- Function definition (ie. lambda expression)
|
||||||
[String] -- Parameter labels
|
[String] -- Parameter labels
|
||||||
|
[(SgNamedNode, Edge)] -- Embedded nodes
|
||||||
[NodeName] -- Nodes inside the lambda
|
[NodeName] -- Nodes inside the lambda
|
||||||
| CaseResultNode -- TODO remove caseResultNode
|
| CaseResultNode -- TODO remove caseResultNode
|
||||||
| CaseOrMultiIfNode CaseOrMultiIfTag Int [(SgNamedNode, Edge)]
|
| CaseOrMultiIfNode CaseOrMultiIfTag Int [(SgNamedNode, Edge)]
|
||||||
|
@ -15,9 +15,9 @@ import Util(iconToPort, tupleToNamedIcon)
|
|||||||
iconToIntPort :: NodeName -> NodeName -> Int -> Edge
|
iconToIntPort :: NodeName -> NodeName -> Int -> Edge
|
||||||
iconToIntPort x y p = iconToPort x y (Port p)
|
iconToIntPort x y p = iconToPort x y (Port p)
|
||||||
|
|
||||||
n0, n1, _n2, n3, _n4, n5, _n6, _n7, _n8, _n9, n10 :: NodeName
|
n0, n1, n2, n3, _n4, n5, _n6, _n7, _n8, _n9, n10 :: NodeName
|
||||||
nodeNames :: [NodeName]
|
nodeNames :: [NodeName]
|
||||||
nodeNames@[n0, n1, _n2, n3, _n4, n5, _n6, _n7, _n8, _n9, n10]
|
nodeNames@[n0, n1, n2, n3, _n4, n5, _n6, _n7, _n8, _n9, n10]
|
||||||
= fmap NodeName [0..10]
|
= fmap NodeName [0..10]
|
||||||
|
|
||||||
ni0, ni1, ni2, ni3, ni4, ni5, ni6, ni7, ni8, ni9, ni10 :: Icon -> NamedIcon
|
ni0, ni1, ni2, ni3, ni4, ni5, ni6, ni7, ni8, ni9, ni10 :: Icon -> NamedIcon
|
||||||
@ -107,7 +107,19 @@ lambdaDia :: Drawing
|
|||||||
lambdaDia = Drawing icons []
|
lambdaDia = Drawing icons []
|
||||||
where
|
where
|
||||||
icons = [
|
icons = [
|
||||||
ni0 $ FlatLambdaIcon ["foo", "bar"] [n0, n1]
|
ni0 $ LambdaIcon ["foo", "bar"] Nothing [n0, n1]
|
||||||
|
, ni1 CaseResultIcon
|
||||||
|
, ni2 $ MultiIfIcon 3
|
||||||
|
]
|
||||||
|
|
||||||
|
nestedLambdaDia :: Drawing
|
||||||
|
nestedLambdaDia = Drawing icons []
|
||||||
|
where
|
||||||
|
icons = [
|
||||||
|
ni0 $ LambdaIcon
|
||||||
|
["baz", "cat"]
|
||||||
|
(Just $ NamedIcon n2 (TextBoxIcon "foobar"))
|
||||||
|
[n0, n1]
|
||||||
, ni1 CaseResultIcon
|
, ni1 CaseResultIcon
|
||||||
, ni2 $ MultiIfIcon 3
|
, ni2 $ MultiIfIcon 3
|
||||||
]
|
]
|
||||||
@ -128,4 +140,5 @@ renderTests = do
|
|||||||
, nestedPAppDia
|
, nestedPAppDia
|
||||||
, nestedApplyDia
|
, nestedApplyDia
|
||||||
, lambdaDia
|
, lambdaDia
|
||||||
|
, nestedLambdaDia
|
||||||
]
|
]
|
||||||
|
3
todo.md
3
todo.md
@ -1,7 +1,8 @@
|
|||||||
# Todo
|
# Todo
|
||||||
|
|
||||||
## Todo Now
|
## Todo Now
|
||||||
* Let lambda icons embed results.
|
* Let lambda icons embed more icons.
|
||||||
|
* Refactor out embedded nodes from SyntaxNodes into a common data structure.
|
||||||
* Redesign case to avoid non-locality.
|
* Redesign case to avoid non-locality.
|
||||||
* Add command line flags for color style, embedding, and whether to draw arrowheads.
|
* Add command line flags for color style, embedding, and whether to draw arrowheads.
|
||||||
* Add wiki pages discussing: Why a visual language?, History of Glance, How to contribute, Code guide [code style, ...], etc..
|
* Add wiki pages discussing: Why a visual language?, History of Glance, How to contribute, Code guide [code style, ...], etc..
|
||||||
|
Loading…
Reference in New Issue
Block a user