Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/dbm-branch-2005_09_20/ckit/src/parser/util/error.sml
ViewVC logotype

Annotation of /sml/branches/dbm-branch-2005_09_20/ckit/src/parser/util/error.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 598 - (view) (download)
Original Path: sml/branches/ckit/ckit/src/parser/util/error.sml

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