1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
module Fun.Tree where
data Tree = Tree [Program]
deriving Show
data Program = Program [Block]
deriving Show
data Block = Block FunctionBlock -- | Block DataBlock ...
deriving Show
data FunctionBlock = FunctionBlock FunctionDeclaration [FunctionDefinition]
deriving Show
data Visibility = PublicVisibility | PrivateVisibility
deriving Show
data FunctionDeclaration = FunctionDeclaration String
Visibility
[String]
[FunctionFlag]
deriving Show
data FunctionFlag = FunctionInline | FunctionDeprecated | FunctionUnknown
deriving Show
instance Read FunctionFlag where
readsPrec _ "inline" = [(FunctionInline, "")]
readsPrec _ "deprecated" = [(FunctionDeprecated, "")]
readsPrec _ _ = [(FunctionUnknown, "")]
data FunctionDefinition = FunctionDefinition FunctionPattern FunctionBody
deriving Show
data FunctionPattern = FunctionPattern [FunctionPatternElement]
deriving Show
data FunctionPatternElement = FunctionPatternParameter String | FunctionPatternString String | FunctionPatternNumber Integer | FunctionPatternWildcard
deriving Show
data FunctionBody = FunctionBody [FunctionBodyElement]
deriving Show
data FunctionBodyElement = Statement String | FunctionBodyIdentifier String | FunctionBodyParameter String | FunctionBodyString String | FunctionBodyNumber Integer
deriving Show
----
data NodeValue = NodeName String | FunctionBlockNode FunctionBlock -- | Type, Lambda, .. (TODO)
deriving Show
data EmptyValue = EmptyValue
deriving Show
data Node = EmptyNode | Node NodeValue [Node]
deriving Show
data Crumb = Crumb NodeValue [Node] [Node]
deriving Show
type Zipper = (Node, [Crumb])
(-:) :: Maybe Zipper -> (Maybe Zipper -> Maybe Zipper) -> Maybe Zipper
u -: f = f u
nodePred :: (NodeValue -> Bool) -> Node -> Bool
nodePred pred (Node value _) = pred value
nodePred _ _ = False
-- One layer search from top
treeTo :: (NodeValue -> Bool) -> Maybe Zipper -> Maybe Zipper
treeTo _ Nothing = Nothing
treeTo pred (Just (EmptyNode, _)) = Nothing
treeTo pred (Just (Node value nodes, bs)) =
let (ls, node : rs) = break (nodePred pred) nodes
in Just (node, Crumb value ls rs : bs)
treeUp :: Maybe Zipper -> Maybe Zipper
treeUp Nothing = Nothing
treeUp (Just (EmptyNode, _)) = Nothing
treeUp (Just (node, Crumb value ls rs : bs)) =
Just (Node value (ls ++ [node] ++ rs), bs)
|
