cgit.sxemacs.org Git - sxemacs/blob - src/ent/ent-binary-rel.h

   1 /*
   2   ent-binary-rel.h -- Global Binary Relations
   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_ent_binary_rel_h_
  40 #define INCLUDED_ent_binary_rel_h_
  41
  42 #define ENT_DEBUG_BINREL(args...)       ENT_DEBUG("[BINREL]: " args)
  43
  44 /*************************/
  45 /* new ASE optable magic */
  46 /*************************/
  47 /* the binary reltable */
  48 typedef enum ase_binary_relation_e ase_binary_relation_t;
  49 typedef int(*ase_binary_relation_f)(Lisp_Object, Lisp_Object);
  50
  51 enum ase_binary_relation_e {
  52         ASE_BINARY_REL_LESSP,
  53         ASE_BINARY_FIRST_REL = ASE_BINARY_REL_LESSP,
  54         ASE_BINARY_REL_GREATERP,
  55         ASE_BINARY_REL_EQUALP,
  56         ASE_BINARY_REL_NEQP,
  57         ASE_BINARY_REL_SUBSETP,
  58         ASE_BINARY_REL_SUPERSETP,
  59         ASE_BINARY_REL_CONTAINSP,
  60         ASE_BINARY_REL_INP,
  61         ASE_BINARY_LAST_REL = ASE_BINARY_REL_INP,
  62         N_ASE_BINARY_RELS
  63 };
  64
  65 extern ase_binary_relation_f
  66 ase_binary_reltable[N_ASE_BINARY_RELS][ASE_OPTABLE_SIZE][ASE_OPTABLE_SIZE];
  67
  68 extern int ase_binary_relation_undefined(Lisp_Object l, Lisp_Object r);
  69 extern void ase_binary_reltable_init(void);
  70
  71 extern_inline void
  72 ent_binrel_register(
  73         ase_binary_relation_t rel,
  74         ase_object_type_t t1, ase_object_type_t t2,
  75         ase_binary_relation_f relf);
  76 extern_inline void
  77 ent_binrel_unregister(
  78         ase_binary_relation_t rel,
  79         ase_object_type_t t1, ase_object_type_t t2);
  80 extern_inline int
  81 _ent_binrel(
  82         ase_binary_relation_t rel,
  83         ase_object_type_t l1t, Lisp_Object l1,
  84         ase_object_type_t l2t, Lisp_Object l2);
  85 extern_inline int
  86 _ent_binrel2(
  87         ase_binary_relation_t rel1, ase_binary_relation_t rel2,
  88         ase_object_type_t l1t, Lisp_Object l1,
  89         ase_object_type_t l2t, Lisp_Object l2);
  90 extern_inline int
  91 ent_binrel(ase_binary_relation_t rel, Lisp_Object l1, Lisp_Object l2);
  92 extern_inline int
  93 ent_binrel2(
  94         ase_binary_relation_t rel1, ase_binary_relation_t rel2,
  95         Lisp_Object l1, Lisp_Object l2);
  96 extern_inline int
  97 ent_binrel_transitive_many(
  98         ase_binary_relation_t rel,
  99         int nargs, Lisp_Object *args);
 100 extern_inline int
 101 ent_binrel2_transitive_many(
 102         ase_binary_relation_t rel1,
 103         ase_binary_relation_t rel2,
 104         int nargs, Lisp_Object *args);
 105 extern_inline int
 106 ent_binrel_intransitive_many(
 107         ase_binary_relation_t rel,
 108         int nargs, Lisp_Object *args);
 109
 110 \f
 111 extern_inline void
 112 ent_binrel_register(ase_binary_relation_t rel,
 113                     ase_object_type_t t1, ase_object_type_t t2,
 114                     ase_binary_relation_f relf)
 115 {
 116         ase_binary_reltable[rel][t1][t2] = relf;
 117         return;
 118 }
 119 extern_inline void
 120 ent_binrel_unregister(ase_binary_relation_t rel,
 121                       ase_object_type_t t1, ase_object_type_t t2)
 122 {
 123         ase_binary_reltable[rel][t1][t2] = ase_binary_relation_undefined;
 124         return;
 125 }
 126
 127 extern_inline int
 128 _ent_binrel(ase_binary_relation_t rel,
 129             ase_object_type_t l1t, Lisp_Object l1,
 130             ase_object_type_t l2t, Lisp_Object l2)
 131 {
 132         ase_binary_relation_f relf =
 133                 ase_binary_reltable[rel][l1t][l2t];
 134
 135         return relf(l1, l2);
 136 }
 137
 138 extern_inline int
 139 _ent_binrel2(ase_binary_relation_t rel1, ase_binary_relation_t rel2,
 140              ase_object_type_t l1t, Lisp_Object l1,
 141              ase_object_type_t l2t, Lisp_Object l2)
 142 {
 143         ase_binary_relation_f relf1 =
 144                 ase_binary_reltable[rel1][l1t][l2t];
 145         ase_binary_relation_f relf2 =
 146                 ase_binary_reltable[rel2][l1t][l2t];
 147
 148         return (relf1(l1, l2) || relf2(l1, l2));
 149 }
 150
 151 extern_inline int
 152 ent_binrel(ase_binary_relation_t rel, Lisp_Object l1, Lisp_Object l2)
 153 {
 154         ase_object_type_t l1t = ase_optable_index(l1);
 155         ase_object_type_t l2t = ase_optable_index(l2);
 156
 157         return _ent_binrel(rel, l1t, l1, l2t, l2);
 158 }
 159
 160 extern_inline int
 161 ent_binrel2(ase_binary_relation_t rel1, ase_binary_relation_t rel2,
 162             Lisp_Object l1, Lisp_Object l2)
 163 {
 164         ase_object_type_t l1t = ase_optable_index(l1);
 165         ase_object_type_t l2t = ase_optable_index(l2);
 166
 167         return _ent_binrel2(rel1, rel2, l1t, l1, l2t, l2);
 168 }
 169
 170 extern_inline int
 171 ent_binrel_transitive_many(ase_binary_relation_t rel,
 172                            int nargs, Lisp_Object *args)
 173 {
 174         REGISTER int i;
 175         Lisp_Object accum;
 176         ase_object_type_t _acct, addt;
 177
 178         accum = args[0];
 179         _acct = ase_optable_index(accum);
 180         for (i = 1; i < nargs; i++) {
 181                 addt = ase_optable_index(args[i]);
 182                 if (!_ent_binrel(rel, _acct, accum, addt, args[i]))
 183                         return 0;
 184                 accum = args[i];
 185                 _acct = addt;
 186         }
 187
 188         return 1;
 189 }
 190
 191 extern_inline int
 192 ent_binrel2_transitive_many(ase_binary_relation_t rel1,
 193                             ase_binary_relation_t rel2,
 194                             int nargs, Lisp_Object *args)
 195 {
 196         REGISTER int i;
 197         Lisp_Object accum;
 198         ase_object_type_t _acct, addt;
 199
 200         accum = args[0];
 201         _acct = ase_optable_index(accum);
 202         for (i = 1; i < nargs; i++) {
 203                 addt = ase_optable_index(args[i]);
 204                 if (!_ent_binrel2(rel1, rel2, _acct, accum, addt, args[i]))
 205                         return 0;
 206                 accum = args[i];
 207                 _acct = addt;
 208         }
 209
 210         return 1;
 211 }
 212
 213 extern_inline int
 214 ent_binrel_intransitive_many(ase_binary_relation_t rel,
 215                              int nargs, Lisp_Object *args)
 216 {
 217         REGISTER int i, j;
 218
 219         for (i = 0; i < nargs; i++) {
 220                 for (j = i+1; j < nargs; j++) {
 221                         Lisp_Object o1 = args[i], o2 = args[j];
 222                         ase_object_type_t o1t, o2t;
 223                         o1t = ase_optable_index(o1);
 224                         o2t = ase_optable_index(o2);
 225                         if (!_ent_binrel(rel, o1t, o1, o2t, o2))
 226                                 return 0;
 227                 }
 228         }
 229
 230         return 1;
 231 }
 232
 233 #if 0
 234 #define Flss            Fent_binrel_lessp
 235 #define Fgtr            Fent_binrel_greaterp
 236 #define Fleq            Fent_binrel_lessequalp
 237 #define Fgeq            Fent_binrel_greaterequalp
 238 #define Feqlsign        Fent_binrel_equalp
 239 #define Fneq            Fent_binrel_neqp
 240 #endif
 241 EXFUN(Fent_binrel_lessp, MANY);
 242 EXFUN(Fent_binrel_greaterp, MANY);
 243 EXFUN(Fent_binrel_lessequalp, MANY);
 244 EXFUN(Fent_binrel_greaterequalp, MANY);
 245 EXFUN(Fent_binrel_equalp, MANY);
 246 EXFUN(Fent_binrel_neqp, MANY);
 247 EXFUN(Fmin, MANY);
 248 EXFUN(Fmax, MANY);
 249
 250 extern void syms_of_ent_binary_rel(void);
 251 extern void vars_of_ent_binary_rel(void);
 252
 253 extern_inline Lisp_Object
 254 __ent_binrel_lift_1(
 255         ase_binary_relation_t rel,
 256         ase_object_type_t l1t, Lisp_Object l1,
 257         ase_object_type_t l2t, Lisp_Object l2,
 258         ent_lift_args_t la);
 259 extern_inline Lisp_Object
 260 __ent_binrel_lift_1(
 261         ase_binary_relation_t rel,
 262         ase_object_type_t l1t, Lisp_Object l1,
 263         ase_object_type_t l2t, Lisp_Object l2,
 264         ent_lift_args_t la);
 265 extern_inline Lisp_Object
 266 _ent_binrel_lift_1(
 267         ase_binary_relation_t rel,
 268         Lisp_Object l1, ase_object_type_t l2t, Lisp_Object l2,
 269         ent_lift_args_t la);
 270 extern_inline Lisp_Object
 271 ent_binrel_lift_1(
 272         ase_binary_relation_t op,
 273         Lisp_Object l1, Lisp_Object l2,
 274         ent_lift_args_t la);
 275 extern_inline Lisp_Object
 276 __ent_binrel_lift_2(
 277         ase_binary_relation_t rel,
 278         ase_object_type_t l1t, Lisp_Object l1,
 279         ase_object_type_t l2t, Lisp_Object l2,
 280         ent_lift_args_t la);
 281 extern_inline Lisp_Object
 282 _ent_binrel_lift_2(
 283         ase_binary_relation_t rel,
 284         ase_object_type_t l1t, Lisp_Object l1, Lisp_Object l2,
 285         ent_lift_args_t la);
 286 extern_inline Lisp_Object
 287 ent_binrel_lift_2(
 288         ase_binary_relation_t rel,
 289         Lisp_Object l1, Lisp_Object l2,
 290         ent_lift_args_t la);
 291
 292 \f
 293 /* lift to first or second arg and perform an operation */
 294 extern_inline Lisp_Object
 295 __ent_binrel_lift_1(ase_binary_relation_t rel,
 296                     ase_object_type_t l1t, Lisp_Object l1,
 297                     ase_object_type_t l2t, Lisp_Object l2,
 298                     ent_lift_args_t la)
 299 {
 300         /* lifts arg l1 to the world of l2 and calls the native op */
 301         Lisp_Object l1n = _ent_lift(l1t, l1, l2t, la);
 302         return ent_binrel(rel, l1n, l2);
 303 }
 304
 305 extern_inline Lisp_Object
 306 _ent_binrel_lift_1(ase_binary_relation_t rel,
 307                    Lisp_Object l1, ase_object_type_t l2t, Lisp_Object l2,
 308                    ent_lift_args_t la)
 309 {
 310         /* lifts l1 to l2t and calls the native op */
 311         ase_object_type_t l1t = ase_optable_index(l1);
 312         return __ent_binrel_lift_1(rel, l1t, l1, l2t, l2, la);
 313 }
 314
 315 extern_inline Lisp_Object
 316 ent_binrel_lift_1(ase_binary_relation_t op,
 317                   Lisp_Object l1, Lisp_Object l2,
 318                   ent_lift_args_t la)
 319 {
 320         /* lifts arg l1 to the world of l2 and calls the native op */
 321         ase_object_type_t l2t = ase_optable_index(l2);
 322         return _ent_binrel_lift_1(op, l1, l2t, l2, la);
 323 }
 324
 325 extern_inline Lisp_Object
 326 __ent_binrel_lift_2(ase_binary_relation_t rel,
 327                     ase_object_type_t l1t, Lisp_Object l1,
 328                     ase_object_type_t l2t, Lisp_Object l2,
 329                     ent_lift_args_t la)
 330 {
 331         /* lifts arg l2 to the world of l1 and calls the native op */
 332         Lisp_Object l2n = _ent_lift(l2t, l2, l1t, la);
 333         return ent_binrel(rel, l1, l2n);
 334 }
 335
 336 extern_inline Lisp_Object
 337 _ent_binrel_lift_2(ase_binary_relation_t rel,
 338                    ase_object_type_t l1t, Lisp_Object l1, Lisp_Object l2,
 339                    ent_lift_args_t la)
 340 {
 341         /* lifts l2 to l1t and calls the native op */
 342         ase_object_type_t l2t = ase_optable_index(l2);
 343         return __ent_binrel_lift_2(rel, l1t, l1, l2t, l2, la);
 344 }
 345
 346 extern_inline Lisp_Object
 347 ent_binrel_lift_2(ase_binary_relation_t rel,
 348                   Lisp_Object l1, Lisp_Object l2,
 349                   ent_lift_args_t la)
 350 {
 351         /* lifts arg l2 to the world of l1 and calls the native op */
 352         ase_object_type_t l1t = ase_optable_index(l1);
 353         return _ent_binrel_lift_2(rel, l1t, l1, l2, la);
 354 }
 355
 356 #endif  /* INCLUDED_ent_binary_rel_h_ */