Add positions to Statements

7 files changed, 92 insertions, 82 deletions

diff --git a/Sil/Check.icl b/Sil/Check.icl
index 6179a66..b06824b 100644
--- a/Sil/Check.icl
+++ b/Sil/Check.icl
@@ -57,21 +57,19 @@ checkFunction err f = checkErrors
 where
 	checkReturnAndVoid :: Function -> [Error]
 	checkReturnAndVoid f = case f.f_type of
-		TVoid -> case [st \\ st=:(Return (Just _)) <- allStatements f] of
-			[] -> []
-			_  -> [Ck_ReturnExpressionFromVoid (errpos f) f.f_name]
+		TVoid -> [Ck_ReturnExpressionFromVoid (errpos st) f.f_name \\ st=:(Return _ (Just _)) <- allStatements f]
 		_     -> if (sureToReturn f.f_code) [] [Ck_NoReturnFromNonVoid (errpos f) f.f_name]
 	where
 		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
-				MachineStm _   -> True // Let's assume the user is not stupid
-				_              -> False
+				Return _ _       -> True
+				While _ _ cb`    -> sureToReturn cb`
+				If _ bs (Just e) -> all sureToReturn [e:map snd bs]
+				If _ bs Nothing  -> all (sureToReturn o snd) bs
+				MachineStm _ _   -> True // Let's assume the user is not stupid
+				_                -> False
 
 	checkMainFunctionType :: Function -> [Error]
 	checkMainFunctionType {f_name="main",f_args=[]}
@@ -95,13 +93,13 @@ where
 		underlyingCBs :: CodeBlock -> [CodeBlock]
 		underlyingCBs cb = concatMap findCBs cb.cb_content
 		where
-			findCBs (Declaration _ _) = []
-			findCBs (Application _)   = []
-			findCBs (Return _)        = []
-			findCBs (If bs (Just e))  = [e:map snd bs]
-			findCBs (If bs Nothing)   = map snd bs
-			findCBs (While _ cb)      = [cb]
-			findCBs (MachineStm _)    = []
+			findCBs (Declaration _ _ _) = []
+			findCBs (Application _ _)   = []
+			findCBs (Return _ _)        = []
+			findCBs (If _ bs (Just e))  = [e:map snd bs]
+			findCBs (If _ bs Nothing)   = map snd bs
+			findCBs (While _ _ cb)      = [cb]
+			findCBs (MachineStm _ _)    = []
 
 		checkVoid :: (Type, Name) -> [Error]
 		checkVoid (TVoid, n) = [Ck_LocalVoid f.f_name n]
diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index 6569dd1..6efee77 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -401,7 +401,7 @@ where
 
 instance gen Statement
 where
-	gen st=:(Declaration n e) =
+	gen st=:(Declaration _ n e) =
 		checkTypeName n e >>= \t ->
 		comment (toString st) *>
 		gen e *>
@@ -415,14 +415,14 @@ where
 			({asize=0}, TBool) -> tell ['ABC'.FillB_b 0 i,  'ABC'.Pop_b 1] *> shrinkStack {zero & bsize=1}
 			_                  -> tell ['ABC'.Update_a 0 i, 'ABC'.Pop_a 1] *> shrinkStack {zero & asize=1}
 		updateLoc _ (BAddr i)  =  tell ['ABC'.Update_b 0 i, 'ABC'.Pop_b 1] *> shrinkStack {zero & bsize=1}
-	gen (Application e) =
+	gen (Application _ e) =
 		comment "Application" *>
 		gen e *>
 		getTypeResolver >>= \tr -> case fmap typeSize <$> type tr e of
 			Just (Ok sz)     -> tell ['ABC'.Pop_a sz.asize, 'ABC'.Pop_b sz.bsize] *> shrinkStack sz
 			Just (Error err) -> error err
 			Nothing          -> error $ C_CouldNotDeduceType e
-	gen (Return (Just e)) =
+	gen (Return _ (Just e)) =
 		comment "Return" *>
 		gen e *>
 		gets returnType >>= \rettype ->
@@ -438,13 +438,13 @@ where
 		updateReturnFrame {asize=0,bsize=0} _ = nop
 		updateReturnFrame {bsize=0} (aso, _)  = tell ['ABC'.Update_a 0 (aso-1), 'ABC'.Pop_a 1] // TODO should depend on return type
 		updateReturnFrame _         (_, bso)  = tell ['ABC'.Update_b 0 (bso-1)] // TODO should depend on return type
