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 3349 - (view) (download)

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

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