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
|
implementation module Sil.Check
import StdBool
import StdFile
from StdFunc import flip, o
import StdList
import StdOverloaded
import StdString
import StdTuple
from Data.Func import $, mapSt, seqSt
import Data.List
import Data.Maybe
import Data.Tuple
from Text import <+
import Sil.Syntax
import Sil.Types
instance toString CheckError
where
toString NoMainFunction
= "Error: no main function."
toString (DuplicateFunctionName n)
= "Error: multiply defined: '" <+ n <+ "'."
toString (DuplicateLocalName f arg)
= "Error: multiply defined: '" <+ arg <+ "' in '" <+ f <+ "'."
toString (ReturnExpressionFromVoidError f)
= "Type error: an expression was returned from void function '" <+ f <+ "'."
toString (NoReturnFromNonVoidError f)
= "Type error: no return from non-void function '" <+ f <+ "'."
toString (LocalVoid f l)
= "Type error: local variable '" <+ l <+ "' in '" <+ f <+ "' cannot have type Void."
instance <<< CheckError where <<< f e = f <<< toString e <<< "\r\n"
checkProgram :: *(Maybe *File) Program -> *([CheckError], *Maybe *File)
checkProgram err prog
= checkErrors [checkFunctionNames, checkMainFunction] prog
$ appFst flatten $ mapSt (flip checkFunction) prog.p_funs err
where
checkMainFunction :: Program -> [CheckError]
checkMainFunction p = case [f \\ f <- p.p_funs | f.f_name == "main"] of
[] -> [NoMainFunction]
_ -> []
checkFunctionNames :: Program -> [CheckError]
checkFunctionNames p =
[ DuplicateFunctionName $ hd fs
\\ fs <- tails [f.f_name \\ f <- p.p_funs]
| not (isEmpty fs) && isMember (hd fs) (tl fs)]
checkFunction :: *(Maybe *File) Function -> *([CheckError], *Maybe *File)
checkFunction err f = checkErrors [checkLocals, checkReturnAndVoid] f $ noErrors err
where
checkReturnAndVoid :: Function -> [CheckError]
checkReturnAndVoid f = case f.f_type of
TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of
[] -> []
_ -> [ReturnExpressionFromVoidError f.f_name]
_ -> if (sureToReturn f.f_code) [] [NoReturnFromNonVoidError f.f_name]
where
sureToReturn :: CodeBlock -> Bool
sureToReturn cb = case cb.cb_content of
[] -> False
sts -> case 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
_ -> False
checkLocals :: Function -> [CheckError]
checkLocals f =
checkDupName [a.arg_name \\ a <- f.f_args] f.f_code ++
concatMap checkVoid (allLocals f)
where
checkDupName :: [Name] CodeBlock -> [CheckError]
checkDupName defined cb =
[DuplicateLocalName f.f_name l \\ l <- defined | isMember l locals] ++
concatMap (checkDupName (locals ++ defined)) (underlyingCBs cb)
where locals = [i.init_name \\ i <- cb.cb_init]
underlyingCBs :: CodeBlock -> [CodeBlock]
underlyingCBs cb = concatMap findCBs 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) -> [CheckError]
checkVoid (TVoid, n) = [LocalVoid f.f_name n]
checkVoid _ = []
checkErrors :: [(a -> [CheckError])] a *([CheckError], Maybe *File) -> *([CheckError], *Maybe *File)
checkErrors cks x st = seqSt error (concatMap (flip ($) x) cks) st
error :: CheckError *([CheckError], *Maybe *File) -> *([CheckError], *Maybe *File)
error e (es, err) = ([e:es], err <?< e)
noErrors :: *(Maybe *File) -> *([CheckError], *Maybe *File)
noErrors f = ([], f)
(<?<) infixl :: !*(Maybe *File) !a -> *Maybe *File | <<< a
(<?<) (Just f) x = Just (f <<< x)
(<?<) Nothing _ = Nothing
|