-	gen (Return Nothing) =
+	gen (Return _ Nothing) =
 		comment "Return" *>
 		cleanup *>
 		tell ['ABC'.Rtn]
-	gen (MachineStm s) =
+	gen (MachineStm _ s) =
 		tell ['ABC'.Raw s]
-	gen (If blocks else) =
+	gen (If _ blocks else) =
 		fresh "ifend" >>= \end ->
 		mapM_ (genifblock end) blocks *>
 		genelse end else
@@ -464,7 +464,7 @@ where
 		genelse :: 'ABC'.Label (Maybe CodeBlock) -> Gen ()
 		genelse end Nothing   = tell ['ABC'.Label end]
 		genelse end (Just cb) = gen cb *> tell ['ABC'.Label end]
-	gen (While cond do) =
+	gen (While _ cond do) =
 		checkType TBool cond *>
 		fresh "while" >>= \loop -> fresh "whileend" >>= \end ->
 		tell [ 'ABC'.Label loop ] *>
diff --git a/Sil/Error.icl b/Sil/Error.icl
index 9253673..36a614b 100644
--- a/Sil/Error.icl
+++ b/Sil/Error.icl
@@ -19,27 +19,27 @@ where
 
 instance toString Error
 where
-	toString (P_Invalid                     w tk)  = "Invalid token '" <+ tk <+ "' while parsing a " <+ w <+ "."
-	toString (P_Expected                    s)     = "Expected " <+ s <+ "."
-	toString (T_IllegalApplication          ft et) = "Cannot apply a " <+ et <+ " to a " <+ ft <+ "."
-	toString (T_IllegalField                f t)   = "Illegal field '" <+ f <+ "' on type " <+ t <+ "."
-	toString (T_TooHighTupleArity           i)     = "Too high tuple arity " <+ i <+ " (maximum is 32)."
-	toString  Ck_NoMainFunction                    = "Error: no main function."
+	toString (P_Invalid                     w tk)  = "\tInvalid token '" <+ tk <+ "' while parsing a " <+ w <+ "."
+	toString (P_Expected                    s)     = "\tExpected " <+ s <+ "."
+	toString (T_IllegalApplication          ft et) = "\tCannot apply a " <+ et <+ " to a " <+ ft <+ "."
+	toString (T_IllegalField                f t)   = "\tIllegal field '" <+ f <+ "' on type " <+ t <+ "."
+	toString (T_TooHighTupleArity           i)     = "\tToo high tuple arity " <+ i <+ " (maximum is 32)."
+	toString  Ck_NoMainFunction                    = "\tError: no main function."
 	toString (Ck_MainFunctionInvalidType  p t)     = p <+ "Error: function 'main' should not have arguments has type " <+ t <+ "."
 	toString (Ck_DuplicateFunctionName    p n)     = p <+ "Error: multiply defined: '" <+ n <+ "'."
 	toString (Ck_DuplicateLocalName       p f arg) = p <+ "Error: multiply defined: '" <+ arg <+ "' in '" <+ f <+ "'."
 	toString (Ck_ReturnExpressionFromVoid p f)     = p <+ "Type error: an expression was returned from void function '" <+ f <+ "'."
 	toString (Ck_NoReturnFromNonVoid      p f)     = p <+ "Type error: no return from non-void function '" <+ f <+ "'."
-	toString (Ck_LocalVoid                  f l)   = "Type error: local variable '" <+ l <+ "' in '" <+ f <+ "' cannot have type Void."
+	toString (Ck_LocalVoid                  f l)   = "\tType error: local variable '" <+ l <+ "' in '" <+ f <+ "' cannot have type Void."
 	toString (Ck_BasicGlobal              p g)     = p <+ "Error: global variable '" <+ g <+ "' cannot have a basic type."
