Annotation of /branches/vis12/src/compiler/common/error.sml

Parent Directory | Revision Log

---

Revision 2159 - (view) (download)

1 :	jhr	26	(* error.sml
2 :			*
3 :	jhr	435	* COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :	jhr	26	* All rights reserved.
5 :			*
6 :	jhr	1640	* Common infrastructure for error reporting in the Manticore compiler.
7 :	jhr	26	*)
8 :
9 :			structure Error :> sig
10 :
11 :			(* logical positions in the input stream *)
12 :			type pos = AntlrStreamPos.pos
13 :			type span = AntlrStreamPos.span
14 :
15 :			type err_stream
16 :
17 :			(* make an error stream. *)
18 :			val mkErrStream : string -> err_stream
19 :
20 :			val anyErrors : err_stream -> bool
21 :	jhr	2157	val anyWarnings : err_stream -> bool
22 :	jhr	26	val sourceFile : err_stream -> string
23 :			val sourceMap : err_stream -> AntlrStreamPos.sourcemap
24 :
25 :			(* add error messages to the error stream *)
26 :			val error : err_stream * string list -> unit
27 :			val errorAt : err_stream * span * string list -> unit
28 :
29 :			(* add warning messages to the error stream *)
30 :			val warning : err_stream * string list -> unit
31 :			val warningAt : err_stream * span * string list -> unit
32 :
33 :			(* add an ml-antlr parse error to the error stream *)
34 :			val parseError : ('tok -> string)
35 :			-> err_stream
36 :			-> (pos * 'tok AntlrRepair.repair_action)
37 :			-> unit
38 :
39 :			(* print the errors to an output stream *)
40 :			val report : TextIO.outstream * err_stream -> unit
41 :
42 :			(* source-code locations *)
43 :			datatype location
44 :			= UNKNOWN
45 :			| LOC of {file : string, l1 : int, c1 : int, l2 : int, c2 : int}
46 :
47 :			val location : err_stream * span -> location
48 :			val position : err_stream * pos -> location
49 :
50 :			val locToString : location -> string
51 :
52 :			(* a term marked with a source-map span *)
53 :			type 'a mark = {span : span, tree : 'a}
54 :
55 :			end = struct
56 :
57 :			structure SP = AntlrStreamPos
58 :			structure Repair = AntlrRepair
59 :			structure F = Format
60 :
61 :			type pos = SP.pos
62 :			type span = SP.span
63 :
64 :			datatype severity = WARN | ERR
65 :
66 :			type error = {
67 :			kind : severity,
68 :			pos : span option,
69 :			msg : string
70 :			}
71 :
72 :			(* an error stream collects the errors and warnings generated for
73 :			* a compilation unit.
74 :			*)
75 :			datatype err_stream = ES of {
76 :			srcFile : string,
77 :			sm : SP.sourcemap, (* the source map for mapping positions to *)
78 :			(* source-file positions *)
79 :			errors : error list ref,
80 :			numErrors : int ref,
81 :			numWarnings : int ref
82 :			}
83 :
84 :			(* make an error stream. *)
85 :			fun mkErrStream filename = ES{
86 :			srcFile = filename,
87 :			sm = SP.mkSourcemap' filename,
88 :			errors = ref [],
89 :			numErrors = ref 0,
90 :			numWarnings = ref 0
91 :			}
92 :
93 :			fun anyErrors (ES{numErrors, ...}) = (!numErrors > 0)
94 :	jhr	2157	fun anyWarnings (ES{numWarnings, ...}) = (!numWarnings > 0)
95 :	jhr	26	fun sourceFile (ES{srcFile, ...}) = srcFile
96 :			fun sourceMap (ES{sm, ...}) = sm
97 :
98 :			fun addErr (ES{errors, numErrors, ...}, pos, msg) = (
99 :			numErrors := !numErrors + 1;
100 :			errors := {kind=ERR, pos=pos, msg=msg} :: !errors)
101 :
102 :			fun addWarn (ES{errors, numWarnings, ...}, pos, msg) = (
103 :			numWarnings := !numWarnings + 1;
104 :			errors := {kind=WARN, pos=pos, msg=msg} :: !errors)
105 :
106 :			fun parseError tok2str es (pos, repair) = let
107 :			val toksToStr = (String.concatWith " ") o (List.map tok2str)
108 :			val msg = (case repair
109 :			of Repair.Insert toks => ["syntax error; try inserting \"", toksToStr toks, "\""]
110 :			| Repair.Delete toks => ["syntax error; try deleting \"", toksToStr toks, "\""]
111 :			| Repair.Subst{old, new} => [
112 :			"syntax error; try substituting \"", toksToStr new, "\" for \"",
113 :			toksToStr old, "\""
114 :			]
115 :			| Repair.FailureAt tok => ["syntax error at ", tok2str tok]
116 :			(* end case *))
117 :			in
118 :			addErr (es, SOME(pos, pos), String.concat msg)
119 :			end
120 :
121 :			(* add error messages to the error stream *)
122 :			fun error (es, msg) = addErr (es, NONE, String.concat msg)
123 :			fun errorAt (es, span, msg) = addErr (es, SOME span, String.concat msg)
124 :
125 :			(* add warning messages to the error stream *)
126 :			fun warning (es, msg) = addWarn (es, NONE, String.concat msg)
127 :			fun warningAt (es, span, msg) = addWarn (es, SOME span, String.concat msg)
128 :
129 :			(* sort a list of errors by position in the source file *)
130 :			val sort = let
131 :			fun lt (NONE, NONE) = false
132 :			| lt (NONE, _) = true
133 :			| lt (_, NONE) = false
134 :			| lt (SOME(l1, r1), SOME(l2, r2)) = (case Position.compare(l1, l2)
135 :			of LESS => true
136 :			| EQUAL => (Position.compare(r1, r2) = LESS)
137 :			| GREATER => false
138 :			(* end case *))
139 :			fun cmp (e1 : error, e2 : error) = lt(#pos e1, #pos e2)
140 :			in
141 :			ListMergeSort.sort cmp
142 :			end
143 :
144 :			(* source-code locations *)
145 :			datatype location
146 :			= UNKNOWN
147 :			| LOC of {file : string, l1 : int, c1 : int, l2 : int, c2 : int}
148 :
149 :			fun location (ES{sm, ...}, (p1, p2) : span) =
150 :			if (p1 = p2)
151 :			then let
152 :			val {fileName=SOME f, lineNo, colNo} = SP.sourceLoc sm p1
153 :			in
154 :			LOC{file=f, l1=lineNo, c1=colNo, l2=lineNo, c2=colNo}
155 :			end
156 :			else let
157 :			val {fileName=SOME f1, lineNo=l1, colNo=c1} = SP.sourceLoc sm p1
158 :			val {fileName=SOME f2, lineNo=l2, colNo=c2} = SP.sourceLoc sm p2
159 :			in
160 :			if (f1 <> f2)
161 :			then LOC{file=f1, l1=l1, c1=c1, l2=l1, c2=c1}
162 :			else LOC{file=f1, l1=l1, c1=c1, l2=l2, c2=c2}
163 :			end
164 :
165 :			fun position (ES{sm, ...}, p : pos) = let
166 :			val {fileName=SOME f, lineNo, colNo} = SP.sourceLoc sm p
167 :			in
168 :			LOC{file=f, l1=lineNo, c1=colNo, l2=lineNo, c2=colNo}
169 :			end
170 :
171 :			fun locToString UNKNOWN = "<unknown>"
172 :			| locToString (LOC{file, l1, l2, c1, c2}) =
173 :			if (l1 = l2)
174 :			then if (c1 = c2)
175 :			then F.format "[%s:%d.%d] " [F.STR file, F.INT l1, F.INT c1]
176 :			else F.format "[%s:%d.%d-%d] " [F.STR file, F.INT l1, F.INT c1, F.INT c2]
177 :			else F.format "[%s:%d.%d-%d.%d] " [
178 :			F.STR file, F.INT l1, F.INT c1, F.INT l2, F.INT c2
179 :			]
180 :
181 :	jhr	1140	fun printError (outStrm, ES{srcFile, sm, ...}) = let
182 :	jhr	26	fun pr {kind, pos, msg} = let
183 :			val kind = (case kind of ERR => "Error" | Warn => "Warning")
184 :			val pos = (case pos
185 :	jhr	1140	of NONE => concat["[", srcFile, "] "]
186 :			| SOME(p1, p2) => if (p1 = p2)
187 :	jhr	26	then let
188 :			val {fileName=SOME f, lineNo, colNo} = SP.sourceLoc sm p1
189 :			in
190 :			F.format "[%s:%d.%d] " [
191 :			F.STR f, F.INT lineNo, F.INT colNo
192 :			]
193 :			end
194 :			else let
195 :			val {fileName=SOME f1, lineNo=l1, colNo=c1} = SP.sourceLoc sm p1
196 :			val {fileName=SOME f2, lineNo=l2, colNo=c2} = SP.sourceLoc sm p2
197 :			in
198 :			if (f1 <> f2)
199 :			then F.format "[%s:%d.%d-%s:%d.%d] " [
200 :			F.STR f1, F.INT l1, F.INT c1,
201 :			F.STR f2, F.INT l2, F.INT c2
202 :			]
203 :			else if (l1 <> l2)
204 :			then F.format "[%s:%d.%d-%d.%d] " [
205 :			F.STR f1, F.INT l1, F.INT c1,
206 :			F.INT l2, F.INT c2
207 :			]
208 :			else F.format "[%s:%d.%d-%d] " [
209 :			F.STR f1, F.INT l1, F.INT c1, F.INT c2
210 :			]
211 :			end
212 :			(* end case *))
213 :			in
214 :			TextIO.output (outStrm, String.concat [pos, kind, ": ", msg, "\n"])
215 :			end
216 :			in
217 :			pr
218 :			end
219 :
220 :	jhr	2159	fun report (outStrm, es as ES{errors, ...}) =
221 :			List.app (printError (outStrm, es)) (sort (!errors))
222 :	jhr	26
223 :			(* a term marked with a source-map span *)
224 :			type 'a mark = {span : span, tree : 'a}
225 :
226 :			end

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0