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

SCM Repository

[diderot] Annotation of /branches/pure-cfg/src/compiler/common/error.sml
ViewVC logotype

Annotation of /branches/pure-cfg/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 :     * Common infrastructure for error reporting in the Manticore compiler.
9 :     *)
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 :     val sourceFile : err_stream -> string
24 :     val sourceMap : err_stream -> AntlrStreamPos.sourcemap
25 :    
26 :     (* add error messages to the error stream *)
27 :     val error : err_stream * string list -> unit
28 :     val errorAt : err_stream * span * string list -> unit
29 :    
30 :     (* add warning messages to the error stream *)
31 :     val warning : err_stream * string list -> unit
32 :     val warningAt : err_stream * span * string list -> unit
33 :    
34 :     (* add an ml-antlr parse error to the error stream *)
35 :     val parseError : ('tok -> string)
36 :     -> err_stream
37 :     -> (pos * 'tok AntlrRepair.repair_action)
38 :     -> unit
39 :    
40 :     (* print the errors to an output stream *)
41 :     val report : TextIO.outstream * err_stream -> unit
42 :    
43 :     (* source-code locations *)
44 :     datatype location
45 :     = UNKNOWN
46 :     | LOC of {file : string, l1 : int, c1 : int, l2 : int, c2 : int}
47 :    
48 :     val location : err_stream * span -> location
49 :     val position : err_stream * pos -> location
50 :    
51 :     val locToString : location -> string
52 :    
53 :     (* a term marked with a source-map span *)
54 :     type 'a mark = {span : span, tree : 'a}
55 :    
56 :     end = struct
57 :    
58 :     structure SP = AntlrStreamPos
59 :     structure Repair = AntlrRepair
60 :     structure F = Format
61 :    
62 :     type pos = SP.pos
63 :     type span = SP.span
64 :    
65 :     datatype severity = WARN | ERR
66 :    
67 :     type error = {
68 :     kind : severity,
69 :     pos : span option,
70 :     msg : string
71 :     }
72 :    
73 :     (* an error stream collects the errors and warnings generated for
74 :     * a compilation unit.
75 :     *)
76 :     datatype err_stream = ES of {
77 :     srcFile : string,
78 :     sm : SP.sourcemap, (* the source map for mapping positions to *)
79 :     (* source-file positions *)
80 :     errors : error list ref,
81 :     numErrors : int ref,
82 :     numWarnings : int ref
83 :     }
84 :    
85 :     (* make an error stream. *)
86 :     fun mkErrStream filename = ES{
87 :     srcFile = filename,
88 :     sm = SP.mkSourcemap' filename,
89 :     errors = ref [],
90 :     numErrors = ref 0,
91 :     numWarnings = ref 0
92 :     }
93 :    
94 :     fun anyErrors (ES{numErrors, ...}) = (!numErrors > 0)
95 :     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 1138 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 1138 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 :     fun report (outStrm, es as ES{errors, ...}) =
221 :     List.app (printError (outStrm, es)) (sort (!errors))
222 :    
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