Centralise errors (needed for positional errors #5)

1 files changed, 18 insertions, 29 deletions

diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index 7ef48e4..fdc2bf5 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -23,29 +23,18 @@ from Text import <+
 
 import qualified ABC.Assembler as ABC
 
+import Sil.Error
 import Sil.Syntax
 import Sil.Types
 import Sil.Util.Printer
 
-instance toString CompileError
-where
-	toString (UndefinedName n)         = "Undefined name '" <+ n <+ "'."
-	toString (UndefinedField f)        = "Undefined field '" <+ f <+ "'."
-	toString VariableLabel             = "Variable stored at label."
-	toString FunctionOnStack           = "Function stored on the stack."
-	toString (TypeError err e)         = "Type error in '" <+ e <+ "': " <+ err
-	toString (CouldNotDeduceType e)    = "Could not deduce type of '" <+ e <+ "'."
-	toString (TypeMisMatch t e)        = "Type mismatch: expected " <+ t <+ " for '" <+ e <+ "'."
-	toString (BasicInitWithoutValue n) = "Basic value '" <+ n <+ "' must have an initial value."
-	toString UnknownError              = "Unknown error."
-
-error :: CompileError -> RWST r w s (MaybeError CompileError) a
+error :: Error -> RWST r w s (MaybeError Error) a
 error e = RWST \_ _ -> Error e
 
 nop :: RWST r w s m () | Monoid w & Monad m
 nop = RWST \_ s -> pure ((), s, mempty)
 
-compile :: Program -> MaybeError CompileError 'ABC'.Assembler
+compile :: Program -> MaybeError Error 'ABC'.Assembler
 compile prog = case evalRWST (censor censor` $ gen prog) () zero of
 	Error e  -> Error e
 	Ok (_,p) -> Ok p
@@ -129,7 +118,7 @@ stackoffsets cs = cs.stackoffsets
 typeresolvers :: CompileState -> [TypeResolver]
 typeresolvers cs = cs.typeresolvers
 
-:: Gen a :== RWST () 'ABC'.Assembler CompileState (MaybeError CompileError) a
+:: Gen a :== RWST () 'ABC'.Assembler CompileState (MaybeError Error) a
 
 fresh :: a -> Gen 'ABC'.Label | toString a
 fresh n = gets labels
@@ -187,7 +176,7 @@ findVar 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 $ UndefinedName n
+		Nothing        -> error $ C_UndefinedName n
 
 addFunction :: Function -> Gen ()
 addFunction f = modify (\cs -> {cs & symbols='M'.put f.f_name fs cs.symbols})
@@ -216,12 +205,12 @@ where
 
 getType :: Expression -> Gen Type
 getType e = getTypeResolver >>= \tr -> case type tr e of
-	Nothing          -> error $ CouldNotDeduceType e
-	Just (Error err) -> error $ TypeError err e
+	Nothing          -> error $ C_CouldNotDeduceType e
+	Just (Error err) -> error err
 	Just (Ok t)      -> pure $ t
 
 checkType :: Type Expression -> Gen ()
-checkType t e = getType e >>= \t` -> if (t == t`) nop (error $ TypeMisMatch t e)
+checkType t e = getType e >>= \t` -> if (t == t`) nop (error $ C_TypeMisMatch t e)
 
 checkTypeName :: Name Expression -> Gen Type
 checkTypeName n e = getType (Name n) >>= \t` -> checkType t` e $> t`
@@ -245,7 +234,7 @@ where
 		mapM_ gen p.p_funs *>
 		popTypeResolver
 	where
-		typeresolver :: Name -> Maybe (MaybeError TypeError Type)
+		typeresolver :: Name -> Maybe (MaybeError Error Type)
 		typeresolver n = case [f \\ f <- p.p_funs | f.f_name == n] of
 			[]    -> Nothing
 			[f:_] -> type zero f
@@ -278,7 +267,7 @@ where
 			]
 		retSize = typeSize f.f_type
 
-		typeresolver :: Name -> Maybe (MaybeError TypeError Type)
+		typeresolver :: Name -> Maybe (MaybeError Error Type)
 		typeresolver n = listToMaybe [Ok a.arg_type \\ a <- f.f_args | a.arg_name == n]
 
 		mainBootstrap :: Gen ()
@@ -339,7 +328,7 @@ where
 			      ]
 		locals = foldr (+~) zero [typeSize i.init_type \\ i <- cb.cb_init]
 
-		typeresolver :: Name -> Maybe (MaybeError TypeError Type)
+		typeresolver :: Name -> Maybe (MaybeError Error Type)
 		typeresolver n = listToMaybe [Ok i.init_type \\ i <- cb.cb_init | i.init_name == n]
 
 instance gen Initialisation
@@ -347,7 +336,7 @@ where
 	gen init = case typeSize init.init_type of
 		s=:{bsize=0} -> tell $ repeatn s.asize 'ABC'.Create
 		s=:{asize=0} -> case init.init_value of
-			Nothing -> error $ BasicInitWithoutValue init.init_name
+			Nothing -> error $ C_BasicInitWithoutValue init.init_name
 			Just v  -> checkType init.init_type v *> gen v *> shrinkStack s
 
 instance gen Statement
@@ -371,8 +360,8 @@ where
 		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 $ TypeError err e
-			Nothing          -> error $ CouldNotDeduceType e
+			Just (Error err) -> error err
+			Nothing          -> error $ C_CouldNotDeduceType e
 	gen (Return (Just e)) =
 		comment "Return" *>
 		gen e *>
@@ -440,7 +429,7 @@ where
 		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
-		Just i -> liftT $ Error FunctionOnStack
+		Just i -> error C_FunctionOnStack
 		_      -> gets symbols >>= \syms -> case 'M'.get n syms of
 			Just fs ->
 				comment "Retrieve arguments" *>
@@ -451,7 +440,7 @@ where
 				     , 'ABC'.Annotation $ toOAnnot $ typeSize fs.fs_rettype
 				     ] *>
 				growStack (foldl (-~) (typeSize fs.fs_rettype) $ map typeSize fs.fs_argtypes)
-			_ -> liftT $ Error $ UndefinedName n
+			_ -> error $ C_UndefinedName n
 	gen (BuiltinApp op arg) =
 		gen arg *>
 		gen op
@@ -504,12 +493,12 @@ where
 		     , 'ABC'.Update_a 0 (arity - tupleEl)
 		     , 'ABC'.Pop_a (arity - tupleEl)
 		     ] *>
-		if (0 >= tupleEl || tupleEl > arity) (error $ TypeError (IllegalField f t) e) nop *>
+		if (0 >= tupleEl || tupleEl > arity) (error $ T_IllegalField f t) nop *>
 		case typeSize $ tes!!(tupleEl - 1) of
 			{bsize=0} -> nop
 			{btypes} -> mapM (flip toBStack 1) btypes *> nop
 	| otherwise =
-		error $ UndefinedField f
+		error $ C_UndefinedField f
 	where
 		f` = fromString f