Add AST checks

8 files changed, 140 insertions, 24 deletions

diff --git a/Sil/Check.dcl b/Sil/Check.dcl
new file mode 100644
index 0000000..b222079
--- /dev/null
+++ b/Sil/Check.dcl
@@ -0,0 +1,15 @@
+definition module Sil.Check
+
+from StdOverloaded import class toString
+
+from Data.Maybe import :: Maybe
+
+from Sil.Syntax import :: Program, :: Name
+
+:: CheckError
+	= ReturnExpressionFromVoidError Name
+	| NoReturnFromNonVoidError Name
+
+instance toString CheckError
+
+checkProgram :: *(Maybe *File) Program -> *([CheckError], *Maybe *File)
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
diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index 7857ff2..afdfe90 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -36,7 +36,8 @@ compile prog = case evalRWST (gen prog) () zero of
 :: Address :== Int
 
 :: FunctionSymbol =
-	{ fs_arity :: Int
+	{ fs_arity   :: Int
+	, fs_rettype :: Type
 	}
 
 :: CompileState =
@@ -104,7 +105,11 @@ reserveVar :: Int Name -> Gen Int
 reserveVar i n = modify (\cs -> {cs & addresses='M'.put n i cs.addresses}) *> pure (i+1)
 
 addFunction :: Function -> Gen ()
-addFunction f = modify (\cs -> {cs & symbols='M'.put f.f_name {fs_arity=length f.f_args} cs.symbols})
+addFunction f = modify (\cs -> {cs & symbols='M'.put f.f_name fs cs.symbols})
+where
+	fs = { fs_arity   = length f.f_args
+	     , fs_rettype = f.f_type
+	     }
 
 cleanup :: Gen ()
 cleanup = gets peekReturn >>= tell
@@ -142,18 +147,19 @@ where
 		modify (newReturn cleanup`) *>
 		gen f.f_code *>
 		cleanup *>
-		shrinkStack (args - 1) *>
+		modify (\cs -> {cs & stackoffset=0}) *>
 		tell ['ABC'.Rtn] *>
 		modify popReturn
 	where
 		cleanup` = case f.f_args of
-			[] -> [ 'ABC'.Annotation $ 'ABC'.DAnnot 1 []
+			[] -> [ 'ABC'.Annotation $ 'ABC'.DAnnot retSize []
 			      ]
-			_  -> [ 'ABC'.Comment "Cleanup"
-			      , 'ABC'.Update_a 0 args
-			      , 'ABC'.Pop_a args
-			      , 'ABC'.Annotation $ 'ABC'.DAnnot 1 []
+			_  -> [ 'ABC'.Comment "Cleanup"] ++
+			      [ 'ABC'.Update_a i (args+i) \\ i <- [0..retSize-1] ] ++
+			      [ 'ABC'.Pop_a args
+			      , 'ABC'.Annotation $ 'ABC'.DAnnot retSize []
 			      ]
+		retSize = typeSize f.f_type
 		args = length f.f_args
 		locals = length f.f_code.cb_init
 
@@ -171,9 +177,7 @@ where
 	where
 		cleanup` = case cb.cb_init of
 			[] -> []
-			_  -> [ 'ABC'.Update_a 0 locals
-			      , 'ABC'.Pop_a locals
-			      ]
+			_  -> [ 'ABC'.Pop_a locals ]
 		locals = length cb.cb_init
 
 instance gen Initialisation
diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl
index aebe32c..42097c5 100644
--- a/Sil/Syntax.dcl
+++ b/Sil/Syntax.dcl
@@ -77,3 +77,14 @@ instance toString Expression
 instance toString Op1
 instance toString Op2
 instance toString Literal
+
+class allStatements a :: a -> [Statement]
+instance allStatements Program
+instance allStatements Function
+instance allStatements CodeBlock
+instance allStatements Statement
+
+/**
+ * Size of an expression on the stack
+ */
+typeSize :: Type -> Int
diff --git a/Sil/Syntax.icl b/Sil/Syntax.icl
index 0056618..f78ba83 100644
--- a/Sil/Syntax.icl
+++ b/Sil/Syntax.icl
@@ -1,8 +1,11 @@
 implementation module Sil.Syntax
 
+from StdFunc import o
 import StdOverloaded
 import StdString
+import StdTuple
 
+import Data.List
 import Data.Maybe
 import Text
 
@@ -54,3 +57,27 @@ instance toString Literal
 where
 	toString (BLit b) = toString b
 	toString (ILit i) = toString i
+
+instance allStatements Program
+where allStatements p = concatMap allStatements p.p_funs
+
+instance allStatements Function
+where allStatements f = allStatements f.f_code
+
+instance allStatements CodeBlock
+where allStatements cb = concatMap allStatements cb.cb_content
+
+instance allStatements Statement
+where
+	allStatements st=:(Declaration _ _) = [st]
+	allStatements st=:(Application _)   = [st]
+	allStatements st=:(Return _)        = [st]
+	allStatements st=:(If bs Nothing)   = [st:concatMap (allStatements o snd) bs]
+	allStatements st=:(If bs (Just e))  = [st:allStatements e ++ concatMap (allStatements o snd) bs]
+	allStatements st=:(While _ cb)      = [st:allStatements cb]
+	allStatements st=:(MachineStm _)    = [st]
+
+typeSize :: Type -> Int
+typeSize TVoid = 0
+typeSize TBool = 1
+typeSize TInt  = 1
diff --git a/examples/fib.sil b/examples/fib.sil
index 71a9bb1..db66783 100644
--- a/examples/fib.sil
+++ b/examples/fib.sil
@@ -1,13 +1,13 @@
 Int fib(Int n) {
-	if (n == 100) {
-		return 100;
-	} else if (n == 200) {
-			return 100;
+	if (n == 1) {
+		return 1;
+	} else if (n == 2) {
+		return 1;
 	} else {
-		return fib(n - 100) + fib(n - 200);
+		return fib(n - 1) + fib(n - 2);
 	}
 }
 
 Int main() {
-	return fib(1000);
+	return fib(10);
 }
diff --git a/examples/while.sil b/examples/while.sil
index b6ae2cc..49186fb 100644
--- a/examples/while.sil
+++ b/examples/while.sil
@@ -1,9 +1,8 @@
-Int print(Int n) {
+Void print(Int n) {
 	|~	push_a 0
 	|~.d 1 0
 	|~	jsr _print_graph
 	|~.o 0 0
-	return n;
 }
 
 Int loop(Int start, Int end) {
diff --git a/sil.icl b/sil.icl
index 8bfe037..b73f25c 100644
--- a/sil.icl
+++ b/sil.icl
@@ -14,12 +14,14 @@ import Control.Monad
 import Data.Error
 from Data.Func import $
 import Data.Functor
+import Data.Tuple
 import System.CommandLine
 import System.File
 import System.Process
 
 import ABC.Assembler
 
+from Sil.Check import :: CheckError, checkProgram
 import qualified Sil.Compile as SC
 from Sil.Compile import :: CompileError, instance toString CompileError
 import Sil.Parse
@@ -30,6 +32,7 @@ from Sil.Util.Printer import :: PrintState, instance zero PrintState,
 
 :: CLI =
 	{ prettyprint :: Bool
+	, check       :: Bool
 	, compile     :: Bool
 	, generate    :: Bool
 	, run         :: Bool
@@ -40,6 +43,7 @@ instance zero CLI
 where
 	zero =
 		{ prettyprint = False
+		, check       = False
 		, compile     = False
 		, generate    = False
 		, run         = False
@@ -63,9 +67,15 @@ Start w
 | isError prog
 	# err = err <<< toString (fromError prog) <<< "\r\n"
 	= finish io err w
+# prog = fromOk prog
 # io = if args.prettyprint
-	(io <<< print zero (fromOk prog) <<< "\r\n")
+	(io <<< print zero prog <<< "\r\n")
 	io
+# (errs, err) = if args.check
+	(appSnd fromJust $ checkProgram (Just err) prog)
+	([], err)
+| not (isEmpty errs)
+	= finish io err w
 | not args.compile
 	= finish io err w
 # (ok,f,w) = fopen "sil_compiled.dcl" FWriteText w
@@ -79,7 +89,7 @@ Start w
 | not ok
 	# err = err <<< "Could not open 'sil_compiled.abc' for writing\r\n"
 	= finish io err w
-# f = f <<< 'SC'.compile (fromOk prog)
+# f = f <<< 'SC'.compile prog
 # (_,w) = fclose f w
 | not args.generate
 	= finish io err w
@@ -98,9 +108,10 @@ where
 	arg :: Parser String (CLI -> CLI)
 	arg = peek >>= \opt ->
 		(   item "--pretty-print" *> pure (\cli -> {cli & prettyprint=True})
-		<|> item "--compile" *> pure (\cli -> {cli & compile=True})
-		<|> item "--generate" *> pure (\cli -> {cli & generate=True})
-		<|> item "--run" *> pure (\cli -> {cli & run=True})
+		<|> item "--check"        *> pure (\cli -> {cli & check=True})
+		<|> item "--compile"      *> pure (\cli -> {cli & compile=True})
+		<|> item "--generate"     *> pure (\cli -> {cli & generate=True})
+		<|> item "--run"          *> pure (\cli -> {cli & run=True})
 		<|> (satisfy isFilename >>= \name -> pure (\cli -> {cli & inputfile=name}))
 		<?> Invalid "command line argument" opt
 		)