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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
module Make (M : sig
module Types : sig
type type_expression
end
module Pp : sig
val fprintf_literal : Format.formatter -> Lang.literal -> unit
val fprintf_expr : Format.formatter -> Lang.expr -> unit
val fprintf_type : Format.formatter -> Types.type_expression -> unit
end
end) =
struct
exception Apply_anon_const
exception Const_rebind of Lang.var_id
exception Duplication of Lang.expr
exception Inline_lack of Lang.var_id
exception Internal_error of string
exception Known_value of Lang.expr
exception Recursive_type of M.Types.type_expression
exception Scope_too_large of Lang.var_id
exception Sugar_lack_args of Lang.var_id * Lang.var_id list
exception Unbound_variable of Lang.var_id
exception Unbound_literal of Lang.literal
exception Unused_variable of Lang.var_id
exception Useless_if of Lang.expr
exception Useless_if_cond of Lang.expr
exception Useless_if_expr of Lang.expr
exception Useless_match of Lang.expr
exception Useless_match_expr of Lang.expr
exception Useless_match_cond of Lang.expr
exception Useless_match_onecase of Lang.expr
exception Wrong_application of Lang.expr * M.Types.type_expression
exception
Wrong_type of Lang.expr * M.Types.type_expression * M.Types.type_expression
let args_to_string = List.fold_left (fun acc el -> el ^ " " ^ acc) ""
let args_anon_to_string =
List.fold_left (fun acc el -> "fun " ^ el ^ " -> " ^ acc) "..."
let fprintf fmt = function
| Apply_anon_const ->
Format.fprintf fmt
"you're applying an anonymous function, it's useless, inline the arg \
and remove that function"
| Const_rebind x ->
Format.fprintf fmt "variable %s is useless, please inline it" x
| Duplication e ->
Format.fprintf fmt
"expression `%a` is duplicated in your program, please factor it"
M.Pp.fprintf_expr e
| Inline_lack x ->
Format.fprintf fmt "variable %s is used only once, please inline it" x
| Internal_error s ->
Format.fprintf fmt "%s" s
| Known_value e ->
Format.fprintf fmt "known value for expr `%a`" M.Pp.fprintf_expr e
| Complice.Cli.Empty_filename ->
Format.fprintf fmt "file name shouldn't be empty"
| Complice.Lexer.Error s
| Complice.Parse.Error s
| Complice.Cli.File_is_dir s
| Complice.Cli.Invalid_filename s
| Complice.Cli.Missing_file s
| Complice.Cli.Usage s ->
Format.fprintf fmt "%s" s
| Recursive_type t ->
Format.fprintf fmt
"type %a is recursive, stop doing this please... ( \
https://youtu.be/mqA2evDu4Mw )"
M.Pp.fprintf_type t
| Scope_too_large x ->
Format.fprintf fmt "the scope of the variable %s can be reduced" x
| Sugar_lack_args (f, x) ->
Format.fprintf fmt
"please use more sugar: you should write `let %s %s= ... in ...` \
instead of `let %s = %s in ...`"
f (args_to_string x) f (args_anon_to_string x)
| Unbound_variable id ->
Format.fprintf fmt "unbound variable %s" id
| Unbound_literal l ->
Format.fprintf fmt "unbound literal %a" M.Pp.fprintf_literal l
| Unused_variable id ->
Format.fprintf fmt "unused variable %s" id
| Useless_if expr ->
Format.fprintf fmt "useless if, it is equivalent to the condition: `%a`"
M.Pp.fprintf_expr expr
| Useless_if_cond cond ->
Format.fprintf fmt "useless if, the condition is constant: `%a`"
M.Pp.fprintf_expr cond
| Useless_if_expr expr ->
Format.fprintf fmt "useless if, the two branches are the same: `%a`"
M.Pp.fprintf_expr expr
| Useless_match expr ->
Format.fprintf fmt
"useless match, it is equivalent to the matched expression: `%a`"
M.Pp.fprintf_expr expr
| Useless_match_cond cond ->
Format.fprintf fmt
"useless match, the matched expression is constant: `%a`"
M.Pp.fprintf_expr cond
| Useless_match_expr expr ->
Format.fprintf fmt "useless match, all cases are the same: `%a`"
M.Pp.fprintf_expr expr
| Useless_match_onecase expr ->
Format.fprintf fmt "useless match, it has only one case: `%a`"
M.Pp.fprintf_expr expr
| Wrong_application (e, t) ->
Format.fprintf fmt
"expression `%a` has type %a, it is not a function, it can't be \
applied"
M.Pp.fprintf_expr e M.Pp.fprintf_type t
| Wrong_type (e, t, t') ->
Format.fprintf fmt
"expression `%a` has type %a but an expression of type %a was \
expected"
M.Pp.fprintf_expr e M.Pp.fprintf_type t M.Pp.fprintf_type t'
| e ->
raise e
end