Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /trunk/src/compiler/common/error.sml
ViewVC logotype

Annotation of /trunk/src/compiler/common/error.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 26 - (view) (download)
Original Path: trunk/src/common/error.sml

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

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