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 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