2 ase-cartesian.h -- Cartesian (exterior) product of ASE objects
3 Copyright (C) 2006, 2007, 2008 Sebastian Freundt
5 Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 * This file is part of SXEmacs.
9 * Redistribution and use in source and binary forms, with or without
10 * modification, are permitted provided that the following conditions
13 * 1. Redistributions of source code must retain the above copyright
14 * notice, this list of conditions and the following disclaimer.
16 * 2. Redistributions in binary form must reproduce the above copyright
17 * notice, this list of conditions and the following disclaimer in the
18 * documentation and/or other materials provided with the distribution.
20 * 3. Neither the name of the author nor the names of any contributors
21 * may be used to endorse or promote products derived from this
22 * software without specific prior written permission.
24 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
28 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
31 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
32 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
33 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
34 * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37 /* Synched up with: Not in FSF. */
39 #ifndef INCLUDED_ase_cartesian_h_
40 #define INCLUDED_ase_cartesian_h_ 1
44 #define EMOD_ASE_DEBUG_CART(args...) EMOD_ASE_DEBUG("[CART]: " args)
46 typedef struct ase_cartesian_s *ase_cartesian_t;
48 extern Lisp_Object Qase_cartesian, Qase_cartesianp;
49 extern Lisp_Object Qase_cartesian_interior, Qase_cartesian_interior_p;
50 extern Lisp_Object Qembed_error, Qinterior_error;
52 extern void LTX_PUBINIT(ase_cartesian)(void);
53 extern void LTX_PUBREINIT(ase_cartesian)(void);
54 extern void LTX_PUBDEINIT(ase_cartesian)(void);
59 struct ase_cartesian_s {
60 struct ase_object_s obj;
62 Lisp_Object interior_type;
65 /* for measure freaks */
66 Lisp_Object lebesgue_measure;
67 Lisp_Object rational_measure;
69 /* for friends of colour */
72 /* just a ref counter for those nifty recycled items */
73 struct sxe_refcounter_s refcnt;
77 #define ASE_CARTESIANP(_i) \
79 EQ(XDYNACAT(_i)->type, Qase_cartesian))
80 #define ASE_CARTESIAN_INTERIOR_P(_i) \
82 EQ(XDYNACAT(_i)->type, Qase_cartesian_interior))
83 #define ASE_UBERCARTESIANP(_i) \
84 (ASE_CARTESIANP(_i) || ASE_CARTESIAN_INTERIOR_P(_i))
85 #define CHECK_ASE_CARTESIAN(x) \
87 if (!ASE_CARTESIANP(x)) \
88 dead_wrong_type_argument( \
89 Qase_cartesianp, x); \
91 #define CHECK_ASE_CARTESIAN_INTERIOR(x) \
93 if (!ASE_CARTESIAN_INTERIOR_P(x)) \
94 dead_wrong_type_argument( \
95 Qase_cartesian_interior_p, x); \
97 #define CHECK_ASE_UBERCARTESIAN(x) \
99 if (!ASE_UBERCARTESIANP(x)) \
100 dead_wrong_type_argument( \
101 Qase_cartesianp, x); \
103 #define CONCHECK_ASE_CARTESIAN(x) \
105 if (!ASE_CARTESIANP(x)) \
106 x = wrong_type_argument( \
107 Qase_cartesianp, x); \
109 #define CONCHECK_ASE_CARTESIAN_INTERIOR(x) \
111 if (!ASE_CARTESIAN_INTERIOR_P(x)) \
112 x = wrong_type_argument( \
113 Qase_cartesian_interior_p, x); \
115 #define CONCHECK_ASE_UBERCARTESIAN(x) \
117 if (!ASE_UBERCARTESIANP(x)) \
118 x = wrong_type_argument( \
119 Qase_cartesianp, x); \
121 #define XSETASE_CARTESIAN(_res, _int) \
122 (_res) = _ase_wrap_cartesian((_int))
123 #define XSETASE_CARTESIAN_INTERIOR(_res, _int) \
124 (_res) = _ase_wrap_cartesian_interior((_int))
125 #define XASE_CARTESIAN(_x) ((ase_cartesian_t)get_dynacat(_x))
126 #define ase_cartesian_interior_type(_x) ((_x)->interior_type)
127 #define ase_cartesian_dimension(_x) ((_x)->dimension)
128 #define ase_cartesian_objects(_x) ((_x)->objects)
129 #define XASE_CARTESIAN_INTERIOR_TYPE(_x) \
130 (ase_cartesian_interior_type(XASE_CARTESIAN(_x)))
131 #define XASE_CARTESIAN_DIMENSION(_x) \
132 (ase_cartesian_dimension(XASE_CARTESIAN(_x)))
133 #define XASE_CARTESIAN_OBJECTS(_x) \
134 (ase_cartesian_objects(XASE_CARTESIAN(_x)))
135 #define XASE_CARTESIAN_FIRST_OBJECT(_x) \
136 (ase_cartesian_objects(XASE_CARTESIAN(_x))[0])
138 #define ASE_CARTESIAN_TRAVERSE(_c, _var, args...) \
141 for (i = 0; i < c->dimension; i++) { \
142 Lisp_Object (_var) = _c->objects[i]; \
147 #define ase_cartesian_refcnt(_a) (&((_a)->refcnt))
148 #define ase_cartesian_init_refcnt(_a) \
149 (sxe_refcounter_init(ase_cartesian_refcnt(_a)))
150 #define ase_cartesian_fini_refcnt(_a) \
151 (sxe_refcounter_finish(ase_cartesian_refcnt(_a)))
152 #define ase_cartesian_refval(_a) \
153 (sxe_refcounter_value(ase_cartesian_refcnt(_a)))
154 #define ase_cartesian_incref(_a) \
155 (sxe_refcounter_incref(ase_cartesian_refcnt(_a)))
156 #define ase_cartesian_decref(_a) \
157 (sxe_refcounter_decref(ase_cartesian_refcnt(_a)))
158 #define XASE_CARTESIAN_REFVAL(_a) \
159 (ase_interval_refval(XASE_CARTESIAN(_a)))
160 #define XASE_CARTESIAN_INCREF(_a) \
161 (ase_interval_incref(XASE_CARTESIAN(_a)))
162 #define XASE_CARTESIAN_DECREF(_a) \
163 (ase_interval_decref(XASE_CARTESIAN(_a)))
167 extern Lisp_Object ase_make_cartesian(int nargs, Lisp_Object *args, int interiorp);
168 extern Lisp_Object _ase_wrap_cartesian(ase_cartesian_t);
169 extern Lisp_Object _ase_wrap_cartesian_interior(ase_cartesian_t);
171 ase_cartesian_pointwise_pred_p(ase_cartesian_t, int(*)(Lisp_Object));
172 extern inline Lisp_Object
173 ase_cartesian_pointwise_erel_p(
174 ase_cartesian_t, ase_cartesian_t, ase_element_relation_f);
176 ase_cartesian_pointwise_rel_p(
177 ase_cartesian_t, ase_cartesian_t, ase_relation_f);
179 ase_cartesian_antipointwise_rel_p(
180 ase_cartesian_t, ase_cartesian_t, ase_relation_f);
181 extern inline ase_cartesian_t
182 _ase_make_cartesian(int nargs, Lisp_Object*, int interiorp);
183 extern inline Lisp_Object*
184 __ase_vectorise(int nargs, Lisp_Object *o);
187 /* for predicates this is a more intuitive function
188 * it applies PREDFUN to every point in C and returns non-0 iff
189 * all points met PREDFUN and 0 otherwise */
191 ase_cartesian_pointwise_pred_p(ase_cartesian_t c, int(*predfun)(Lisp_Object))
193 /* Apply PREDFUN to every point in C and returns non-0 iff
194 * all points met PREDFUN and 0 otherwise */
196 Lisp_Object *o = c->objects;
198 for (i = 0; i < c->dimension; i++) {
205 extern inline Lisp_Object
206 ase_cartesian_pointwise_erel_p(
207 ase_cartesian_t c1, ase_cartesian_t c2, ase_element_relation_f relf)
209 /* Apply RELFUN pointwise to C1 and C2 and returns non-0 iff
210 * all points met RELF and 0 otherwise */
212 Lisp_Object *o1 = c1->objects;
213 Lisp_Object *o2 = c2->objects;
215 for (i = 0; i < c1->dimension && i < c2->dimension; i++) {
216 if (NILP(relf(o1[i], o2[i])))
223 ase_cartesian_pointwise_rel_p(
224 ase_cartesian_t c1, ase_cartesian_t c2, ase_relation_f relf)
226 /* Apply RELF pointwise to C1 and C2 and returns non-0 iff
227 * all points met RELF and 0 otherwise */
229 Lisp_Object *o1 = c1->objects;
230 Lisp_Object *o2 = c2->objects;
232 for (i = 0; i < c1->dimension && i < c2->dimension; i++) {
233 if (!relf(o1[i], o2[i])) {
241 ase_cartesian_antipointwise_rel_p(
242 ase_cartesian_t c1, ase_cartesian_t c2, ase_relation_f relf)
244 /* Apply RELF pointwise to C1 and C2 and returns non-0 iff
245 * at least one point met RELF and 0 otherwise */
247 Lisp_Object *o1 = c1->objects;
248 Lisp_Object *o2 = c2->objects;
250 for (i = 0; i < c1->dimension && i < c2->dimension; i++) {
251 if (relf(o1[i], o2[i]))
259 extern inline Lisp_Object*
260 __ase_vectorise(int nargs, Lisp_Object *o)
262 Lisp_Object *result = NULL;
265 result = xnew_array(Lisp_Object, nargs);
266 for (i = 0; i < nargs; i++)
272 extern inline ase_cartesian_t
273 _ase_make_cartesian(int nargs, Lisp_Object *o, int interiorp)
275 ase_cartesian_t n = NULL;
277 n = xnew(struct ase_cartesian_s);
279 n->dimension = nargs;
280 n->lebesgue_measure = Qnil;
281 n->rational_measure = Qnil;
283 /* if we deal with an interior cartesian product, stick the type here */
285 n->interior_type = Ftype_of(o[0]);
287 n->interior_type = Qnil;
289 n->objects = __ase_vectorise(nargs, o);
291 ase_cartesian_init_refcnt(n);
293 EMOD_ASE_DEBUG_CART("n:0x%08x (rc:0) shall be created...\n",
303 DOESNT_RETURN ase_cartesian_embedding_error(Lisp_Object, Lisp_Object);
305 #endif /* INCLUDED_ase_cartesian_h_ */