1 #include "pl-incl.h"
2
outOfCore(void)3 void outOfCore(void) {}
fatalError(const char * fm,...)4 void fatalError(const char *fm, ...) {exit(1);}
printMessage(int type,...)5 void printMessage(int type, ...) {}
6
7 /*******************************
8 * ERROR-CHECKING *_get() *
9 *******************************/
10
11 int
PL_get_nchars_ex(term_t t,size_t * len,char ** s,unsigned int flags)12 PL_get_nchars_ex(term_t t, size_t *len, char **s, unsigned int flags)
13 { return PL_get_nchars(t, len, s, flags|CVT_EXCEPTION);
14 }
15
16
17 int
PL_get_chars_ex(term_t t,char ** s,unsigned int flags)18 PL_get_chars_ex(term_t t, char **s, unsigned int flags)
19 { return PL_get_nchars(t, NULL, s, flags|CVT_EXCEPTION);
20 }
21
22
23 int
PL_get_atom_ex(term_t t,atom_t * a)24 PL_get_atom_ex(term_t t, atom_t *a)
25 { if ( PL_get_atom(t, a) )
26 succeed;
27
28 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, t);
29 }
30
31
32 int
PL_get_integer_ex(term_t t,int * i)33 PL_get_integer_ex(term_t t, int *i)
34 { if ( PL_get_integer(t, i) )
35 succeed;
36
37 if ( PL_is_integer(t) )
38 return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_int);
39
40 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_integer, t);
41 }
42
43
44 int
PL_get_long_ex(term_t t,long * i)45 PL_get_long_ex(term_t t, long *i)
46 { if ( PL_get_long(t, i) )
47 succeed;
48
49 if ( PL_is_integer(t) )
50 return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_long);
51
52 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_integer, t);
53 }
54
55
56 int
PL_get_int64_ex(term_t t,int64_t * i)57 PL_get_int64_ex(term_t t, int64_t *i)
58 { if ( PL_get_int64(t, i) )
59 succeed;
60
61 if ( PL_is_integer(t) )
62 return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_int64_t);
63
64 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_integer, t);
65 }
66
67
68 int
PL_get_intptr_ex(term_t t,intptr_t * i)69 PL_get_intptr_ex(term_t t, intptr_t *i)
70 {
71 #if SIZEOF_LONG != SIZEOF_VOIDP && SIZEOF_VOIDP == 8
72 return PL_get_int64_ex(t, i);
73 #else
74 return PL_get_long_ex(t, (long*)i);
75 #endif
76 }
77
78
79 int
PL_get_bool_ex(term_t t,int * i)80 PL_get_bool_ex(term_t t, int *i)
81 { if ( PL_get_bool(t, i) )
82 succeed;
83
84 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_bool, t);
85 }
86
87
88 int
PL_get_float_ex(term_t t,double * f)89 PL_get_float_ex(term_t t, double *f)
90 { if ( PL_get_float(t, f) )
91 succeed;
92
93 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_float, t);
94 }
95
96
97 int
PL_get_char_ex(term_t t,int * p,int eof)98 PL_get_char_ex(term_t t, int *p, int eof)
99 { if ( PL_get_char(t, p, eof) )
100 succeed;
101
102 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_character, t);
103 }
104
105
106 int
PL_unify_list_ex(term_t l,term_t h,term_t t)107 PL_unify_list_ex(term_t l, term_t h, term_t t)
108 { if ( PL_unify_list(l, h, t) )
109 succeed;
110
111 if ( PL_get_nil(l) )
112 fail;
113
114 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
115 }
116
117
118 int
PL_unify_nil_ex(term_t l)119 PL_unify_nil_ex(term_t l)
120 { if ( PL_unify_nil(l) )
121 succeed;
122
123 if ( PL_is_list(l) )
124 fail;
125
126 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
127 }
128
129
130 int
PL_get_list_ex(term_t l,term_t h,term_t t)131 PL_get_list_ex(term_t l, term_t h, term_t t)
132 { if ( PL_get_list(l, h, t) )
133 succeed;
134
135 if ( PL_get_nil(l) )
136 fail;
137
138 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
139 }
140
141 int
PL_get_nil_ex(term_t l)142 PL_get_nil_ex(term_t l)
143 { if ( PL_get_nil(l) )
144 succeed;
145
146 if ( PL_is_list(l) )
147 fail;
148
149 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, l);
150 }
151
152
153 int
PL_get_module_ex(term_t name,module_t * m)154 PL_get_module_ex(term_t name, module_t *m)
155 { if ( !PL_get_module(name, m) )
156 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, name);
157
158 succeed;
159 }
160
161 int
PL_unify_bool_ex(term_t t,bool val)162 PL_unify_bool_ex(term_t t, bool val)
163 { bool v;
164
165 if ( PL_is_variable(t) )
166 return PL_unify_atom(t, val ? ATOM_true : ATOM_false);
167 if ( PL_get_bool(t, &v) )
168 { if ( (!val && !v) || (val && v) )
169 succeed;
170 fail;
171 }
172
173 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_bool, t);
174 }
175
176 word
notImplemented(char * name,int arity)177 notImplemented(char *name, int arity)
178 { return (word)PL_error(NULL, 0, NULL, ERR_NOT_IMPLEMENTED_PROC, name, arity);
179 }
180
181