Added support for specifications at the start of functions without ruining the check for a return statement

This commit is contained in:
Neil Brown 2008-03-22 18:57:23 +00:00
parent 7f28d3dbe3
commit 230db2de08

View File

@ -234,16 +234,22 @@ checkFunction = everywhereM (mkM checkFunction')
checkFunction' :: A.Specification -> PassM A.Specification checkFunction' :: A.Specification -> PassM A.Specification
checkFunction' spec@(A.Specification _ n (A.Function m _ _ _ (Right body))) checkFunction' spec@(A.Specification _ n (A.Function m _ _ _ (Right body)))
= case body of = case body of
(A.Seq m' (A.Several m'' statements)) -> (A.Seq m' seqBody) ->
let A.Several _ statements = skipSpecs seqBody in
if (null statements) if (null statements)
then dieP m "Functions must not have empty bodies" then dieP m "Functions must not have empty bodies"
else case (last statements) of else case (last statements) of
(A.Only _ (A.Assign _ [A.Variable _ dest] _)) -> if A.nameName n == A.nameName dest then return spec else (A.Only _ (A.Assign _ [A.Variable _ dest] _)) -> if A.nameName n == A.nameName dest then return spec else
dieP m "Functions must have a return statement as their last statement." dieP m "Functions must have a return statement as their last statement."
_ -> dieP m "Functions must have a return statement as their last statement" _ -> dieP m "Functions must have a return statement as their last statement"
_ -> dieP m "Functions must have seq[uential] bodies" _ -> dieP m $ "Functions must have seq[uential] bodies, found instead: "
++ showConstr (toConstr body)
checkFunction' s = return s checkFunction' s = return s
skipSpecs :: A.Structured A.Process -> A.Structured A.Process
skipSpecs (A.Spec _ _ inner) = skipSpecs inner
skipSpecs s = s
-- | Pulls up the list expression into a variable. -- | Pulls up the list expression into a variable.
-- This is done no matter how simple the expression is; when we reach the -- This is done no matter how simple the expression is; when we reach the
-- backend we need it to be a variable so we can use begin() and end() (in -- backend we need it to be a variable so we can use begin() and end() (in