cgit.sxemacs.org Git - sxemacs/blob - modules/ase/ase-cartesian.h

   1 /*
   2   ase-cartesian.h -- Cartesian (exterior) product of ASE objects
   3   Copyright (C) 2006, 2007, 2008 Sebastian Freundt
   4
   5   Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6
   7   * This file is part of SXEmacs.
   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 the
  18   *    documentation and/or other materials provided with the distribution.
  19   *
  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.
  23   *
  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.
  35   */
  36
  37 /* Synched up with: Not in FSF. */
  38
  39 #ifndef INCLUDED_ase_cartesian_h_
  40 #define INCLUDED_ase_cartesian_h_ 1
  41
  42 #include "ase.h"
  43
  44 #define EMOD_ASE_DEBUG_CART(args...)    EMOD_ASE_DEBUG("[CART]: " args)
  45
  46 typedef struct ase_cartesian_s *ase_cartesian_t;
  47
  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;
  51
  52 extern void LTX_PUBINIT(ase_cartesian)(void);
  53 extern void LTX_PUBREINIT(ase_cartesian)(void);
  54 extern void LTX_PUBDEINIT(ase_cartesian)(void);
  55
  56 EXFUN(Ftype_of, 1);
  57
  58 \f
  59 struct ase_cartesian_s {
  60         struct ase_object_s obj;
  61         int dimension;
  62         Lisp_Object interior_type;
  63         Lisp_Object *objects;
  64
  65         /* for measure freaks */
  66         Lisp_Object lebesgue_measure;
  67         Lisp_Object rational_measure;
  68
  69         /* for friends of colour */
  70         Lisp_Object colour;
  71
  72         /* just a ref counter for those nifty recycled items */
  73         struct sxe_refcounter_s refcnt;
  74 };
  75
  76 \f
  77 #define ASE_CARTESIANP(_i)                                              \
  78         (DYNACATP(_i) &&                                                \
  79          EQ(XDYNACAT(_i)->type, Qase_cartesian))
  80 #define ASE_CARTESIAN_INTERIOR_P(_i)                                    \
  81         (DYNACATP(_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)                                          \
  86         do {                                                            \
  87                 if (!ASE_CARTESIANP(x))                                 \
  88                         dead_wrong_type_argument(                       \
  89                                 Qase_cartesianp, x);                    \
  90         } while (0)
  91 #define CHECK_ASE_CARTESIAN_INTERIOR(x)                                 \
  92         do {                                                            \
  93                 if (!ASE_CARTESIAN_INTERIOR_P(x))                       \
  94                         dead_wrong_type_argument(                       \
  95                                 Qase_cartesian_interior_p, x);          \
  96         } while (0)
  97 #define CHECK_ASE_UBERCARTESIAN(x)                                      \
  98         do {                                                            \
  99                 if (!ASE_UBERCARTESIANP(x))                             \
 100                         dead_wrong_type_argument(                       \
 101                                 Qase_cartesianp, x);                    \
 102         } while (0)
 103 #define CONCHECK_ASE_CARTESIAN(x)                                       \
 104         do {                                                            \
 105                 if (!ASE_CARTESIANP(x))                                 \
 106                         x = wrong_type_argument(                        \
 107                                 Qase_cartesianp, x);                    \
 108         } while (0)
 109 #define CONCHECK_ASE_CARTESIAN_INTERIOR(x)                              \
 110         do {                                                            \
 111                 if (!ASE_CARTESIAN_INTERIOR_P(x))                       \
 112                         x = wrong_type_argument(                        \
 113                                 Qase_cartesian_interior_p, x);          \
 114         } while (0)
 115 #define CONCHECK_ASE_UBERCARTESIAN(x)                                   \
 116         do {                                                            \
 117                 if (!ASE_UBERCARTESIANP(x))                             \
 118                         x = wrong_type_argument(                        \
 119                                 Qase_cartesianp, x);                    \
 120         } while (0)
 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])
 137
 138 #define ASE_CARTESIAN_TRAVERSE(_c, _var, args...)               \
 139         do {                                                    \
 140                 int i;                                          \
 141                 for (i = 0; i < c->dimension; i++) {            \
 142                         Lisp_Object (_var) = _c->objects[i];    \
 143                         args;                                   \
 144                 }                                               \
 145         } while (0);
 146
 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)))
 164
 165 \f
 166 /* protos */
 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);
 170 static inline int
 171 ase_cartesian_pointwise_pred_p(ase_cartesian_t, int(*)(Lisp_Object));
 172 static inline Lisp_Object
 173 ase_cartesian_pointwise_erel_p(
 174         ase_cartesian_t, ase_cartesian_t, ase_element_relation_f);
 175 static inline int
 176 ase_cartesian_pointwise_rel_p(
 177         ase_cartesian_t, ase_cartesian_t, ase_relation_f);
 178 static inline int
 179 ase_cartesian_antipointwise_rel_p(
 180         ase_cartesian_t, ase_cartesian_t, ase_relation_f);
 181 static inline ase_cartesian_t
 182         _ase_make_cartesian(int nargs, Lisp_Object*, int interiorp);
 183 static inline Lisp_Object*
 184 __ase_vectorise(int nargs, Lisp_Object *o);
 185
 186 \f
 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 */
 190 static inline int
 191 ase_cartesian_pointwise_pred_p(ase_cartesian_t c, int(*predfun)(Lisp_Object))
 192 {
 193         /* Apply PREDFUN to every point in C and returns non-0 iff
 194          * all points met PREDFUN and 0 otherwise */
 195         int i;
 196         Lisp_Object *o = c->objects;
 197
 198         for (i = 0; i < c->dimension; i++) {
 199                 if (!predfun(o[i]))
 200                         return 0;
 201         }
 202         return 1;
 203 }
 204
 205 static inline Lisp_Object
 206 ase_cartesian_pointwise_erel_p(
 207         ase_cartesian_t c1, ase_cartesian_t c2, ase_element_relation_f relf)
 208 {
 209         /* Apply RELFUN pointwise to C1 and C2 and returns non-0 iff
 210          * all points met RELF and 0 otherwise */
 211         int i;
 212         Lisp_Object *o1 = c1->objects;
 213         Lisp_Object *o2 = c2->objects;
 214
 215         for (i = 0; i < c1->dimension && i < c2->dimension; i++) {
 216                 if (NILP(relf(o1[i], o2[i])))
 217                         return Qnil;
 218         }
 219         return Qt;
 220 }
 221
 222 static inline int
 223 ase_cartesian_pointwise_rel_p(
 224         ase_cartesian_t c1, ase_cartesian_t c2, ase_relation_f relf)
 225 {
 226         /* Apply RELF pointwise to C1 and C2 and returns non-0 iff
 227          * all points met RELF and 0 otherwise */
 228         int i;
 229         Lisp_Object *o1 = c1->objects;
 230         Lisp_Object *o2 = c2->objects;
 231
 232         for (i = 0; i < c1->dimension && i < c2->dimension; i++) {
 233                 if (!relf(o1[i], o2[i])) {
 234                         return 0;
 235                 }
 236         }
 237         return 1;
 238 }
 239
 240 static inline int
 241 ase_cartesian_antipointwise_rel_p(
 242         ase_cartesian_t c1, ase_cartesian_t c2, ase_relation_f relf)
 243 {
 244         /* Apply RELF pointwise to C1 and C2 and returns non-0 iff
 245          * at least one point met RELF and 0 otherwise */
 246         int i;
 247         Lisp_Object *o1 = c1->objects;
 248         Lisp_Object *o2 = c2->objects;
 249
 250         for (i = 0; i < c1->dimension && i < c2->dimension; i++) {
 251                 if (relf(o1[i], o2[i]))
 252                         return 1;
 253         }
 254         return 0;
 255 }
 256
 257 \f
 258 /* constructors */
 259 static inline Lisp_Object*
 260 __ase_vectorise(int nargs, Lisp_Object *o)
 261 {
 262         Lisp_Object *result = NULL;
 263         int i;
 264
 265         result = xnew_array(Lisp_Object, nargs);
 266         for (i = 0; i < nargs; i++)
 267                 result[i] = o[i];
 268
 269         return result;
 270 }
 271
 272 static inline ase_cartesian_t
 273 _ase_make_cartesian(int nargs, Lisp_Object *o, int interiorp)
 274 {
 275         ase_cartesian_t n = NULL;
 276
 277         n = xnew(struct ase_cartesian_s);
 278
 279         n->dimension = nargs;
 280         n->lebesgue_measure = Qnil;
 281         n->rational_measure = Qnil;
 282         n->colour = Qnil;
 283         /* if we deal with an interior cartesian product, stick the type here */
 284         if (interiorp)
 285                 n->interior_type = Ftype_of(o[0]);
 286         else
 287                 n->interior_type = Qnil;
 288
 289         n->objects = __ase_vectorise(nargs, o);
 290
 291         ase_cartesian_init_refcnt(n);
 292
 293         EMOD_ASE_DEBUG_CART("n:0x%08x (rc:0) shall be created...\n",
 294                             (unsigned int)n);
 295         return n;
 296 }
 297
 298 /* predicates */
 299
 300 /* accessors */
 301
 302 /* errors */
 303 DOESNT_RETURN ase_cartesian_embedding_error(Lisp_Object, Lisp_Object);
 304
 305 #endif  /* INCLUDED_ase_cartesian_h_ */