aboutsummaryrefslogtreecommitdiff
path: root/Sil/Check.icl
diff options
context:
space:
mode:
Diffstat (limited to 'Sil/Check.icl')
-rw-r--r--Sil/Check.icl49
1 files changed, 49 insertions, 0 deletions
diff --git a/Sil/Check.icl b/Sil/Check.icl
new file mode 100644
index 0000000..fa93ac9
--- /dev/null
+++ b/Sil/Check.icl
@@ -0,0 +1,49 @@
+implementation module Sil.Check
+
+import StdFile
+from StdFunc import flip
+import StdList
+import StdOverloaded
+import StdString
+
+from Data.Func import $, mapSt, seqSt
+import Data.Maybe
+import Data.Tuple
+from Text import <+
+
+import Sil.Syntax
+
+instance toString CheckError
+where
+ 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 <+ "'."
+
+instance <<< CheckError where <<< f e = f <<< toString e <<< "\r\n"
+
+checkProgram :: *(Maybe *File) Program -> *([CheckError], *Maybe *File)
+checkProgram err prog = checkFunction err (hd prog.p_funs) //appFst flatten $ mapSt (flip checkFunction) prog.p_funs err
+
+checkFunction :: *(Maybe *File) Function -> *([CheckError], *Maybe *File)
+checkFunction err f = checkErrors [checkReturnExpressionFromVoid] f err
+where
+ checkReturnExpressionFromVoid :: Function -> Maybe CheckError
+ checkReturnExpressionFromVoid f = case f.f_type of
+ TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of
+ [] -> Nothing
+ _ -> Just $ ReturnExpressionFromVoidError f.f_name
+ _ -> Nothing
+
+checkErrors :: [(a -> Maybe CheckError)] a *(Maybe *File) -> *([CheckError], *Maybe *File)
+checkErrors cks x err = seqSt error (catMaybes $ map (flip ($) x) cks) $ noErrors err
+
+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