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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
implementation module Sil.Check
import StdBool
import StdFile
from StdFunc import flip, o
import StdList
import StdOverloaded
import StdString
import StdTuple
import Data.Error
from Data.Func import $, mapSt, seqSt
import Data.List
import Data.Maybe
import Data.Tuple
from Text import <+
import Sil.Error
import Sil.Syntax
import Sil.Types
import Sil.Util.Parser
checkProgram :: *(Maybe *File) Program -> *([Error], *Maybe *File)
checkProgram err prog
= checkErrors
[ checkFunctionNames
, checkMainFunction
, checkGlobals
] prog
$ appFst flatten $ mapSt (flip checkFunction) prog.p_funs err
where
checkMainFunction :: Program -> [Error]
checkMainFunction p = case [f \\ f <- p.p_funs | f.pos_val.f_name == "main"] of
[] -> [Ck_NoMainFunction]
_ -> []
checkFunctionNames :: Program -> [Error]
checkFunctionNames p =
[ Ck_DuplicateFunctionName (errpos $ hd fs) (fromPositioned $ hd fs).f_name
\\ fs <- tails [f \\ f <- p.p_funs]
| let names = [f.pos_val.f_name \\ f <- fs]
in not (isEmpty names) && isMember (hd names) (tl names)]
checkGlobals :: Program -> [Error]
checkGlobals p =
[ Ck_BasicGlobal (errpos g) (fromPositioned g).init_name
\\ g <- p.p_globals
| (typeSize (fromPositioned g).init_type).bsize <> 0]
checkFunction :: *(Maybe *File) (Positioned Function) -> *([Error], *Maybe *File)
checkFunction err f = checkErrors
[ checkLocals
, checkReturnAndVoid
, checkMainFunctionType
] f
$ noErrors err
where
checkReturnAndVoid :: (Positioned Function) -> [Error]
checkReturnAndVoid p=:{pos_val=f} = case f.f_type of
TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of
[] -> []
_ -> [Ck_ReturnExpressionFromVoid (errpos p) f.f_name]
_ -> if (sureToReturn f.f_code) [] [Ck_NoReturnFromNonVoid (errpos p) f.f_name]
where
sureToReturn :: CodeBlock -> Bool
sureToReturn cb = case cb.cb_content of
[] -> False
sts -> case fromPositioned $ last sts of
Return _ -> True
While _ cb` -> sureToReturn cb`
If bs (Just e) -> all sureToReturn [e:map snd bs]
If bs Nothing -> all (sureToReturn o snd) bs
MachineStm _ -> True // Let's assume the user is not stupid
_ -> False
checkMainFunctionType :: (Positioned Function) -> [Error]
checkMainFunctionType {pos_val={f_name="main",f_args=[]}}
= []
checkMainFunctionType p=:{pos_val=f=:{f_name="main"}}
= [Ck_MainFunctionInvalidType (errpos p) $ fromOk $ fromJust $ type zero f]
checkMainFunctionType _
= []
checkLocals :: (Positioned Function) -> [Error]
checkLocals p=:{pos_val=f} =
checkDupName [a.arg_name \\ a <- f.f_args] f.f_code ++
concatMap checkVoid (allLocals f)
where
checkDupName :: [Name] CodeBlock -> [Error]
checkDupName defined cb =
[Ck_DuplicateLocalName (errpos p) f.f_name l \\ l <- defined | isMember l locals] ++
concatMap (checkDupName (locals ++ defined)) (underlyingCBs cb)
where locals = [(fromPositioned i).init_name \\ i <- cb.cb_init]
underlyingCBs :: CodeBlock -> [CodeBlock]
underlyingCBs cb = concatMap (findCBs o fromPositioned) cb.cb_content
where
findCBs (Declaration _ _) = []
findCBs (Application _) = []
findCBs (Return _) = []
findCBs (If bs (Just e)) = [e:map snd bs]
findCBs (If bs Nothing) = map snd bs
findCBs (While _ cb) = [cb]
findCBs (MachineStm _) = []
checkVoid :: (Type, Name) -> [Error]
checkVoid (TVoid, n) = [Ck_LocalVoid f.f_name n]
checkVoid _ = []
checkErrors :: [(a -> [Error])] a *([Error], Maybe *File) -> *([Error], *Maybe *File)
checkErrors cks x st = seqSt error (concatMap (flip ($) x) cks) st
error :: Error *([Error], *Maybe *File) -> *([Error], *Maybe *File)
error e (es, err) = ([e:es], err <?< e)
noErrors :: *(Maybe *File) -> *([Error], *Maybe *File)
noErrors f = ([], f)
(<?<) infixl :: !*(Maybe *File) !a -> *Maybe *File | <<< a
(<?<) (Just f) x = Just (f <<< x)
(<?<) Nothing _ = Nothing
|
