Annotation of /sml/branches/ckit/ckit/src/parser/util/error.sml

Parent Directory | Revision Log

---

Revision 598 - (view) (download)

1 :	dbm	597	(*
2 :			* Copyright (c) 1996 by Satish Chandra, Brad Richards, Mark D. Hill,
3 :			* James R. Larus, and David A. Wood.
4 :			*
5 :			* Teapot is distributed under the following conditions:
6 :			*
7 :			* You may make copies of Teapot for your own use and modify those copies.
8 :			*
9 :			* All copies of Teapot must retain our names and copyright notice.
10 :			*
11 :			* You may not sell Teapot or distributed Teapot in conjunction with a
12 :			* commercial product or service without the expressed written consent of
13 :			* the copyright holders.
14 :			*
15 :			* THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
16 :			* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
17 :			* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
18 :			*
19 :			*)
20 :
21 :			(* error.sml
22 :			*
23 :			* CS703 --- Project --- Spring '94
24 :			*
25 :			* COPYRIGHT (c) 1992 AT&T Bell Laboratories
26 :			*)
27 :
28 :			structure Error : ERROR =
29 :			struct
30 :
31 :			structure F = Format
32 :			structure PP = OldPrettyPrint
33 :			structure SM = SourceMap
34 :
35 :			datatype errorState
36 :			= ES of
37 :			{outStrm : TextIO.outstream,
38 :			numErrors : int ref,
39 :			numWarnings : int ref,
40 :			warningsEnabled : bool ref,
41 :			errorsEnabled : bool ref,
42 :			errorsLimit : int,
43 :			warningsLimit : int}
44 :
45 :			(* global error and warning count limits *)
46 :			val errorsLimit = ref 10 (* flag for suppressing error messages *)
47 :			val warningsLimit = ref 10 (* flag for suppressing warning messages *)
48 :
49 :			(* make an error state. src is the source file name, dst is the
50 :			* output state to report errors on, lnum and lpos are references
51 :			* used to keep track of the current line number and starting
52 :			* character positions of the scanned lines.
53 :			*)
54 :			fun mkErrState (dst: TextIO.outstream) =
55 :			ES {outStrm = dst,
56 :			numErrors = ref 0,
57 :			numWarnings = ref 0,
58 :			warningsEnabled = ref true,
59 :			errorsEnabled = ref true,
60 :			errorsLimit = !errorsLimit,
61 :			warningsLimit = !warningsLimit
62 :			}
63 :
64 :			fun inc (i: int ref) = (i := !i + 1; ())
65 :			fun dec (i: int ref) = (i := !i - 1; ())
66 :
67 :			(* curried version of TextIO.output *)
68 :			fun outputc outstrm strng = TextIO.output(outstrm, strng)
69 :
70 :			(* for reporting internal bugs *)
71 :			fun bug (ES{outStrm,...}) (msg: string) : unit=
72 :			TextIO.output(outStrm,("Compiler bug: " ^ msg ^ "\n"))
73 :
74 :			(* output a warning/error message with location info *)
75 :			fun sayError (es as ES{outStrm, ...}, loc, kind, msg) =
76 :			F.formatf "%s: %s%s\n" (outputc outStrm) [
77 :			F.STR(SM.locToString loc), F.STR kind, F.STR msg
78 :			]
79 :
80 :			(* output a formatted warning/error message with location info *)
81 :			fun fmtError (es as ES{outStrm, ...}, loc, kind, fmt, items) =
82 :			F.formatf ("%s: %s" ^ fmt ^ "\n") (outputc outStrm)
83 :			((F.STR(SM.locToString loc))::(F.STR kind)::items)
84 :
85 :			(* generate warning messages to the error stream *)
86 :			fun warning (es as ES{numWarnings,warningsLimit,warningsEnabled,...}, loc, msg) =
87 :			if !warningsEnabled then
88 :			(sayError(es, loc, "warning: ", msg);
89 :			inc numWarnings;
90 :			if !numWarnings > warningsLimit then
91 :			(warningsEnabled := false;
92 :			sayError(es, loc, "warning: ", "additional warnings suppressed"))
93 :			else ())
94 :			else ()
95 :
96 :			fun warningf (es as ES{numWarnings,warningsLimit,warningsEnabled,...},
97 :			loc, fmt, items) =
98 :			if !warningsEnabled then
99 :			(fmtError(es, loc, "warning: ", fmt, items);
100 :			inc numWarnings;
101 :			if !numWarnings > warningsLimit then
102 :			(warningsEnabled := false;
103 :			sayError(es, loc, "warning: ", "additional warnings suppressed"))
104 :			else ())
105 :			else ()
106 :
107 :			fun noMoreWarnings (es as ES{warningsEnabled,...}) =
108 :			(warningsEnabled := false;
109 :			sayError(es, SM.UNKNOWN, "warning: ", "additional warnings suppressed."))
110 :
111 :			(* hints - heuristic help for error messages;
112 :			Note: must be called before error call is generated. *)
113 :			val lastHint = ref (NONE : string option)
114 :			fun hint s = (lastHint := SOME s)
115 :
116 :			(* generate error messages to the error stream *)
117 :			fun error (es as ES{numErrors, errorsLimit, errorsEnabled,...}, loc, msg) =
118 :			if !errorsEnabled then
119 :			(case !lastHint of
120 :			SOME s => (sayError(es, loc, "error: ", msg ^ "\n" ^ s);
121 :			lastHint := NONE)
122 :			| NONE => sayError(es, loc, "error: ", msg);
123 :			inc numErrors;
124 :			if !numErrors > errorsLimit then
125 :			(errorsEnabled := false;
126 :			sayError(es, loc, "warning: ", "additional errors suppressed."))
127 :			else ())
128 :			else ()
129 :
130 :			fun errorf (es as ES{numErrors,errorsLimit,errorsEnabled,...}, loc, fmt, items) =
131 :			if !errorsEnabled then
132 :			(fmtError(es, loc, "error: ", fmt, items);
133 :			inc numErrors;
134 :			if !numErrors > errorsLimit then
135 :			(errorsEnabled := false;
136 :			sayError(es, loc, "warning: ", "additional errors suppressed."))
137 :			else ())
138 :			else ()
139 :
140 :			fun noMoreErrors(es as ES{errorsEnabled,...}) =
141 :			(errorsEnabled := false;
142 :			sayError(es, SM.UNKNOWN, "warning: ", "additional errors suppressed."))
143 :
144 :			(* pretty-print an error message on the error stream *)
145 :			fun ppError (es as ES{outStrm, numErrors, ...}, loc, pp) = let
146 :			val ppStrm = PP.mk_ppstream {
147 :			consumer = outputc outStrm,
148 :			flush = fn () => TextIO.flushOut outStrm,
149 :			linewidth = 80
150 :			}
151 :			in
152 :			inc numErrors;
153 :			PP.begin_block ppStrm PP.INCONSISTENT 0;
154 :			PP.add_string ppStrm
155 :			(F.format "Error %s: " [F.STR(SM.locToString loc)]);
156 :			pp ppStrm;
157 :			PP.add_newline ppStrm;
158 :			PP.end_block ppStrm;
159 :			PP.flush_ppstream ppStrm
160 :			end
161 :
162 :			fun errStream (ES{outStrm, ...}) = outStrm
163 :
164 :			(* returns count of errors reported on the state (since last reset) *)
165 :			fun errorCount (ES{numErrors, ...}) =
166 :			!numErrors
167 :			(* returns count of warnings reported on the state (since last reset) *)
168 :			fun warningCount (ES{numWarnings, ...}) =
169 :			!numWarnings
170 :
171 :			(* clears the error and warning counts, so that errorCount and
172 :			* warningCount will return 0. *)
173 :			fun reset (ES{numErrors, numWarnings,...}) =
174 :			(numErrors := 0; numWarnings := 0)
175 :
176 :			end (* Error *)

---

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