implementation module Sil.Check

import StdFile
from StdFunc import flip, o
import StdList
import StdOverloaded
import StdString
import StdTuple

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 = appFst flatten $ mapSt (flip checkFunction) prog.p_funs err

checkFunction :: *(Maybe *File) Function -> *([CheckError], *Maybe *File)
checkFunction err f = checkErrors [checkReturnAndVoid] f err
where
	checkReturnAndVoid :: Function -> Maybe CheckError
	checkReturnAndVoid f = case f.f_type of
		TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of
			[] -> Nothing
			_  -> Just $ ReturnExpressionFromVoidError f.f_name
		_     -> if (sureToReturn f.f_code) Nothing (Just $ NoReturnFromNonVoidError f.f_name)

	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

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