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