-	toString (C_UndefinedName               n)     = "Undefined name '" <+ n <+ "'."
-	toString (C_UndefinedField              f)     = "Undefined field '" <+ f <+ "'."
-	toString  C_VariableLabel                      = "Variable stored at label."
-	toString  C_FunctionOnStack                    = "Function stored on the stack."
-	toString (C_CouldNotDeduceType          e)     = "Could not deduce type of '" <+ e <+ "'."
-	toString (C_TypeMisMatch                t e u) = "Type mismatch: expected " <+ t <+ " for '" <+ e <+ "'; had " <+ u <+ "."
-	toString (C_BasicInitWithoutValue       n)     = "Basic value '" <+ n <+ "' must have an initial value."
-	toString (UnknownError                  e)     = "Unknown error: " <+ e <+ "."
+	toString (C_UndefinedName               n)     = "\tUndefined name '" <+ n <+ "'."
+	toString (C_UndefinedField              f)     = "\tUndefined field '" <+ f <+ "'."
+	toString  C_VariableLabel                      = "\tVariable stored at label."
+	toString  C_FunctionOnStack                    = "\tFunction stored on the stack."
+	toString (C_CouldNotDeduceType          e)     = "\tCould not deduce type of '" <+ e <+ "'."
+	toString (C_TypeMisMatch                t e u) = "\tType mismatch: expected " <+ t <+ " for '" <+ e <+ "'; had " <+ u <+ "."
+	toString (C_BasicInitWithoutValue       n)     = "\tBasic value '" <+ n <+ "' must have an initial value."
+	toString (UnknownError                  e)     = "\tUnknown error: " <+ e <+ "."
 
 instance <<< Error where <<< f e = f <<< toString e <<< "\r\n"
 
diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 4a345fe..6a3999d 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -175,41 +175,43 @@ where
 
 statement :: Parser Token Statement
 statement =
-	    declaration
-	<|> liftM Application (expression <* item TSemicolon)
-	<|> return
-	<|> if`
-	<|> while
-	<|> machinecode
+	getPosition >>= \pos ->
+	(   declaration pos
+	<|> liftM (Application pos) (expression <* item TSemicolon)
+	<|> return pos
+	<|> if` pos
+	<|> while pos
+	<|> machinecode pos
+	)
 where
-	declaration :: Parser Token Statement
-	declaration = liftM2 Declaration name (item TAssign *> expression <* item TSemicolon)
+	declaration :: ParsePosition -> Parser Token Statement
+	declaration p = liftM2 (Declaration p) name (item TAssign *> expression <* item TSemicolon)
 
-	return :: Parser Token Statement
-	return = liftM Return (item TReturn *> optional expression <* item TSemicolon)
+	return :: ParsePosition -> Parser Token Statement
+	return p = liftM (Return p) (item TReturn *> optional expression <* item TSemicolon)
 
-	machinecode :: Parser Token Statement
-	machinecode = (\(TMachineCode s) -> MachineStm s) <$> satisfy isMachineCode
+	machinecode :: ParsePosition -> Parser Token Statement
+	machinecode p = (\(TMachineCode s) -> MachineStm p s) <$> satisfy isMachineCode
 	where isMachineCode (TMachineCode _) = True; isMachineCode _ = False
 
-	if` :: Parser Token Statement
-	if` = item TIf *>
+	if` :: ParsePosition -> Parser Token Statement
+	if` p = item TIf *>
 		parenthised expression >>= \cond ->
 		braced codeblock >>= \iftrue ->
 		many elseif >>= \elseifs ->
 		optional (item TElse *> braced codeblock) >>= \iffalse ->
-		pure $ If [(cond,iftrue):elseifs] iffalse
+		pure $ If p [(cond,iftrue):elseifs] iffalse
 	where
 		elseif = list [TElse, TIf] *>
 			parenthised expression >>= \cond ->
 			braced codeblock >>= \block ->
 			pure (cond, block)
 
-	while :: Parser Token Statement
-	while = item TWhile *>
+	while :: ParsePosition -> Parser Token Statement
+	while p = item TWhile *>
 		parenthised expression >>= \cond ->
 		braced codeblock >>= \do ->
-		pure $ While cond do
+		pure $ While p cond do
 
 expression :: Parser Token Expression
 expression
diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl
index b298c19..4f0ddf9 100644
--- a/Sil/Syntax.dcl
+++ b/Sil/Syntax.dcl
@@ -38,12 +38,12 @@ from Sil.Util.Parser import :: ParsePosition, class getPos
 	}
 
 :: Statement
-	= Declaration Name Expression
-	| Application Expression
-	| Return (Maybe Expression)
-	| If [(Expression, CodeBlock)] (Maybe CodeBlock)
-	| While Expression CodeBlock
-	| MachineStm String
+	= Declaration ParsePosition Name Expression
+	| Application ParsePosition Expression
+	| Return      ParsePosition (Maybe Expression)
+	| If          ParsePosition [(Expression, CodeBlock)] (Maybe CodeBlock)
+	| While       ParsePosition Expression CodeBlock
+	| MachineStm  ParsePosition String
 
 :: Expression
 	= Name Name
