aboutsummaryrefslogtreecommitdiff
path: root/Sil/Error.icl
blob: a58dd9370b7dd121a6a6242fa41308ea0549750a (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
implementation module Sil.Error

import StdFile
import StdInt
import StdString

import Text

import Sil.Syntax
import Sil.Types
import Sil.Util.Parser

:: ErrorPosition =
	{ ep_line  :: Int
	, ep_token :: Int
	}

instance < ErrorPosition where (<) p1 p2 = p1.ep_token < p2.ep_token

instance toString ErrorPosition
where
	toString ep = ep.ep_line <+ ":\t"

instance toString Error
where
	toString (P_Invalid                     w tk)  = "\tInvalid token '" <+ tk <+ "' while parsing a " <+ w <+ "."
	toString (P_Expected                  p s h)   = p <+ "Expected " <+ s <+ " near '" <+ h <+ "'."
	toString (T_IllegalApplication        p ft et) = p <+ "Cannot apply a " <+ et <+ " to a " <+ ft <+ "."
	toString (T_IllegalField              p f t)   = p <+ "Illegal field '" <+ f <+ "' on type " <+ t <+ "."
	toString (T_TooHighTupleArity         p i)     = p <+ "Too 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                p l)     = p <+ "Type error: local variable '" <+ l <+ "' cannot have type Void."
	toString (Ck_BasicGlobal              p g)     = p <+ "Error: global variable '" <+ g <+ "' cannot have a basic type."
	toString (C_UndefinedName             p n)     = p <+ "Undefined name '" <+ n <+ "'."
	toString (C_UndefinedField            p f)     = p <+ "Undefined field '" <+ f <+ "'."
	toString (C_CouldNotDeduceType          e)     = errpos e <+ "Could not deduce type of '" <+ e <+ "'."
	toString (C_TypeMisMatch                t e u) = errpos e <+ "Type mismatch: expected " <+ t <+ " for '" <+ e <+ "'; had " <+ u <+ "."
	toString (C_BasicInitWithoutValue     p n)     = p <+ "Basic value '" <+ n <+ "' must have an initial value."
	toString (UnknownError                  e)     = "\tUnknown error: " <+ e <+ "."

instance <<< Error where (<<<) f e = f <<< toString e <<< "\r\n"

instance < Error
where
	(<) _                (UnknownError _) = False
	(<) (UnknownError _) _                = True
	(<) e1               e2               = case (getErrorPosition e1, getErrorPosition e2) of
		(?Just p1, ?Just p2) -> p1 < p2
		(_       , ?None   ) -> False
		(?None   , _       ) -> True

getErrorPosition :: Error -> ?ErrorPosition
getErrorPosition (P_Invalid                     w tk)  = ?None
getErrorPosition (P_Expected                  p s h)   = ?Just p
getErrorPosition (T_IllegalApplication        p ft et) = ?Just p
getErrorPosition (T_IllegalField              p f t)   = ?Just p
getErrorPosition (T_TooHighTupleArity         p i)     = ?Just p
getErrorPosition  Ck_NoMainFunction                    = ?None
getErrorPosition (Ck_MainFunctionInvalidType  p t)     = ?Just p
getErrorPosition (Ck_DuplicateFunctionName    p n)     = ?Just p
getErrorPosition (Ck_DuplicateLocalName       p f arg) = ?Just p
getErrorPosition (Ck_ReturnExpressionFromVoid p f)     = ?Just p
getErrorPosition (Ck_NoReturnFromNonVoid      p f)     = ?Just p
getErrorPosition (Ck_LocalVoid                p l)     = ?Just p
getErrorPosition (Ck_BasicGlobal              p g)     = ?Just p
getErrorPosition (C_UndefinedName             p n)     = ?Just p
getErrorPosition (C_UndefinedField            p f)     = ?Just p
getErrorPosition (C_CouldNotDeduceType          e)     = ?Just (errpos e)
getErrorPosition (C_TypeMisMatch                t e u) = ?Just (errpos e)
getErrorPosition (C_BasicInitWithoutValue     p n)     = ?Just p
getErrorPosition (UnknownError                  e)     = ?None

errpos :: a -> ErrorPosition | getPos a
errpos x = {ep_line=p.pp_line, ep_token=p.pp_token}
where p = getPos x