1 /* error.c -*- mode:c; coding:utf-8; -*-
2 *
3 * Copyright (c) 2010-2021 Takashi Kato <ktakashi@ymail.com>
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 *
9 * 1. Redistributions of source code must retain the above copyright
10 * notice, this list of conditions and the following disclaimer.
11 *
12 * 2. Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in the
14 * documentation and/or other materials provided with the distribution.
15 *
16 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
17 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
18 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
19 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
20 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
22 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
23 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
24 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 *
28 * $Id: $
29 */
30 #include <stdarg.h>
31 #define LIBSAGITTARIUS_BODY
32 #include "sagittarius/private/error.h"
33 #include "sagittarius/private/exceptions.h"
34 #include "sagittarius/private/file.h"
35 #include "sagittarius/private/port.h"
36 #include "sagittarius/private/pair.h"
37 #include "sagittarius/private/writer.h"
38 #include "sagittarius/private/symbol.h"
39 #include "sagittarius/private/vm.h"
40 #include "sagittarius/private/library.h"
41 #include "sagittarius/private/gloc.h"
42 #include "sagittarius/private/core.h"
43
44 #define make_message3(msg_, prefix_, fmt_) \
45 do { \
46 va_list ap; \
47 SgStringPort tp; \
48 SgPort *err_; \
49 const SgChar *p = (prefix_); \
50 err_ = Sg_InitStringOutputPort(&tp, 0); \
51 if (p) \
52 Sg_PutuzUnsafe(err_, prefix_); \
53 va_start(ap, fmt_); \
54 Sg_Vprintf(err_, fmt_, ap, TRUE); \
55 va_end(ap); \
56 (msg_) = Sg_GetStringFromStringPort(&tp); \
57 SG_CLEAN_STRING_PORT(&tp); \
58 } while (0)
59
60 #define make_message(msg_, fmt_) \
61 make_message3(msg_, NULL, fmt_)
62
Sg_Warn(const SgChar * fmt,...)63 void Sg_Warn(const SgChar* fmt, ...)
64 {
65 SgObject errObj;
66 make_message3(errObj, UC("*warning* "), fmt);
67 Sg_Printf(Sg_CurrentErrorPort(), UC("%A\n"), errObj);
68 }
69
Sg_Error(const SgChar * fmt,...)70 void Sg_Error(const SgChar* fmt, ...)
71 {
72 SgObject errObj;
73 make_message(errObj, fmt);
74 errObj = Sg_MakeError(errObj);
75 Sg_VMThrowException(Sg_VM(), errObj, FALSE);
76 }
77
Sg_ReadError(const SgChar * fmt,...)78 void Sg_ReadError(const SgChar* fmt, ...)
79 {
80 SgObject errObj;
81 make_message(errObj, fmt);
82 errObj = Sg_MakeReaderCondition(errObj);
83 Sg_VMThrowException(Sg_VM(), errObj, FALSE);
84 }
85
Sg_SystemError(int errno_,const SgChar * msg,...)86 void Sg_SystemError(int errno_, const SgChar* msg, ...)
87 {
88 SgObject err, msgC;
89 make_message(msgC, msg);
90 msgC = Sg_MakeMessageCondition(msgC);
91 err = Sg_MakeSystemError(errno_);
92 Sg_VMThrowException(Sg_VM(), Sg_Condition(SG_LIST2(err, msgC)), FALSE);
93 }
94
Sg_SyntaxError(SgObject form,SgObject irritants)95 void Sg_SyntaxError(SgObject form, SgObject irritants)
96 {
97 SgObject errObj;
98 errObj = Sg_MakeSyntaxError(form, irritants);
99 Sg_VMThrowException(Sg_VM(), errObj, FALSE);
100 }
101
Sg_IOError(SgIOErrorType type,SgObject who,SgObject msg,SgObject file,SgObject port)102 void Sg_IOError(SgIOErrorType type, SgObject who, SgObject msg,
103 SgObject file, SgObject port)
104 {
105 switch (type) {
106 case SG_IO_READ_ERROR:
107 Sg_IOReadError(who, msg, port, file);
108 break;
109 case SG_IO_WRITE_ERROR:
110 Sg_IOWriteError(who, msg, port, file);
111 break;
112 case SG_IO_FILE_NOT_EXIST_ERROR:
113 Sg_IOFileDoesNotExistError(file, who, msg);
114 break;
115 case SG_IO_FILE_ALREADY_EXIST_ERROR:
116 Sg_IOFileAlreadyExistsError(file, who, msg);
117 break;
118 case SG_IO_DECODE_ERROR:
119 Sg_IODecodingError(port, who, msg);
120 break;
121 case SG_IO_ENCODE_ERROR:
122 Sg_IOEncodingError(port, '?', who, msg);
123 break;
124 case SG_IO_FILENAME_ERROR:
125 Sg_IOFilenameError(file, who, msg);
126 break;
127 case SG_IO_FILE_PROTECTION_ERROR:
128 Sg_IOFileProtectionError(file, who, msg);
129 break;
130 default:
131 Sg_Raise(Sg_Condition(SG_LIST3(Sg_MakeIOError(file),
132 Sg_MakeWhoCondition(who),
133 Sg_MakeMessageCondition(msg))),
134 FALSE);
135 break;
136 }
137 }
138
make_info_condition(SgObject who,SgObject msg,SgObject irr)139 static SgObject make_info_condition(SgObject who, SgObject msg, SgObject irr)
140 {
141 SgObject h = SG_NIL, t = SG_NIL;
142 if (!SG_FALSEP(who)) SG_APPEND1(h, t, Sg_MakeWhoCondition(who));
143 SG_APPEND1(h, t, Sg_MakeMessageCondition(msg));
144 SG_APPEND1(h, t, Sg_MakeIrritantsCondition(irr));
145 return h;
146 }
147
Sg_IOReadError(SgObject who,SgObject msg,SgObject port,SgObject irr)148 void Sg_IOReadError(SgObject who, SgObject msg, SgObject port, SgObject irr)
149 {
150 SgObject nirr = SG_NULLP(irr) ? SG_NIL : irr;
151 nirr = Sg_Cons(port, nirr);
152 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeIOReadError(),
153 make_info_condition(who, msg, nirr))),
154 FALSE);
155 }
156
Sg_IOWriteError(SgObject who,SgObject msg,SgObject port,SgObject irr)157 void Sg_IOWriteError(SgObject who, SgObject msg, SgObject port, SgObject irr)
158 {
159 SgObject nirr = SG_NULLP(irr) ? SG_NIL : irr;
160 nirr = Sg_Cons(port, nirr);
161 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeIOWriteError(),
162 make_info_condition(who, msg, nirr))),
163 FALSE);
164 }
165
Sg_IOFileDoesNotExistError(SgObject file,SgObject who,SgObject msg)166 void Sg_IOFileDoesNotExistError(SgObject file, SgObject who, SgObject msg)
167 {
168 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeIOFileDoesNotExist(file),
169 make_info_condition(who, msg, SG_NIL))),
170 FALSE);
171 }
Sg_IOFileAlreadyExistsError(SgObject file,SgObject who,SgObject msg)172 void Sg_IOFileAlreadyExistsError(SgObject file, SgObject who, SgObject msg)
173 {
174 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeIOFileAlreadyExists(file),
175 make_info_condition(who, msg, SG_NIL))),
176 FALSE);
177 }
178
Sg_IODecodingError(SgObject port,SgObject who,SgObject msg)179 void Sg_IODecodingError(SgObject port, SgObject who, SgObject msg)
180 {
181 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeIODecoding(port),
182 make_info_condition(who, msg, SG_NIL))),
183 FALSE);
184 }
Sg_IOEncodingError(SgObject port,SgChar c,SgObject who,SgObject msg)185 void Sg_IOEncodingError(SgObject port, SgChar c, SgObject who, SgObject msg)
186 {
187 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeIOEncoding(port, c),
188 make_info_condition(who, msg, SG_NIL))),
189 FALSE);
190 }
Sg_IOFilenameError(SgObject file,SgObject who,SgObject msg)191 void Sg_IOFilenameError(SgObject file, SgObject who, SgObject msg)
192 {
193 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeIOFilename(file),
194 make_info_condition(who, msg, SG_NIL))),
195 FALSE);
196 }
Sg_IOFileProtectionError(SgObject file,SgObject who,SgObject msg)197 void Sg_IOFileProtectionError(SgObject file, SgObject who, SgObject msg)
198 {
199 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeIOFileProtection(file),
200 make_info_condition(who, msg, SG_NIL))),
201 FALSE);
202 }
203
204
Sg_AssertionViolation(SgObject who,SgObject message,SgObject irritants)205 void Sg_AssertionViolation(SgObject who, SgObject message, SgObject irritants)
206 {
207 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeAssertionViolation(),
208 make_info_condition(who, message, irritants))),
209 FALSE);
210 }
211
Sg_UndefinedViolation(SgObject who,SgObject message)212 void Sg_UndefinedViolation(SgObject who, SgObject message)
213 {
214 SgObject h = SG_NIL, t = SG_NIL;
215
216 SG_APPEND1(h, t, Sg_MakeUndefinedViolation());
217 if (who && !SG_FALSEP(who)) {
218 SG_APPEND1(h, t, Sg_MakeWhoCondition(who));
219 }
220 if (message && !SG_FALSEP(message)) {
221 SG_APPEND1(h, t, Sg_MakeMessageCondition(message));
222 }
223 Sg_Raise(Sg_Condition(h), FALSE);
224 }
225
Sg_ImplementationRestrictionViolation(SgObject who,SgObject message,SgObject irritants)226 void Sg_ImplementationRestrictionViolation(SgObject who, SgObject message,
227 SgObject irritants)
228 {
229 Sg_Raise(Sg_Condition(Sg_Cons(Sg_MakeImplementationRestrictionViolation(),
230 make_info_condition(who, message, irritants))),
231 FALSE);
232 }
233
Sg_WrongTypeOfArgumentViolation(SgObject who,SgObject requiredType,SgObject gotValue,SgObject irritants)234 void Sg_WrongTypeOfArgumentViolation(SgObject who, SgObject requiredType,
235 SgObject gotValue, SgObject irritants)
236 {
237 SgObject message = Sg_Sprintf(UC("%S required, but got %S"),
238 requiredType, gotValue);
239 Sg_AssertionViolation(who, message, irritants);
240 }
241
Sg_WrongNumberOfArgumentsViolation(SgObject who,int requiredCounts,int gotCounts,SgObject irritants)242 void Sg_WrongNumberOfArgumentsViolation(SgObject who, int requiredCounts,
243 int gotCounts, SgObject irritants)
244 {
245 SgObject message = Sg_Sprintf(UC("wrong number of arguments"
246 " (required %d, but got %d)"),
247 requiredCounts, gotCounts);
248 Sg_AssertionViolation(who, message, irritants);
249 }
250
Sg_WrongNumberOfArgumentsAtLeastViolation(SgObject who,int requiredCounts,int gotCounts,SgObject irritants)251 void Sg_WrongNumberOfArgumentsAtLeastViolation(SgObject who, int requiredCounts,
252 int gotCounts,
253 SgObject irritants)
254 {
255 SgObject message = Sg_Sprintf(UC("wrong number of arguments"
256 " (required at least %d, but got %d)"),
257 requiredCounts, gotCounts);
258 Sg_AssertionViolation(who, message, irritants);
259 }
260
Sg_WrongNumberOfArgumentsBetweenViolation(SgObject who,int startCounts,int endCounts,int gotCounts,SgObject irritants)261 void Sg_WrongNumberOfArgumentsBetweenViolation(SgObject who, int startCounts,
262 int endCounts, int gotCounts,
263 SgObject irritants)
264 {
265 SgObject message = Sg_Sprintf(UC("wrong number of arguments"
266 " (required beween %d and %d, but got %d)"),
267 startCounts, endCounts, gotCounts);
268 Sg_AssertionViolation(who, message, irritants);
269 }
270
Sg_Raise(SgObject condition,int continuableP)271 SgObject Sg_Raise(SgObject condition, int continuableP)
272 {
273 return Sg_VMThrowException(Sg_VM(), condition, continuableP);
274 }
275
276 /*
277 end of file
278 Local Variables:
279 coding: utf-8-unix
280 End:
281 */
282