From bb52dc5e385a011f928f7a6c8b8497563a31c464 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Wed, 19 Jul 2017 19:42:47 +0000
Subject: Add AST checks

---
 Sil/Check.icl | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 Sil/Check.icl

(limited to 'Sil/Check.icl')

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
-- 
cgit v1.2.3