-
Notifications
You must be signed in to change notification settings - Fork 0
/
errors.ml
70 lines (64 loc) · 3.56 KB
/
errors.ml
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
open Printf
open Exprs
open Pretty
(* TODO: Define any additional exceptions you want *)
exception ParseError of string (* parse-error message *)
exception UnboundId of string * sourcespan (* name, where used *)
exception UnboundFun of string * sourcespan (* name of fun, where used *)
exception ShadowId of string * sourcespan * sourcespan (* name, where used, where defined *)
exception DuplicateId of string * sourcespan * sourcespan (* name, where used, where defined *)
exception DuplicateFun of string * sourcespan * sourcespan (* name, where used, where defined *)
exception Overflow of int64 * sourcespan (* value, where used *)
exception Arity of int * int * sourcespan (* intended arity, actual arity, where called *)
exception NotYetImplemented of string (* TODO: Message to show *)
exception Unsupported of string * sourcespan
exception InternalCompilerError of string (* Major failure: message to show *)
exception LetRecNonFunction of sourcespan bind * sourcespan (* name binding, where defined *)
exception ShouldBeFunction of string * sourcespan (* name, where defined, actual typ *)
exception DeclArity of string * int * int * sourcespan (* name, num args, num types, where defined *)
exception StringIllegalChar of string * sourcespan (* string, where defined *)
(* Stringifies a list of compilation errors *)
let print_errors (exns : exn list) : string list =
List.map (fun e ->
match e with
| ParseError msg -> msg
| NotYetImplemented msg ->
"Not yet implemented: " ^ msg
| Unsupported(msg, loc) ->
sprintf "Unsupported: %s at <%s>" msg (string_of_sourcespan loc)
| InternalCompilerError msg ->
"Internal Compiler Error: " ^ msg
| UnboundId(x, loc) ->
sprintf "The identifier %s, used at <%s>, is not in scope" x (string_of_sourcespan loc)
| UnboundFun(x, loc) ->
sprintf "The function name %s, used at <%s>, is not in scope" x (string_of_sourcespan loc)
| ShadowId(x, loc, existing) ->
sprintf "The identifier %s, defined at <%s>, shadows one defined at <%s>"
x (string_of_sourcespan loc) (string_of_sourcespan existing)
| DuplicateId(x, loc, existing) ->
sprintf "The identifier %s, redefined at <%s>, duplicates one at <%s>"
x (string_of_sourcespan loc) (string_of_sourcespan existing)
| DuplicateFun(x, loc, existing) ->
sprintf "The function name %s, redefined at <%s>, duplicates one at <%s>"
x (string_of_sourcespan loc) (string_of_sourcespan existing)
| Overflow(num, loc) ->
sprintf "The number literal %Ld, used at <%s>, is not supported in this language"
num (string_of_sourcespan loc)
| Arity(expected, actual, loc) ->
sprintf "The function called at <%s> expected an arity of %d, but received %d arguments"
(string_of_sourcespan loc) expected actual
| DeclArity(name, num_args, num_types, loc) ->
sprintf "The function %s, defined at %s, has %d arguments but only %d types provided"
name (string_of_sourcespan loc) num_args num_types
| ShouldBeFunction(name, loc) ->
sprintf "The function %s, at %s, should be function" name (string_of_sourcespan loc)
| LetRecNonFunction(bind, loc) ->
sprintf "Binding error at %s: Let-rec expected a name binding to a lambda; got %s"
(string_of_sourcespan loc) (string_of_bind bind)
| StringIllegalChar(str, loc) ->
sprintf "String %s at %s contains at least one illegal character. "
str (string_of_sourcespan loc)
| _ ->
sprintf "%s" (Printexc.to_string e)
) exns
;;