aboutsummaryrefslogtreecommitdiff
path: root/Sil/Check.icl
diff options
context:
space:
mode:
Diffstat (limited to 'Sil/Check.icl')
-rw-r--r--Sil/Check.icl91
1 files changed, 38 insertions, 53 deletions
diff --git a/Sil/Check.icl b/Sil/Check.icl
index f9147bf..c9ccecb 100644
--- a/Sil/Check.icl
+++ b/Sil/Check.icl
@@ -15,31 +15,12 @@ import Data.Maybe
import Data.Tuple
from Text import <+
+import Sil.Error
import Sil.Syntax
import Sil.Types
+import Sil.Util.Parser
-instance toString CheckError
-where
- toString NoMainFunction
- = "Error: no main function."
- toString (MainFunctionInvalidType t)
- = "Error: function 'main' should not have arguments has type " <+ t <+ "."
- toString (DuplicateFunctionName n)
- = "Error: multiply defined: '" <+ n <+ "'."
- toString (DuplicateLocalName f arg)
- = "Error: multiply defined: '" <+ arg <+ "' in '" <+ f <+ "'."
- toString (ReturnExpressionFromVoid f)
- = "Type error: an expression was returned from void function '" <+ f <+ "'."
- toString (NoReturnFromNonVoid 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."
- toString (BasicGlobal g)
- = "Error: global variable '" <+ g <+ "' cannot have a basic type."
-
-instance <<< CheckError where <<< f e = f <<< toString e <<< "\r\n"
-
-checkProgram :: *(Maybe *File) Program -> *([CheckError], *Maybe *File)
+checkProgram :: *(Maybe *File) Program -> *([Error], *Maybe *File)
checkProgram err prog
= checkErrors
[ checkFunctionNames
@@ -48,24 +29,25 @@ checkProgram err prog
] 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]
+ checkMainFunction :: Program -> [Error]
+ checkMainFunction p = case [f \\ f <- p.p_funs | f.pos_val.f_name == "main"] of
+ [] -> [Ck_NoMainFunction]
_ -> []
- checkFunctionNames :: Program -> [CheckError]
+ checkFunctionNames :: Program -> [Error]
checkFunctionNames p =
- [ DuplicateFunctionName $ hd fs
- \\ fs <- tails [f.f_name \\ f <- p.p_funs]
- | not (isEmpty fs) && isMember (hd fs) (tl fs)]
+ [ 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 -> [CheckError]
+ checkGlobals :: Program -> [Error]
checkGlobals p =
- [ BasicGlobal g.init_name
+ [ Ck_BasicGlobal (errpos g) (fromPositioned g).init_name
\\ g <- p.p_globals
- | (typeSize g.init_type).bsize <> 0]
+ | (typeSize (fromPositioned g).init_type).bsize <> 0]
-checkFunction :: *(Maybe *File) Function -> *([CheckError], *Maybe *File)
+checkFunction :: *(Maybe *File) (Positioned Function) -> *([Error], *Maybe *File)
checkFunction err f = checkErrors
[ checkLocals
, checkReturnAndVoid
@@ -73,17 +55,17 @@ checkFunction err f = checkErrors
] f
$ noErrors err
where
- checkReturnAndVoid :: Function -> [CheckError]
- checkReturnAndVoid f = case f.f_type of
+ checkReturnAndVoid :: (Positioned Function) -> [Error]
+ checkReturnAndVoid p=:{pos_val=f} = case f.f_type of
TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of
[] -> []
- _ -> [ReturnExpressionFromVoid f.f_name]
- _ -> if (sureToReturn f.f_code) [] [NoReturnFromNonVoid f.f_name]
+ _ -> [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 last sts of
+ sts -> case fromPositioned $ last sts of
Return _ -> True
While _ cb` -> sureToReturn cb`
If bs (Just e) -> all sureToReturn [e:map snd bs]
@@ -91,24 +73,27 @@ where
MachineStm _ -> True // Let's assume the user is not stupid
_ -> False
- checkMainFunctionType :: Function -> [CheckError]
- checkMainFunctionType f=:{f_name="main",f_args=[]} = []
- checkMainFunctionType f=:{f_name="main"} = [MainFunctionInvalidType $ fromOk $ fromJust $ type zero f]
- checkMainFunctionType _ = []
+ 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 :: Function -> [CheckError]
- checkLocals f =
+ 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 -> [CheckError]
+ checkDupName :: [Name] CodeBlock -> [Error]
checkDupName defined cb =
- [DuplicateLocalName f.f_name l \\ l <- defined | isMember l locals] ++
+ [Ck_DuplicateLocalName (errpos p) f.f_name l \\ l <- defined | isMember l locals] ++
concatMap (checkDupName (locals ++ defined)) (underlyingCBs cb)
- where locals = [i.init_name \\ i <- cb.cb_init]
+ where locals = [(fromPositioned i).init_name \\ i <- cb.cb_init]
underlyingCBs :: CodeBlock -> [CodeBlock]
- underlyingCBs cb = concatMap findCBs cb.cb_content
+ underlyingCBs cb = concatMap (findCBs o fromPositioned) cb.cb_content
where
findCBs (Declaration _ _) = []
findCBs (Application _) = []
@@ -118,17 +103,17 @@ where
findCBs (While _ cb) = [cb]
findCBs (MachineStm _) = []
- checkVoid :: (Type, Name) -> [CheckError]
- checkVoid (TVoid, n) = [LocalVoid f.f_name n]
+ checkVoid :: (Type, Name) -> [Error]
+ checkVoid (TVoid, n) = [Ck_LocalVoid f.f_name n]
checkVoid _ = []
-checkErrors :: [(a -> [CheckError])] a *([CheckError], Maybe *File) -> *([CheckError], *Maybe *File)
+checkErrors :: [(a -> [Error])] a *([Error], Maybe *File) -> *([Error], *Maybe *File)
checkErrors cks x st = seqSt error (concatMap (flip ($) x) cks) st
-error :: CheckError *([CheckError], *Maybe *File) -> *([CheckError], *Maybe *File)
+error :: Error *([Error], *Maybe *File) -> *([Error], *Maybe *File)
error e (es, err) = ([e:es], err <?< e)
-noErrors :: *(Maybe *File) -> *([CheckError], *Maybe *File)
+noErrors :: *(Maybe *File) -> *([Error], *Maybe *File)
noErrors f = ([], f)
(<?<) infixl :: !*(Maybe *File) !a -> *Maybe *File | <<< a
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-12 19:58:32 +0000