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
|
module Fun.Tree where
import Fun.Typer
data Visibility = PublicVisibility | PrivateVisibility
deriving Show
-- TODO: Actually enforce danger-* in syntax-check
data FunctionFlag = FunctionInline | FunctionDeprecated | FunctionDangerVoid | FunctionDangerAsm | FunctionUnknown
deriving Show
instance Read FunctionFlag where
readsPrec _ "inline" = [(FunctionInline, "")]
readsPrec _ "deprecated" = [(FunctionDeprecated, "")]
readsPrec _ "danger-void" = [(FunctionDangerVoid, "")]
readsPrec _ "danger-asm" = [(FunctionDangerAsm, "")]
readsPrec _ _ = [(FunctionUnknown, "")]
data Tree = Tree [Program]
deriving Show
data Program = Program [Block]
deriving Show
data Block = FunctionBlock
{ bDecl :: FunctionDeclaration
, bDefns :: [FunctionDefinition]
} -- | DataBlock .. TODO
deriving Show
type FunctionSignature = [Type]
data FunctionDeclaration = FunctionDeclaration
{ dName :: String
, dVisibility :: Visibility
, dTypes :: FunctionSignature
, dFlags :: [FunctionFlag]
}
deriving Show
data FunctionDefinition = FunctionDefinition
{ dPattern :: FunctionPattern
, dBody :: FunctionBody
}
deriving Show
data FunctionPattern = FunctionPattern
{ pElements :: [FunctionPatternElement]
}
deriving Show
data FunctionPatternElement = FunctionPatternParameter String | FunctionPatternString String | FunctionPatternNumber Integer | FunctionPatternWildcard
deriving (Show, Eq, Ord)
data FunctionBody = FunctionBodyCall { cName :: String, cArgs :: [FunctionArgument] } | FunctionBodyInfixCall { iName :: String, iArgs :: [FunctionArgument] } | FunctionBodyValue FunctionArgument | FunctionBodySub FunctionBody
deriving Show
data FunctionArgument = FunctionName String | FunctionInfixName String | FunctionParameter String | FunctionString String | FunctionNumber Integer
deriving Show
----
-- TODO: This can be optimized
getFunction :: Tree -> String -> FunctionSignature -> Maybe Block
getFunction (Tree ps) f sig =
let fromProgram (Program bs) =
filter (\b -> (dName . bDecl) b == f && (dTypes . bDecl) b == sig) bs
fromTree = filter (\b -> length b == 1) (map fromProgram ps)
in case fromTree of
[[f]] -> Just f
_ -> Nothing
|
