Made some more errors positional (#5)

1 files changed, 28 insertions, 28 deletions

diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index 6efee77..6475da7 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -198,12 +198,12 @@ where
 			{asize,bsize=0} -> ((aso + asize, bso), AAddr $ aso + asize)
 			{asize=0,bsize} -> ((aso, bso + bsize), BAddr $ bso + bsize)
 
-findVar :: Name -> Gen Address
-findVar n = gets stackoffsets >>= \(aso, bso) ->
+findVar :: ParsePosition Name -> Gen Address
+findVar p n = gets stackoffsets >>= \(aso, bso) ->
 	gets addresses >>= \addr -> case 'M'.get n addr of
 		Just (AAddr i) -> comment (n <+ " is on AStack at " <+ i <+ ", with aso " <+ aso <+ " so " <+ (aso-i)) $> AAddr (aso - i)
 		Just (BAddr i) -> comment (n <+ " is on BStack at " <+ i <+ ", with bso " <+ bso <+ " so " <+ (bso-i)) $> BAddr (bso - i)
-		Nothing        -> error $ C_UndefinedName n
+		Nothing        -> error $ C_UndefinedName (errpos p) n
 
 addFunction :: Function -> Gen ()
 addFunction f = modify (\cs -> {cs & symbols='M'.put f.f_name fs cs.symbols})
@@ -239,8 +239,8 @@ getType e = getTypeResolver >>= \tr -> case type tr e of
 checkType :: Type Expression -> Gen ()
 checkType t e = getType e >>= \t` -> if (t == t`) nop (error $ C_TypeMisMatch t e t`)
 
-checkTypeName :: Name Expression -> Gen Type
-checkTypeName n e = getType (Name n) >>= \t` -> checkType t` e $> t`
+checkTypeName :: ParsePosition Name Expression -> Gen Type
+checkTypeName pp n e = getType (Name pp n) >>= \t` -> checkType t` e $> t`
 
 tellAbort :: String -> Gen ()
 tellAbort s = tell
@@ -396,16 +396,16 @@ where
 			Nothing -> tell $ repeatn s.asize 'ABC'.Create
 			Just v  -> shrinkStack s *> gen v
 		s=:{asize=0} -> case init.init_value of
-			Nothing -> error $ C_BasicInitWithoutValue init.init_name
+			Nothing -> error $ C_BasicInitWithoutValue (errpos init) init.init_name
 			Just v  -> checkType init.init_type v *> shrinkStack s *> gen v
 
 instance gen Statement
 where
-	gen st=:(Declaration _ n e) =
-		checkTypeName n e >>= \t ->
+	gen st=:(Declaration pp n e) =
+		checkTypeName pp n e >>= \t ->
 		comment (toString st) *>
 		gen e *>
-		findVar n >>=
+		findVar pp n >>=
 		updateLoc t
 	where
 		updateLoc :: Type Address -> Gen ()
@@ -477,18 +477,18 @@ where
 
 instance gen Expression
 where
-	gen (Name n) = findVar n >>= getLoc
+	gen (Name p n) = findVar p n >>= getLoc
 	where
 		getLoc :: Address -> Gen ()
 		getLoc (AAddr i) = tell ['ABC'.Push_a $ i] *> growStack {zero & asize=1}
 		getLoc (BAddr i) = tell ['ABC'.Push_b $ i] *> growStack {zero & bsize=1,btypes=['ABC'.BT_Int]} //TODO check type
-	gen (Literal (BLit b)) =
+	gen (Literal _ (BLit b)) =
 		tell ['ABC'.PushB b] *>
 		growStack {zero & bsize=1,btypes=['ABC'.BT_Bool]}
-	gen (Literal (ILit i)) =
+	gen (Literal _ (ILit i)) =
 		tell ['ABC'.PushI i] *>
 		growStack {zero & bsize=1,btypes=['ABC'.BT_Int]}
-	gen (App n args) = gets addresses >>= \addrs -> case 'M'.get n addrs of
+	gen (App p n args) = gets addresses >>= \addrs -> case 'M'.get n addrs of
 		Just i -> error C_FunctionOnStack
 		_      -> gets symbols >>= \syms -> case 'M'.get n syms of
 			Just fs ->
@@ -500,11 +500,11 @@ where
 				     , 'ABC'.Annotation $ toOAnnot $ typeSize fs.fs_rettype
 				     ] *>
 				growStack (foldl (-~) (typeSize fs.fs_rettype) $ map typeSize fs.fs_argtypes)
-			_ -> error $ C_UndefinedName n
-	gen (BuiltinApp op arg) =
+			_ -> error $ C_UndefinedName (errpos p) n
+	gen (BuiltinApp _ op arg) =
 		gen arg *>
 		gen op
-	gen (BuiltinApp2 e1 LogOr e2) =
+	gen (BuiltinApp2 _ e1 LogOr e2) =
 		checkType TBool e1 *>
 		checkType TBool e2 *>
 		fresh "or_true" >>= \true ->
@@ -520,7 +520,7 @@ where
 		     , 'ABC'.PushB True ] *>
 		growStack {zero & bsize=1} *>
 		tell [ 'ABC'.Label end ]
-	gen (BuiltinApp2 e1 LogAnd e2) =
+	gen (BuiltinApp2 _ e1 LogAnd e2) =
 		checkType TBool e1 *>
 		checkType TBool e2 *>
 		fresh "and_false" >>= \false ->
@@ -536,24 +536,24 @@ where
 		     , 'ABC'.PushB False ] *>
 		growStack {zero & bsize=1} *>
 		tell [ 'ABC'.Label end ]
-	gen (BuiltinApp2 e1 Cons e2) =
+	gen (BuiltinApp2 _ e1 Cons e2) =
 		genToAStack e2 *>
 		genToAStack e1 *>
 		tell [ 'ABC'.Raw "\tbuildh\t_Cons\t2" ] *>
 		shrinkStack {zero & asize=1}
-	gen (BuiltinApp2 e1 op e2) =
+	gen (BuiltinApp2 _ e1 op e2) =
 		mapM gen [e2,e1] *>
 		gen op
-	gen (Tuple i es) =
+	gen (Tuple _ i es) =
 		comment "Building tuple" *>
 		mapM genToAStack (reverse es) *>
 		tell [ 'ABC'.Raw $ "\tbuildh\t_Tuple\t" <+ i ] *>
 		shrinkStack {zero & asize=i-1}
-	gen (List _ []) = tell ['ABC'.Raw "\tbuildh\t_Nil\t0"] *> growStack {zero & asize=1}
-	gen (List t [e:es]) =
+	gen (List _ _ []) = tell ['ABC'.Raw "\tbuildh\t_Nil\t0"] *> growStack {zero & asize=1}
+	gen (List pp t [e:es]) =
 		getType e >>= \te ->
-		gen (BuiltinApp2 e Cons (List (t <|> pure te) es))
-	gen e=:(Field f e`)
+		gen (BuiltinApp2 pp e Cons (List pp (t <|> pure te) es))
+	gen e=:(Field _ f e`)
 	| isTuple =
 		getType e` >>= \t=:(TTuple arity tes) ->
 		gen e` *>
@@ -561,7 +561,7 @@ where
 		     , 'ABC'.Pop_a (tupleEl - 1)
 		     , 'ABC'.Update_a 0 (arity - tupleEl)
 		     , 'ABC'.Pop_a (arity - tupleEl) ] *>
-		if (0 >= tupleEl || tupleEl > arity) (error $ T_IllegalField f t) nop *>
+		if (0 >= tupleEl || tupleEl > arity) (error $ T_IllegalField (errpos e) f t) nop *>
 		case typeSize $ tes!!(tupleEl - 1) of
 			{bsize=0} -> nop
 			{btypes} -> mapM (flip toBStack 1) btypes *> nop
@@ -594,7 +594,7 @@ where
 		     , 'ABC'.Pop_a 1 ] *>
 		growStack {asize=(-1), bsize=1, btypes=['ABC'.BT_Bool]}
 	| otherwise =
-		error $ C_UndefinedField f
+		error $ C_UndefinedField (errpos e) f
 	where
 		f` = fromString f
 
@@ -655,9 +655,9 @@ where
 		'ABC'.BT_Int  -> 'ABC'.FillI_b
 
 genToAStack :: Expression -> Gen ()
-genToAStack (Literal (BLit b)) = tell [ 'ABC'.Raw $ "\tbuildB\t" <+ toABCBool b ] *> growStack {zero & asize=1}
+genToAStack (Literal _ (BLit b)) = tell [ 'ABC'.Raw $ "\tbuildB\t" <+ toABCBool b ] *> growStack {zero & asize=1}
 where toABCBool = toString o map toUpper o fromString o toString
-genToAStack (Literal (ILit i)) = tell [ 'ABC'.Raw $ "\tbuildI\t" <+ i ] *> growStack {zero & asize=1}
+genToAStack (Literal _ (ILit i)) = tell [ 'ABC'.Raw $ "\tbuildI\t" <+ i ] *> growStack {zero & asize=1}
 genToAStack e = getType e >>= \t -> case typeSize t of
 	{bsize=0} -> gen e
 	{btypes}  -> gen e <* comment "To A-stack" <* mapM BtoAStack btypes <* comment "Done to A-stack"