1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 2007-2011, University of Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #include <SWI-Stream.h>
36 #include <SWI-Prolog.h>
37
38 #define O_DEBUG 1
39
40 static functor_t FUNCTOR_error2; /* error(Formal, Context) */
41 static functor_t FUNCTOR_type_error2; /* type_error(Term, Expected) */
42 static functor_t FUNCTOR_domain_error2; /* domain_error(Term, Expected) */
43 static functor_t FUNCTOR_permission_error3; /* permission_error(Op, Type, Term) */
44 static functor_t FUNCTOR_existence_error2; /* existence_error(Type, Term) */
45 static int debuglevel = 0;
46
47 #define MKFUNCTOR(name, arity) PL_new_functor(PL_new_atom(name), arity)
48
49 #ifdef O_DEBUG
50 #define DEBUG(n, g) if ( debuglevel >= n ) g
51 #else
52 #define DEBUG(n, g) (void)0
53 #endif
54
55
56 #ifdef O_DEBUG
57 static foreign_t
http_stream_debug(term_t level)58 http_stream_debug(term_t level)
59 { return PL_get_integer(level, &debuglevel);
60 }
61 #endif
62
63
64 /*******************************
65 * ERRORS *
66 *******************************/
67
68 static int
type_error(term_t actual,const char * expected)69 type_error(term_t actual, const char *expected)
70 { term_t ex;
71
72 if ( (ex = PL_new_term_ref()) &&
73 PL_unify_term(ex,
74 PL_FUNCTOR, FUNCTOR_error2,
75 PL_FUNCTOR, FUNCTOR_type_error2,
76 PL_CHARS, expected,
77 PL_TERM, actual,
78 PL_VARIABLE) )
79 return PL_raise_exception(ex);
80
81 return FALSE;
82 }
83
84
85 static int
domain_error(term_t actual,const char * domain)86 domain_error(term_t actual, const char *domain)
87 { term_t ex;
88
89 if ( (ex = PL_new_term_ref()) &&
90 PL_unify_term(ex,
91 PL_FUNCTOR, FUNCTOR_error2,
92 PL_FUNCTOR, FUNCTOR_domain_error2,
93 PL_CHARS, domain,
94 PL_TERM, actual,
95 PL_VARIABLE) )
96 return PL_raise_exception(ex);
97
98 return FALSE;
99 }
100
101
102 static int
existence_error(term_t actual,const char * type)103 existence_error(term_t actual, const char *type)
104 { term_t ex;
105
106 if ( (ex = PL_new_term_ref()) &&
107 PL_unify_term(ex,
108 PL_FUNCTOR, FUNCTOR_error2,
109 PL_FUNCTOR, FUNCTOR_existence_error2,
110 PL_CHARS, type,
111 PL_TERM, actual,
112 PL_VARIABLE) )
113 return PL_raise_exception(ex);
114
115 return FALSE;
116 }
117
118
119 static int
permission_error(const char * op,const char * objtype,term_t obj)120 permission_error(const char *op, const char *objtype, term_t obj)
121 { term_t ex;
122
123 if ( (ex = PL_new_term_ref()) &&
124 PL_unify_term(ex,
125 PL_FUNCTOR, FUNCTOR_error2,
126 PL_FUNCTOR, FUNCTOR_permission_error3,
127 PL_CHARS, op,
128 PL_CHARS, objtype,
129 PL_TERM, obj,
130 PL_VARIABLE) )
131 return PL_raise_exception(ex);
132
133 return FALSE;
134 }
135
136
137 static int
instantiation_error()138 instantiation_error()
139 { term_t ex;
140
141 if ( (ex = PL_new_term_ref()) &&
142 PL_unify_term(ex,
143 PL_FUNCTOR, FUNCTOR_error2,
144 PL_CHARS, "instantiation_error",
145 PL_VARIABLE) )
146 return PL_raise_exception(ex);
147
148 return FALSE;
149 }
150
151
152 static int
get_int_ex(term_t t,int * i)153 get_int_ex(term_t t, int *i)
154 { if ( PL_get_integer(t, i) )
155 return TRUE;
156
157 return type_error(t, "integer");
158 }
159
160
161 static int
get_bool_ex(term_t t,int * i)162 get_bool_ex(term_t t, int *i)
163 { if ( PL_get_bool(t, i) )
164 return TRUE;
165
166 return type_error(t, "boolean");
167 }
168
169
170 static void
init_errors()171 init_errors()
172 { FUNCTOR_error2 = MKFUNCTOR("error", 2);
173 FUNCTOR_type_error2 = MKFUNCTOR("type_error", 2);
174 FUNCTOR_domain_error2 = MKFUNCTOR("domain_error", 2);
175 FUNCTOR_existence_error2 = MKFUNCTOR("existence_error", 2);
176 FUNCTOR_permission_error3 = MKFUNCTOR("permission_error", 3);
177
178 #ifdef O_DEBUG
179 PL_register_foreign("http_stream_debug", 1, http_stream_debug, 0);
180 #endif
181 }
182