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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2685 - (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 : jhr 2685 val parseError : (AntlrRepair.add_or_delete -> 'tok -> string)
35 : jhr 26 -> 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 : jhr 2685 val addToksToStr = (String.concatWith " ") o (List.map (tok2str AntlrRepair.ADD))
108 :     val delToksToStr = (String.concatWith " ") o (List.map (tok2str AntlrRepair.DEL))
109 : jhr 26 val msg = (case repair
110 : jhr 2685 of Repair.Insert toks => ["syntax error; try inserting \"", addToksToStr toks, "\""]
111 :     | Repair.Delete toks => ["syntax error; try deleting \"", delToksToStr toks, "\""]
112 : jhr 26 | Repair.Subst{old, new} => [
113 : jhr 2685 "syntax error; try substituting \"", addToksToStr new, "\" for \"",
114 :     delToksToStr old, "\""
115 : jhr 26 ]
116 : jhr 2685 | Repair.FailureAt tok => ["syntax error at ", tok2str AntlrRepair.DEL tok]
117 : jhr 26 (* end case *))
118 :     in
119 :     addErr (es, SOME(pos, pos), String.concat msg)
120 :     end
121 :    
122 :     (* add error messages to the error stream *)
123 :     fun error (es, msg) = addErr (es, NONE, String.concat msg)
124 :     fun errorAt (es, span, msg) = addErr (es, SOME span, String.concat msg)
125 :    
126 :     (* add warning messages to the error stream *)
127 :     fun warning (es, msg) = addWarn (es, NONE, String.concat msg)
128 :     fun warningAt (es, span, msg) = addWarn (es, SOME span, String.concat msg)
129 :    
130 :     (* sort a list of errors by position in the source file *)
131 :     val sort = let
132 :     fun lt (NONE, NONE) = false
133 :     | lt (NONE, _) = true
134 :     | lt (_, NONE) = false
135 :     | lt (SOME(l1, r1), SOME(l2, r2)) = (case Position.compare(l1, l2)
136 :     of LESS => true
137 :     | EQUAL => (Position.compare(r1, r2) = LESS)
138 :     | GREATER => false
139 :     (* end case *))
140 :     fun cmp (e1 : error, e2 : error) = lt(#pos e1, #pos e2)
141 :     in
142 :     ListMergeSort.sort cmp
143 :     end
144 :    
145 :     (* source-code locations *)
146 :     datatype location
147 :     = UNKNOWN
148 :     | LOC of {file : string, l1 : int, c1 : int, l2 : int, c2 : int}
149 :    
150 :     fun location (ES{sm, ...}, (p1, p2) : span) =
151 :     if (p1 = p2)
152 :     then let
153 :     val {fileName=SOME f, lineNo, colNo} = SP.sourceLoc sm p1
154 :     in
155 :     LOC{file=f, l1=lineNo, c1=colNo, l2=lineNo, c2=colNo}
156 :     end
157 :     else let
158 :     val {fileName=SOME f1, lineNo=l1, colNo=c1} = SP.sourceLoc sm p1
159 :     val {fileName=SOME f2, lineNo=l2, colNo=c2} = SP.sourceLoc sm p2
160 :     in
161 :     if (f1 <> f2)
162 :     then LOC{file=f1, l1=l1, c1=c1, l2=l1, c2=c1}
163 :     else LOC{file=f1, l1=l1, c1=c1, l2=l2, c2=c2}
164 :     end
165 :    
166 :     fun position (ES{sm, ...}, p : pos) = let
167 :     val {fileName=SOME f, lineNo, colNo} = SP.sourceLoc sm p
168 :     in
169 :     LOC{file=f, l1=lineNo, c1=colNo, l2=lineNo, c2=colNo}
170 :     end
171 :    
172 :     fun locToString UNKNOWN = "<unknown>"
173 :     | locToString (LOC{file, l1, l2, c1, c2}) =
174 :     if (l1 = l2)
175 :     then if (c1 = c2)
176 :     then F.format "[%s:%d.%d] " [F.STR file, F.INT l1, F.INT c1]
177 :     else F.format "[%s:%d.%d-%d] " [F.STR file, F.INT l1, F.INT c1, F.INT c2]
178 :     else F.format "[%s:%d.%d-%d.%d] " [
179 :     F.STR file, F.INT l1, F.INT c1, F.INT l2, F.INT c2
180 :     ]
181 :    
182 : jhr 1140 fun printError (outStrm, ES{srcFile, sm, ...}) = let
183 : jhr 26 fun pr {kind, pos, msg} = let
184 :     val kind = (case kind of ERR => "Error" | Warn => "Warning")
185 :     val pos = (case pos
186 : jhr 1140 of NONE => concat["[", srcFile, "] "]
187 :     | SOME(p1, p2) => if (p1 = p2)
188 : jhr 26 then let
189 :     val {fileName=SOME f, lineNo, colNo} = SP.sourceLoc sm p1
190 :     in
191 :     F.format "[%s:%d.%d] " [
192 :     F.STR f, F.INT lineNo, F.INT colNo
193 :     ]
194 :     end
195 :     else let
196 :     val {fileName=SOME f1, lineNo=l1, colNo=c1} = SP.sourceLoc sm p1
197 :     val {fileName=SOME f2, lineNo=l2, colNo=c2} = SP.sourceLoc sm p2
198 :     in
199 :     if (f1 <> f2)
200 :     then F.format "[%s:%d.%d-%s:%d.%d] " [
201 :     F.STR f1, F.INT l1, F.INT c1,
202 :     F.STR f2, F.INT l2, F.INT c2
203 :     ]
204 :     else if (l1 <> l2)
205 :     then F.format "[%s:%d.%d-%d.%d] " [
206 :     F.STR f1, F.INT l1, F.INT c1,
207 :     F.INT l2, F.INT c2
208 :     ]
209 :     else F.format "[%s:%d.%d-%d] " [
210 :     F.STR f1, F.INT l1, F.INT c1, F.INT c2
211 :     ]
212 :     end
213 :     (* end case *))
214 :     in
215 :     TextIO.output (outStrm, String.concat [pos, kind, ": ", msg, "\n"])
216 :     end
217 :     in
218 :     pr
219 :     end
220 :    
221 : jhr 2159 fun report (outStrm, es as ES{errors, ...}) =
222 :     List.app (printError (outStrm, es)) (sort (!errors))
223 : jhr 26
224 :     (* a term marked with a source-map span *)
225 :     type 'a mark = {span : span, tree : 'a}
226 :    
227 :     end

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