@@ -90,6 +90,7 @@ instance toString Literal
 
 instance getPos Function
 instance getPos Initialisation
+instance getPos Statement
 
 class allStatements a :: a -> [Statement]
 instance allStatements Program
diff --git a/Sil/Syntax.icl b/Sil/Syntax.icl
index 0749dde..e28d616 100644
--- a/Sil/Syntax.icl
+++ b/Sil/Syntax.icl
@@ -15,13 +15,13 @@ import Sil.Util.Printer
 
 instance toString Statement
 where
-	toString (Declaration n a) = n <+ " := " <+ a <+ ";"
-	toString (Application e)   = toString e <+ ";"
-	toString (Return Nothing)  = "return;"
-	toString (Return (Just a)) = "return " <+ a <+ ";"
-	toString (If bs e)         = "if ..."
-	toString (MachineStm s)    = "|~" <+ s
-	toString _                 = "<<unimplemented Statement>>"
+	toString (Declaration _ n a) = n <+ " := " <+ a <+ ";"
+	toString (Application _ e)   = toString e <+ ";"
+	toString (Return _ Nothing)  = "return;"
+	toString (Return _ (Just a)) = "return " <+ a <+ ";"
+	toString (If _ bs e)         = "if ..."
+	toString (MachineStm _ s)    = "|~" <+ s
+	toString _                   = "<<unimplemented Statement>>"
 
 instance toString Arg where toString arg = arg.arg_type <+ " " <+ arg.arg_name
 
@@ -68,6 +68,15 @@ where
 instance getPos Function where getPos f = f.f_pos
 instance getPos Initialisation where getPos i = i.init_pos
 
+instance getPos Statement
+where
+	getPos (Declaration p _ _) = p
+	getPos (Application p _)   = p
+	getPos (Return      p _)   = p
+	getPos (If          p _ _) = p
+	getPos (While       p _ _) = p
+	getPos (MachineStm  p _)   = p
+
 instance allStatements Program
 where allStatements p = concatMap allStatements p.p_funs
 
@@ -79,13 +88,13 @@ 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]
+	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]
 
 instance allCodeBlocks Function where allCodeBlocks f = allCodeBlocks f.f_code
 
@@ -94,10 +103,10 @@ where allCodeBlocks cb = [cb:concatMap allCodeBlocks cb.cb_content]
 
 instance allCodeBlocks Statement
 where
-	allCodeBlocks (If bs Nothing)  = concatMap (allCodeBlocks o snd) bs
-	allCodeBlocks (If bs (Just e)) = [e:concatMap (allCodeBlocks o snd) bs]
-	allCodeBlocks (While _ cb)     = [cb]
-	allCodeBlocks _                = []
+	allCodeBlocks (If _ bs Nothing)  = concatMap (allCodeBlocks o snd) bs
+	allCodeBlocks (If _ bs (Just e)) = [e:concatMap (allCodeBlocks o snd) bs]
+	allCodeBlocks (While _ _ cb)     = [cb]
+	allCodeBlocks _                  = []
 
 instance allLocals Function
 where
diff --git a/Sil/Util/Printer.icl b/Sil/Util/Printer.icl
index bcb3c84..283709d 100644
--- a/Sil/Util/Printer.icl
+++ b/Sil/Util/Printer.icl
@@ -101,14 +101,14 @@ where
 
 instance PrettyPrinter Statement
 where
-	print st (If bs else) = st <+ printersperse " else " (map oneblock bs) <+ else`
+	print st (If _ bs else) = st <+ printersperse " else " (map oneblock bs) <+ else`
 	where
 		st` = incIndent st
 		oneblock (c,b) = "if (" <+ c <+ ") {\r\n" <+ print st` b <+ "\r\n" <+ st <+ "}"
 		else` = case else of
 			Nothing -> ""
 			Just e  -> " else {\r\n" <+ print st` e <+ "\r\n" <+ st <+ "}"
-	print st (While c do) = st <+ "while (" <+ c <+ ") {\r\n" <+
+	print st (While _ c do) = st <+ "while (" <+ c <+ ") {\r\n" <+
 		print (incIndent st) do <+ "\r\n" <+ st <+ "}"
 	print st stm = st <+ stm