cgit.sxemacs.org Git - sxemacs/blob - modules/ase/ase-interval.c

   1 /*** ase-interval.c -- Interval Sorcery
   2  *
   3  * Copyright (C) 2006-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
  38 /* Synched up with: Not in FSF. */
  39
  40 #include "config.h"
  41 #include "sxemacs.h"
  42 #include "ent/ent.h"
  43 #include "ase.h"
  44 #include "ase-interval.h"
  45
  46 #define EMODNAME        ase_interval
  47 PROVIDE(ase_interval);
  48 REQUIRE(ase_interval, "ase", "ase-cartesian");
  49
  50 Lisp_Object Q_open, Q_closed, Q_less, Q_greater, Q_eql, Q_unknown;
  51 Lisp_Object Q_disjoint, Q_connected;
  52 Lisp_Object Qase_interval, Qase_intervalp;
  53 Lisp_Object Qase_interval_union, Qase_interval_union_p;
  54 Lisp_Object Qase_empty_interval, Qase_universe_interval;
  55
  56 static struct ase_category_s __interval_cat = {
  57         .setoid_p = true,
  58         .magma_p = false,
  59         .algebra_p = false,
  60         .mapping_p = false,
  61         .relation_p = false,
  62         .orderable_p = true,
  63 };
  64 const ase_category_t ase_interval_cat = (const ase_category_t)&__interval_cat;
  65 typedef enum ase_interval_type_e ase_interval_type_t;
  66
  67 static inline int _ase_interval_less_p(ase_interval_t, ase_interval_t);
  68 static inline int _ase_interval_equal_p(ase_interval_t, ase_interval_t);
  69 static inline int ase_interval_less_p(Lisp_Object, Lisp_Object);
  70 static inline int ase_interval_equal_p(Lisp_Object, Lisp_Object);
  71
  72 static DOESNT_RETURN ase_interval_embedding_error(Lisp_Object, Lisp_Object);
  73 static ase_interval_type_t ase_interval_type(Lisp_Object o);
  74 static int _ase_normalise_union_intr(ase_interval_union_item_t);
  75
  76 static inline Lisp_Object ase_intersect_intv_intv(Lisp_Object, Lisp_Object);
  77 static inline Lisp_Object ase_intersect_intv_union(Lisp_Object, Lisp_Object);
  78 static inline Lisp_Object ase_intersect_intr_intr(Lisp_Object, Lisp_Object);
  79 static inline Lisp_Object ase_intersect_intr_union(Lisp_Object, Lisp_Object);
  80 static inline Lisp_Object ase_intersect_union_intv(Lisp_Object, Lisp_Object);
  81 static inline Lisp_Object ase_intersect_union_intr(Lisp_Object, Lisp_Object);
  82 static inline Lisp_Object ase_intersect_union_union(Lisp_Object, Lisp_Object);
  83
  84 static inline Lisp_Object ase_subtract_intv_intv(Lisp_Object, Lisp_Object);
  85 static inline Lisp_Object ase_subtract_intv_union(Lisp_Object, Lisp_Object);
  86 static inline Lisp_Object ase_subtract_intr_intr(Lisp_Object, Lisp_Object);
  87 static inline Lisp_Object ase_subtract_intr_union(Lisp_Object, Lisp_Object);
  88 static inline Lisp_Object ase_subtract_union_intv(Lisp_Object, Lisp_Object);
  89 static inline Lisp_Object ase_subtract_union_intr(Lisp_Object, Lisp_Object);
  90 static inline Lisp_Object ase_subtract_union_union(Lisp_Object, Lisp_Object);
  91
  92
  93 enum ase_interval_type_e {
  94         ASE_ITYPE_OBJECT,
  95         ASE_ITYPE_INTERVAL,
  96         ASE_ITYPE_INTERIOR,
  97         ASE_ITYPE_UNION,
  98         NUMBER_OF_ASE_ITYPES,
  99 };
 100
 101 /* the superset relation is a generalised version #'= */
 102 static ase_element_relation_f
 103 ase_optable_superset[NUMBER_OF_ASE_ITYPES][NUMBER_OF_ASE_ITYPES] = {
 104         /* OBJECT */
 105         {(ase_element_relation_f)ase_interval_embedding_error,
 106          (ase_element_relation_f)ase_interval_embedding_error,
 107          (ase_element_relation_f)ase_interval_embedding_error,
 108          (ase_element_relation_f)ase_interval_embedding_error},
 109         /* INTERVAL */
 110         {ase_interval_contains_obj_p,
 111          ase_interval_contains_intv_p,
 112          (ase_element_relation_f)ase_interval_embedding_error,
 113          ase_interval_contains_union_p},
 114         /* INTERIOR */
 115         {ase_interval_interior_contains_obj_p,
 116          (ase_element_relation_f)ase_interval_embedding_error,
 117          ase_interval_interior_contains_intr_p,
 118          ase_interval_interior_contains_union_p},
 119         /* UNION */
 120         {ase_interval_union_contains_obj_p,
 121          ase_interval_union_contains_intv_p,
 122          ase_interval_union_contains_intr_p,
 123          ase_interval_union_contains_union_p}};
 124
 125 /* the disjoint relation is a generalised version of #'/= */
 126 static ase_st_relation_f
 127 ase_optable_disjoint[NUMBER_OF_ASE_ITYPES][NUMBER_OF_ASE_ITYPES] = {
 128         /* OBJECT */
 129         {(ase_st_relation_f)ase_interval_embedding_error,
 130          (ase_st_relation_f)ase_interval_embedding_error,
 131          (ase_st_relation_f)ase_interval_embedding_error,
 132          (ase_st_relation_f)ase_interval_embedding_error},
 133         /* INTERVAL */
 134         {(ase_st_relation_f)ase_interval_embedding_error,
 135          ase_interval_disjoint_p,
 136          (ase_st_relation_f)ase_interval_embedding_error,
 137          ase_interval_disjoint_union_p},
 138         /* INTERIOR */
 139         {(ase_st_relation_f)ase_interval_embedding_error,
 140          (ase_st_relation_f)ase_interval_embedding_error,
 141          ase_interval_interior_disjoint_p,
 142          ase_interval_interior_disjoint_union_p},
 143         /* UNION */
 144         {(ase_st_relation_f)ase_interval_embedding_error,
 145          ase_interval_union_disjoint_intv_p,
 146          ase_interval_union_disjoint_intr_p,
 147          ase_interval_union_disjoint_p}};
 148
 149 /* the disjoint relation is a generalised version of #'/= */
 150 static ase_st_relation_f
 151 ase_optable_connected[NUMBER_OF_ASE_ITYPES][NUMBER_OF_ASE_ITYPES] = {
 152         /* OBJECT */
 153         {(ase_st_relation_f)ase_interval_embedding_error,
 154          (ase_st_relation_f)ase_interval_embedding_error,
 155          (ase_st_relation_f)ase_interval_embedding_error,
 156          (ase_st_relation_f)ase_interval_embedding_error},
 157         /* INTERVAL */
 158         {(ase_st_relation_f)ase_interval_embedding_error,
 159          ase_interval_connected_p,
 160          (ase_st_relation_f)ase_interval_embedding_error,
 161          ase_interval_connected_union_p},
 162         /* INTERIOR */
 163         {(ase_st_relation_f)ase_interval_embedding_error,
 164          (ase_st_relation_f)ase_interval_embedding_error,
 165          ase_interval_interior_connected_p,
 166          ase_interval_interior_connected_union_p},
 167         /* UNION */
 168         {(ase_st_relation_f)ase_interval_embedding_error,
 169          ase_interval_union_connected_intv_p,
 170          ase_interval_union_connected_intr_p,
 171          ase_interval_union_connected_p}};
 172
 173 /* the intersection operation */
 174 static ase_binary_operation_f
 175 ase_optable_intersect[NUMBER_OF_ASE_ITYPES][NUMBER_OF_ASE_ITYPES] = {
 176         /* OBJECT */
 177         {(ase_binary_operation_f)ase_interval_embedding_error,
 178          (ase_binary_operation_f)ase_interval_embedding_error,
 179          (ase_binary_operation_f)ase_interval_embedding_error,
 180          (ase_binary_operation_f)ase_interval_embedding_error},
 181         /* INTERVAL */
 182         {(ase_binary_operation_f)ase_interval_embedding_error,
 183          ase_intersect_intv_intv,
 184          (ase_binary_operation_f)ase_interval_embedding_error,
 185          ase_intersect_intv_union},
 186         /* INTERIOR */
 187         {(ase_binary_operation_f)ase_interval_embedding_error,
 188          (ase_binary_operation_f)ase_interval_embedding_error,
 189          ase_intersect_intr_intr,
 190          ase_intersect_intr_union},
 191         /* UNION */
 192         {(ase_binary_operation_f)ase_interval_embedding_error,
 193          ase_intersect_union_intv,
 194          ase_intersect_union_intr,
 195          ase_intersect_union_union}};
 196
 197 /* the difference operation */
 198 static ase_binary_operation_f
 199 ase_optable_subtract[NUMBER_OF_ASE_ITYPES][NUMBER_OF_ASE_ITYPES] = {
 200         /* OBJECT */
 201         {(ase_binary_operation_f)ase_interval_embedding_error,
 202          (ase_binary_operation_f)ase_interval_embedding_error,
 203          (ase_binary_operation_f)ase_interval_embedding_error,
 204          (ase_binary_operation_f)ase_interval_embedding_error},
 205         /* INTERVAL */
 206         {(ase_binary_operation_f)ase_interval_embedding_error,
 207          ase_subtract_intv_intv,
 208          (ase_binary_operation_f)ase_interval_embedding_error,
 209          ase_subtract_intv_union},
 210         /* INTERIOR */
 211         {(ase_binary_operation_f)ase_interval_embedding_error,
 212          (ase_binary_operation_f)ase_interval_embedding_error,
 213          ase_subtract_intr_intr,
 214          ase_subtract_intr_union},
 215         /* UNION */
 216         {(ase_binary_operation_f)ase_interval_embedding_error,
 217          ase_subtract_union_intv,
 218          ase_subtract_union_intr,
 219          ase_subtract_union_union}};
 220
 221 \f
 222 /* stuff for the dynacat, printers */
 223 static void
 224 _ase_interval_prnt(ase_interval_t a, Lisp_Object pcf)
 225 {
 226         if (a == NULL) {
 227                 write_c_string("( )", pcf);
 228                 return;
 229         }
 230
 231         if (a->lower_eq_upper_p) {
 232                 write_c_string("[", pcf);
 233                 print_internal(a->lower, pcf, 0);
 234                 write_c_string("]", pcf);
 235                 return;
 236         }
 237
 238         if (a->lower_open_p)
 239                 write_c_string("(", pcf);
 240         else
 241                 write_c_string("[", pcf);
 242         print_internal(a->lower, pcf, 0);
 243         write_c_string(" ", pcf);
 244         print_internal(a->upper, pcf, 0);
 245         if (a->upper_open_p)
 246                 write_c_string(")", pcf);
 247         else
 248                 write_c_string("]", pcf);
 249 }
 250
 251 static void
 252 _ase_interval_union_item_prnt(ase_interval_union_item_t u, Lisp_Object pcf)
 253 {
 254         dynacat_intprinter_f prfun = NULL;
 255         Lisp_Object o = u->current;
 256
 257         if ((prfun = get_dynacat_intprinter(o)) == NULL)
 258                 return;
 259
 260         prfun(get_dynacat(o), pcf);
 261         if (u->next)
 262                 write_c_string(" u ", pcf);
 263         return;
 264 }
 265
 266 static void
 267 _ase_interval_union_prnt(ase_interval_union_t i, Lisp_Object pcf)
 268 {
 269         ase_interval_union_item_t u = ase_interval_union(i);
 270         while (u) {
 271                 _ase_interval_union_item_prnt(u, pcf);
 272                 u = u->next;
 273         }
 274         return;
 275 }
 276
 277 static void
 278 ase_interval_prnt(Lisp_Object obj, Lisp_Object pcf, int unused)
 279 {
 280         EMOD_ASE_DEBUG_INTV("i:0x%08x@0x%08x (rc:%d)\n",
 281                             (unsigned int)(XASE_INTERVAL(obj)),
 282                             (unsigned int)obj,
 283                             (XASE_INTERVAL(obj) ?
 284                              XASE_INTERVAL_REFVAL(obj) : 1));
 285         write_c_string("#<ase:interval ", pcf);
 286         _ase_interval_prnt(XASE_INTERVAL(obj), pcf);
 287         write_c_string(">", pcf);
 288 }
 289
 290 static void
 291 ase_interval_union_prnt(Lisp_Object obj, Lisp_Object pcf, int unused)
 292 {
 293         EMOD_ASE_DEBUG_INTV("u:0x%08x@0x%08x (rc:%d)\n",
 294                             (unsigned int)(XASE_INTERVAL_UNION(obj)),
 295                             (unsigned int)obj,
 296                             (XASE_INTERVAL_UNION(obj) ?
 297                              XASE_INTERVAL_UNION_REFVAL(obj) : 1));
 298         write_c_string("#<ase:interval-union ", pcf);
 299         _ase_interval_union_prnt(XASE_INTERVAL_UNION(obj), pcf);
 300         write_c_string(">", pcf);
 301         return;
 302 }
 303
 304 /* stuff for the dynacat, finalisers */
 305 static void
 306 _ase_interval_union_item_fini(ase_interval_union_item_t u)
 307 {
 308         EMOD_ASE_DEBUG_GC("uitem:0x%08x refcnt vanished, freeing\n",
 309                           (unsigned int)u);
 310         if (!u)
 311                 return;
 312         if (u->current &&
 313             ASE_INTERVALP(u->current) &&
 314             !ASE_INTERVAL_EMPTY_P(u->current))
 315                 XASE_INTERVAL_DECREF(u->current);
 316         xfree(u);
 317         return;
 318 }
 319
 320 static void
 321 _ase_interval_union_fini(ase_interval_union_item_t u)
 322 {
 323         ase_interval_union_item_t tmp;
 324         while (u) {
 325                 u = (tmp = u)->next;
 326                 _ase_interval_union_item_fini(tmp);
 327         }
 328         return;
 329 }
 330
 331 static void
 332 _ase_interval_fini(ase_interval_t a)
 333 {
 334         EMOD_ASE_DEBUG_GC("i:0x%08x (rc:%d) shall be freed...\n",
 335                           (unsigned int)(a), ase_interval_refval(a));
 336
 337         if (ase_interval_decref(a) <= 0) {
 338                 ase_interval_fini_refcnt(a);
 339                 xfree(a);
 340         } else {
 341                 EMOD_ASE_DEBUG_GC("VETO! References exist\n");
 342         }
 343         return;
 344 }
 345
 346 static void
 347 ase_interval_fini(Lisp_Object obj, int unused)
 348 {
 349         ase_interval_t a = XASE_INTERVAL(obj);
 350
 351         if (ase_interval_empty_p(a))
 352                 return;
 353
 354         _ase_interval_fini(a);
 355         return;
 356 }
 357
 358 static void
 359 ase_interval_union_fini(Lisp_Object obj, int unused)
 360 {
 361         ase_interval_union_t i = XASE_INTERVAL_UNION(obj);
 362
 363         if (i == NULL)
 364                 return;
 365
 366         EMOD_ASE_DEBUG_GC("u:0x%08x@0x%08x (rc:%d) shall be freed...\n",
 367                           (unsigned int)(i), (unsigned int)obj,
 368                           ase_interval_union_refval(i));
 369
 370         if (ase_interval_union_decref(i) <= 0) {
 371                 _ase_interval_union_fini(ase_interval_union(i));
 372                 ase_interval_union_fini_refcnt(i);
 373                 xfree(i);
 374         } else {
 375                 EMOD_ASE_DEBUG_GC("VETO! References exist\n");
 376         }
 377         return;
 378 }
 379
 380 /* stuff for the dynacat, markers */
 381 static void
 382 _ase_interval_mark(ase_interval_t a)
 383 {
 384         if (a == NULL)
 385                 return;
 386
 387         mark_object(a->lower);
 388         mark_object(a->upper);
 389         mark_object(a->lebesgue_measure);
 390         mark_object(a->rational_measure);
 391         mark_object(a->colour);
 392         return;
 393 }
 394
 395 static void
 396 _ase_interval_union_item_mark(ase_interval_union_item_t u)
 397 {
 398         mark_object(u->current);
 399 }
 400
 401 static void
 402 _ase_interval_union_mark(ase_interval_union_t i)
 403 {
 404         ase_interval_union_item_t u = ase_interval_union(i);
 405
 406         mark_object(i->lebesgue_measure);
 407         mark_object(i->rational_measure);
 408         mark_object(i->colour);
 409
 410         while (u) {
 411                 _ase_interval_union_item_mark(u);
 412                 u = u->next;
 413         }
 414         return;
 415 }
 416
 417 static void
 418 ase_interval_mark(Lisp_Object obj)
 419 {
 420         EMOD_ASE_DEBUG_INTV("i:0x%08x@0x%08x (rc:%d) shall be marked...\n",
 421                             (unsigned int)(XASE_INTERVAL(obj)),
 422                             (unsigned int)obj,
 423                             (XASE_INTERVAL(obj) ?
 424                              XASE_INTERVAL_REFVAL(obj) : 1));
 425         _ase_interval_mark(XASE_INTERVAL(obj));
 426         return;
 427 }
 428
 429 static void
 430 ase_interval_union_mark(Lisp_Object obj)
 431 {
 432         EMOD_ASE_DEBUG_INTV("u:0x%08x@0x%08x (rc:%d) shall be marked...\n",
 433                             (unsigned int)(XASE_INTERVAL_UNION(obj)),
 434                             (unsigned int)obj,
 435                             (XASE_INTERVAL_UNION(obj) ?
 436                              XASE_INTERVAL_UNION_REFVAL(obj) : 1));
 437         _ase_interval_union_mark(XASE_INTERVAL_UNION(obj));
 438         return;
 439 }
 440
 441 \f
 442 Lisp_Object
 443 _ase_wrap_interval(ase_interval_t a)
 444 {
 445         Lisp_Object result;
 446
 447         result = make_dynacat(a);
 448         XDYNACAT(result)->type = Qase_interval;
 449
 450         if (a)
 451                 ase_interval_incref(a);
 452
 453         set_dynacat_printer(result, ase_interval_prnt);
 454         set_dynacat_marker(result, ase_interval_mark);
 455         set_dynacat_finaliser(result, ase_interval_fini);
 456         set_dynacat_intprinter(
 457                 result, (dynacat_intprinter_f)_ase_interval_prnt);
 458
 459         EMOD_ASE_DEBUG_INTV("i:0x%08x (rc:%d) shall be wrapped to 0x%08x...\n",
 460                             (unsigned int)a,
 461                             (a ? ase_interval_refval(a) : 1),
 462                             (unsigned int)result);
 463
 464         return result;
 465 }
 466
 467 Lisp_Object
 468 _ase_wrap_interval_union(ase_interval_union_t iu)
 469 {
 470         Lisp_Object result;
 471
 472         result = make_dynacat(iu);
 473         XDYNACAT(result)->type = Qase_interval_union;
 474
 475         if (iu)
 476                 ase_interval_union_incref(iu);
 477
 478         set_dynacat_printer(result, ase_interval_union_prnt);
 479         set_dynacat_marker(result, ase_interval_union_mark);
 480         set_dynacat_finaliser(result, ase_interval_union_fini);
 481         set_dynacat_intprinter(
 482                 result, (dynacat_intprinter_f)_ase_interval_union_prnt);
 483
 484         EMOD_ASE_DEBUG_INTV("u:0x%016lx (rc:%d) "
 485                             "shall be wrapped to 0x%016lx...\n",
 486                             (long unsigned int)iu,
 487                             (iu ? ase_interval_union_refval(iu) : 1),
 488                             (long unsigned int)result);
 489
 490         return result;
 491 }
 492
 493 ase_interval_t
 494 _ase_make_interval(Lisp_Object lower, Lisp_Object upper,
 495                    int lower_open_p, int upper_open_p)
 496 {
 497         ase_interval_t a = NULL;
 498         int lequ_p;
 499
 500         if ((lequ_p = _ase_equal_p(lower, upper)) &&
 501             (lower_open_p || upper_open_p)) {
 502                 return NULL;
 503         }
 504
 505         a = xnew(struct ase_interval_s);
 506
 507         a->obj.category = ase_interval_cat;
 508
 509         a->lower = lower;
 510         a->upper = upper;
 511         a->lower_eq_upper_p = lequ_p;
 512         if (!INFINITYP(lower))
 513                 a->lower_open_p = lower_open_p;
 514         else
 515                 a->lower_open_p = 1;
 516         if (!INFINITYP(upper))
 517                 a->upper_open_p = upper_open_p;
 518         else
 519                 a->upper_open_p = 1;
 520         a->lebesgue_measure = Qnil;
 521         a->rational_measure = Qnil;
 522         a->colour = Qnil;
 523
 524         ase_interval_init_refcnt(a);
 525
 526         EMOD_ASE_DEBUG_INTV("i:0x%08x (rc:0) shall be created...\n",
 527                             (unsigned int)a);
 528         return a;
 529 }
 530
 531 static ase_interval_union_item_t
 532 _ase_make_interval_union_item(Lisp_Object intv)
 533 {
 534         ase_interval_union_item_t u = xnew(struct ase_interval_union_item_s);
 535
 536         u->next = NULL;
 537         u->current = intv;
 538         if (ASE_INTERVALP(intv) && !ASE_INTERVAL_EMPTY_P(intv))
 539                 XASE_INTERVAL_INCREF(intv);
 540
 541         EMOD_ASE_DEBUG_INTV("uitem:0x%08x shall be created...\n",
 542                             (unsigned int)u);
 543         return u;
 544 }
 545
 546 static ase_interval_union_t
 547 _ase_make_interval_union(ase_interval_union_item_t ui)
 548 {
 549         ase_interval_union_t i = xnew(struct ase_interval_union_s);
 550
 551         i->union_ser = ui;
 552         i->lebesgue_measure = Qnil;
 553         i->rational_measure = Qnil;
 554         i->colour = Qnil;
 555
 556         i->no_intv = 1;
 557         ase_interval_union_init_refcnt(i);
 558
 559         EMOD_ASE_DEBUG_INTV("u:0x%08x (rc:0) shall be created...\n",
 560                             (unsigned int)i);
 561         return i;
 562 }
 563
 564
 565 Lisp_Object ase_empty_interval(void)
 566 {
 567         Lisp_Object result = Qnil;
 568
 569         XSETASE_INTERVAL(result, NULL);
 570
 571         return result;
 572 }
 573
 574 Lisp_Object ase_empty_interval_union(void)
 575 {
 576         Lisp_Object result = Qnil;
 577         ase_interval_union_item_t u = NULL;
 578         ase_interval_union_t i = NULL;
 579
 580         u = _ase_make_interval_union_item(Qase_empty_interval);
 581         i = _ase_make_interval_union(u);
 582
 583         XSETASE_INTERVAL_UNION(result, i);
 584
 585         return result;
 586 }
 587
 588 Lisp_Object ase_universe_interval(void)
 589 {
 590         ase_interval_t a = xnew(struct ase_interval_s);
 591
 592         a->lower = Vninfinity;
 593         a->upper = Vpinfinity;
 594         a->lower_eq_upper_p = 0;
 595         a->lower_open_p = 1;
 596         a->upper_open_p = 1;
 597         a->lebesgue_measure = Qnil;
 598         a->rational_measure = Qnil;
 599         a->colour = Qnil;
 600
 601         ase_interval_init_refcnt(a);
 602         return _ase_wrap_interval(a);
 603 }
 604
 605 Lisp_Object ase_make_interval(Lisp_Object lower, Lisp_Object upper,
 606                               int l_open_p, int u_open_p)
 607 {
 608         ase_interval_t a = NULL;
 609         Lisp_Object result = Qnil;
 610
 611         a = _ase_make_interval(lower, upper, l_open_p, u_open_p);
 612         XSETASE_INTERVAL(result, a);
 613
 614         return result;
 615 }
 616
 617
 618 static DOESNT_RETURN
 619 ase_interval_embedding_error(Lisp_Object o1, Lisp_Object o2)
 620 {
 621         ase_cartesian_embedding_error(o1, o2);
 622         return;
 623 }
 624
 625 /* we have 3 different arithmetics:
 626  * - comparison and ordering of lower bounds
 627  * - comparison and ordering of upper bounds
 628  * - comparison and ordering of an upper bound with a lower bound
 629  */
 630 bool            /* inline this? */
 631 _ase_interval_contains_obj_p(ase_interval_t a, Lisp_Object obj)
 632 {
 633         if (UNLIKELY(a == NULL)) {
 634                 return false;
 635         }
 636
 637         if ((a->lower_open_p
 638              ? _ase_less_p(a->lower, obj)
 639              : _ase_lessequal_p(a->lower, obj)) &&
 640             (a->upper_open_p
 641              ? _ase_greater_p(a->upper, obj)
 642              : _ase_greaterequal_p(a->upper, obj))) {
 643                 return true;
 644         } else {
 645                 return false;
 646         }
 647 }
 648
 649 int             /* inline this? */
 650 _ase_interval_contains_intv_p(ase_interval_t a1, ase_interval_t a2)
 651 {
 652         int result = 1;
 653
 654         if (UNLIKELY(a1 == NULL))
 655                 return 0;
 656         if (UNLIKELY(a2 == NULL))
 657                 return -1;
 658
 659         if (LIKELY(a2->lower_open_p)) {
 660                 result &= (_ase_interval_contains_obj_p(a1, a2->lower) ||
 661                             _ase_equal_p(a1->lower, a2->lower));
 662         } else {
 663                 result &= _ase_interval_contains_obj_p(a1, a2->lower);
 664         }
 665
 666         if (LIKELY(a2->upper_open_p)) {
 667                 result &= (_ase_interval_contains_obj_p(a1, a2->upper) ||
 668                             _ase_equal_p(a1->upper, a2->upper));
 669         } else {
 670                 result &= _ase_interval_contains_obj_p(a1, a2->upper);
 671         }
 672
 673         return result;
 674 }
 675
 676 static int
 677 _ase_interval_contains_union_p(ase_interval_t a, ase_interval_union_t i)
 678 {
 679         /* true iff a \supset j \forall j in i */
 680         ase_interval_union_item_t u = ase_interval_union(i);
 681         while (u) {
 682                 if (!_ase_interval_contains_intv_p(
 683                             a, XASE_INTERVAL(u->current)))
 684                         return 0;
 685                 u = u->next;
 686         }
 687         return -1;
 688 }
 689
 690 static int
 691 _ase_interval_less_p(ase_interval_t a1, ase_interval_t a2)
 692 {
 693         if (a1 == NULL)
 694                 return 0;
 695         if (a2 == NULL)
 696                 return 1;
 697
 698         /* should suffice to compare the lower bounds */
 699         return (_ase_less_p(a1->lower, a2->lower) ||
 700                 (!a1->lower_open_p && a2->lower_open_p &&
 701                  _ase_equal_p(a1->lower, a2->lower)));
 702 }
 703 static int
 704 _ase_interval_equal_p(ase_interval_t a1, ase_interval_t a2)
 705 {
 706         /* trivial case */
 707         if (!a1 && !a2)
 708                 return 1;
 709         else if (!a1)
 710                 return 0;
 711         else if (!a2)
 712                 return 0;
 713         else if (a1->lower_eq_upper_p && a2->lower_eq_upper_p)
 714                 return _ase_equal_p(a1->lower, a2->lower);
 715         else if (a1->lower_eq_upper_p)
 716                 return 0;
 717         else if (a2->lower_eq_upper_p)
 718                 return 0;
 719
 720         return (_ase_interval_contains_intv_p(a1, a2) &&
 721                 _ase_interval_contains_intv_p(a2, a1));
 722 }
 723
 724 static int
 725 ase_interval_less_p(Lisp_Object a1, Lisp_Object a2)
 726 {
 727         if (ASE_INTERVALP(a1) && ASE_INTERVALP(a2)) {
 728                 return _ase_interval_less_p(
 729                         XASE_INTERVAL(a1), XASE_INTERVAL(a2));
 730         }
 731         return 0;
 732 }
 733
 734 static int
 735 ase_interval_equal_p(Lisp_Object a1, Lisp_Object a2)
 736 {
 737         if (ASE_INTERVALP(a1) && ASE_INTERVALP(a2)) {
 738                 return _ase_interval_equal_p(
 739                         XASE_INTERVAL(a1), XASE_INTERVAL(a2));
 740         }
 741         return 0;
 742 }
 743
 744 static int
 745 ase_interval_or_union_less_p(Lisp_Object a1, Lisp_Object a2)
 746 {
 747         Lisp_Object na1, na2;
 748         if (ASE_INTERVAL_UNION_P(a1))
 749                 na1 = XASE_INTERVAL_UNION_FIRST(a1);
 750         else
 751                 na1 = a1;
 752         if (ASE_INTERVAL_UNION_P(a2))
 753                 na2 = XASE_INTERVAL_UNION_FIRST(a2);
 754         else
 755                 na2 = a2;
 756         return ase_interval_less_p(na1, na2);
 757 }
 758
 759 static inline bool
 760 _ase_interval_bounds_connected_p(ase_interval_t a1, ase_interval_t a2)
 761 {
 762 /* only compares upper with lower bound, assumes numerical equality */
 763         if (a1->upper_open_p && a2->lower_open_p) {
 764                 return false;
 765         } else {
 766                 return true;
 767         }
 768 }
 769
 770 static inline int
 771 _ase_interval_bounds_disjoint_p(ase_interval_t a1, ase_interval_t a2)
 772 {
 773 /* only compares upper with lower bound, assumes numerical equality */
 774         if (!a1->upper_open_p && !a2->lower_open_p) {
 775                 return false;
 776         } else {
 777                 return true;
 778         }
 779 }
 780
 781 static Lisp_Object
 782 _ase_interval_interior_contains_obj_p(
 783         ase_cartesian_t iip1, ase_cartesian_t iip2)
 784 {
 785         return ase_cartesian_pointwise_erel_p(
 786                 iip1, iip2, ase_interval_contains_obj_p);
 787 }
 788
 789 static Lisp_Object
 790 _ase_interval_interior_contains_intr_p(
 791         ase_cartesian_t iip1, ase_cartesian_t iip2)
 792 {
 793         return ase_cartesian_pointwise_erel_p(
 794                 iip1, iip2, ase_interval_contains_intv_p);
 795 }
 796
 797 static Lisp_Object
 798 _ase_interval_interior_contains_union_p(
 799         ase_cartesian_t iip1, ase_interval_union_t iu)
 800 {
 801         /* true iff a \supset j \forall j in i */
 802         ase_interval_union_item_t u = ase_interval_union(iu);
 803         while (u) {
 804                 if (!_ase_interval_interior_contains_intr_p(
 805                             iip1, XASE_CARTESIAN(u->current)))
 806                         return Qnil;
 807                 u = u->next;
 808         }
 809         return Qt;
 810 }
 811
 812 static Lisp_Object
 813 _ase_interval_union_contains_obj_p(ase_interval_union_t iu, Lisp_Object obj)
 814 {
 815         ase_interval_union_item_t u = ase_interval_union(iu);
 816         Lisp_Object atmp = 0;
 817
 818         while (u) {
 819                 atmp = u->current;
 820                 if (ASE_INTERVALP(atmp)) {
 821                         if (_ase_interval_contains_obj_p(
 822                                     XASE_INTERVAL(atmp), obj))
 823                                 return atmp;
 824                 } else if (ASE_INTERVAL_INTERIOR_P(atmp)) {
 825                         if (!NILP(_ase_interval_interior_contains_obj_p(
 826                                           XASE_CARTESIAN(atmp),
 827                                           XASE_CARTESIAN(obj))))
 828                                 return atmp;
 829                 }
 830                 u = u->next;
 831         }
 832         return Qnil;
 833 }
 834
 835 static Lisp_Object
 836 _ase_interval_union_contains_intv_p(ase_interval_union_t iu, ase_interval_t a)
 837 {
 838         ase_interval_union_item_t u = ase_interval_union(iu);
 839         Lisp_Object atmp = 0;
 840
 841         while (u) {
 842                 atmp = u->current;
 843                 if (_ase_interval_contains_intv_p(XASE_INTERVAL(atmp), a))
 844                         return atmp;
 845                 u = u->next;
 846         }
 847         return Qnil;
 848 }
 849
 850 static Lisp_Object
 851 _ase_interval_union_contains_intr_p(
 852         ase_interval_union_t iu, ase_cartesian_t iip)
 853 {
 854         ase_interval_union_item_t u = ase_interval_union(iu);
 855         Lisp_Object atmp = 0;
 856
 857         while (u) {
 858                 atmp = u->current;
 859                 if (_ase_interval_interior_contains_intr_p(
 860                             XASE_CARTESIAN(atmp), iip))
 861                         return atmp;
 862                 u = u->next;
 863         }
 864         return Qnil;
 865 }
 866
 867 static Lisp_Object
 868 _ase_interval_union_contains_union_p(
 869         ase_interval_union_t iu1, ase_interval_union_t iu2)
 870 {
 871         /* true iff \forall a \in iu2 \exists b \in iu1 : b \supset a */
 872         ase_interval_union_item_t u1, u2;
 873
 874         u1 = ase_interval_union(iu1);
 875         u2 = ase_interval_union(iu2);
 876
 877         while (u2 && u1) {
 878                 Lisp_Object o1 = u1->current, o2 = u2->current;
 879                 if (ASE_INTERVALP(o1)) {
 880                         ase_interval_t a1 = XASE_INTERVAL(o1);
 881                         ase_interval_t a2 = XASE_INTERVAL(o2);
 882                         if (_ase_interval_contains_intv_p(a1, a2))
 883                                 u2 = u2->next;
 884                         else
 885                                 u1 = u1->next;
 886                 } else if (ASE_INTERVAL_INTERIOR_P(o1)) {
 887                         ase_cartesian_t c1 = XASE_CARTESIAN(o1);
 888                         ase_cartesian_t c2 = XASE_CARTESIAN(o2);
 889                         if (_ase_interval_interior_contains_intr_p(c1, c2))
 890                                 u2 = u2->next;
 891                         else
 892                                 u1 = u1->next;
 893                 }
 894         }
 895         if (u2 == NULL)
 896                 return Qt;
 897         return Qnil;
 898 }
 899
 900 static int
 901 _ase_interval_connected_p(ase_interval_t a1, ase_interval_t a2)
 902 {
 903         if (a1 == NULL || a2 == NULL)
 904                 return 1;
 905
 906         if (_ase_equal_p(a1->upper, a2->lower)) {
 907                 return (_ase_interval_bounds_connected_p(a1, a2));
 908         } else if (_ase_equal_p(a1->lower, a2->upper)) {
 909                 return (_ase_interval_bounds_connected_p(a2, a1) << 1);
 910         } else if (_ase_interval_contains_obj_p(a1, a2->lower) ||
 911                    _ase_interval_contains_obj_p(a2, a1->upper)) {
 912                 return 1;
 913         } else if (_ase_interval_contains_obj_p(a1, a2->upper) ||
 914                    _ase_interval_contains_obj_p(a2, a1->lower)) {
 915                 return 2;
 916         } else
 917                 return 0;
 918 }
 919
 920 static int
 921 _ase_interval_interior_connected_p(
 922         ase_cartesian_t iip1, ase_cartesian_t iip2)
 923 {
 924         /* true iff componentwise connected */
 925         return ase_cartesian_pointwise_rel_p(
 926                 iip1, iip2, ase_interval_connected_p);
 927 }
 928
 929 static int
 930 _ase_interval_union_intv_connected_p(
 931         ase_interval_union_t iu, ase_interval_t i)
 932 {
 933         /* true iff \forall j \in iu : j u i is connected */
 934         ase_interval_union_item_t u = ase_interval_union(iu);
 935
 936         while (u) {
 937                 ase_interval_t a = XASE_INTERVAL(u->current);
 938                 if (!_ase_interval_connected_p(a, i))
 939                         return 0;
 940                 u = u->next;
 941         }
 942         return 1;
 943 }
 944
 945 static int
 946 _ase_interval_union_intr_connected_p(
 947         ase_interval_union_t iu, ase_cartesian_t c)
 948 {
 949         /* true iff \forall j \in iu : j u i is connected */
 950         ase_interval_union_item_t u = ase_interval_union(iu);
 951
 952         while (u) {
 953                 ase_cartesian_t t = XASE_CARTESIAN(u->current);
 954                 if (!_ase_interval_interior_connected_p(t, c))
 955                         return 0;
 956                 u = u->next;
 957         }
 958         return 1;
 959 }
 960
 961 static int
 962 _ase_interval_union_connected_p(
 963         ase_interval_union_t iu1, ase_interval_union_t iu2)
 964 {
 965         /* true iff iu1 u iu2 is connected, i.e.
 966          * iff \forall i \in iu1 : i u iu2 is connected */
 967         ase_interval_union_item_t u1 = ase_interval_union(iu1);
 968
 969         while (u1) {
 970                 if (ASE_INTERVALP(u1->current)) {
 971                         if (!_ase_interval_union_intv_connected_p(
 972                                     iu2, XASE_INTERVAL(u1->current)))
 973                                 return 0;
 974                 } else if (ASE_INTERVAL_INTERIOR_P(u1->current)) {
 975                         if (!_ase_interval_union_intr_connected_p(
 976                                     iu2, XASE_CARTESIAN(u1->current)))
 977                                 return 0;
 978                 }
 979                 u1 = u1->next;
 980         }
 981         return 1;
 982 }
 983
 984 static int
 985 _ase_interval_disjoint_p(ase_interval_t a1, ase_interval_t a2)
 986 {
 987         if (a1 == NULL || a2 == NULL)
 988                 return 1;
 989
 990         if (_ase_equal_p(a1->upper, a2->lower)) {
 991                 return _ase_interval_bounds_disjoint_p(a1, a2);
 992         } else if (_ase_equal_p(a1->lower, a2->upper)) {
 993                 return _ase_interval_bounds_disjoint_p(a2, a1);
 994         } else {
 995                 return !((_ase_interval_contains_obj_p(a1, a2->lower)) ||
 996                          (_ase_interval_contains_obj_p(a1, a2->upper)) ||
 997                          (_ase_interval_contains_obj_p(a2, a1->lower)) ||
 998                          (_ase_interval_contains_obj_p(a2, a1->upper)));
 999         }
1000 }
1001
1002 static int
1003 _ase_interval_interior_disjoint_p(
1004         ase_cartesian_t iip1, ase_cartesian_t iip2)
1005 {
1006         /* true iff iip1 n iip2 = ( ), i.e.
1007          * component-intervals are disjoint in at least one dimension */
1008         return ase_cartesian_antipointwise_rel_p(
1009                 iip1, iip2, ase_interval_disjoint_p);
1010 }
1011
1012 static int
1013 _ase_interval_union_disjoint_intv_p(
1014         ase_interval_union_t iu1, ase_interval_t i2)
1015 {
1016         /* true iff \forall i \in iu1 : i n i2 = ( ) */
1017         ase_interval_union_item_t u = ase_interval_union(iu1);
1018
1019         while (u) {
1020                 ase_interval_t a1 = XASE_INTERVAL(u->current);
1021                 if (!_ase_interval_disjoint_p(a1, i2))
1022                         return 0;
1023                 u = u->next;
1024         }
1025         return -1;
1026 }
1027
1028 static int
1029 _ase_interval_union_disjoint_intr_p(
1030         ase_interval_union_t iu, ase_cartesian_t c)
1031 {
1032         /* true iff \forall i \in iu1 : i n i2 = ( ) */
1033         ase_interval_union_item_t u = ase_interval_union(iu);
1034
1035         while (u) {
1036                 ase_cartesian_t t = XASE_CARTESIAN(u->current);
1037                 if (!_ase_interval_interior_disjoint_p(t, c))
1038                         return 0;
1039                 u = u->next;
1040         }
1041         return -1;
1042 }
1043
1044 static int
1045 _ase_interval_union_disjoint_p(
1046         ase_interval_union_t iu1, ase_interval_union_t iu2)
1047 {
1048         /* true iff i1 n i2 = ( ), i.e.
1049          * iff \forall i \in i1 \forall j \in i2 : i n j = ( ) */
1050         ase_interval_union_item_t u1 = ase_interval_union(iu1);
1051
1052         while (u1) {
1053                 if (ASE_INTERVALP(u1->current)) {
1054                         if (!_ase_interval_union_disjoint_intv_p(
1055                                     iu2, XASE_INTERVAL(u1->current)))
1056                                 return 0;
1057                 } else if (ASE_INTERVAL_INTERIOR_P(u1->current)) {
1058                         if (!_ase_interval_union_disjoint_intr_p(
1059                                     iu2, XASE_CARTESIAN(u1->current)))
1060                                 return 0;
1061                 }
1062                 u1 = u1->next;
1063         }
1064         return -1;
1065 }
1066
1067 static inline int
1068 _ase_interval_open_p(ase_interval_t a)
1069 {
1070         return ((a == NULL) || (a->lower_open_p && a->upper_open_p));
1071 }
1072
1073 static inline int
1074 _ase_interval_closed_p(ase_interval_t a)
1075 {
1076         return ((a == NULL) ||
1077                 ((!a->lower_open_p || INFINITYP(a->lower)) &&
1078                  (!a->upper_open_p || INFINITYP(a->upper))));
1079 }
1080
1081 static int
1082 _ase_interval_union_open_p(ase_interval_union_item_t u)
1083 {
1084         while (u) {
1085                 if (ASE_INTERVALP(u->current)) {
1086                         if (!_ase_interval_open_p(XASE_INTERVAL(u->current)))
1087                                 return 0;
1088                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
1089                         if (!ase_interval_interior_open_p(u->current))
1090                                 return 0;
1091                 }
1092                 u = u->next;
1093         }
1094         return 1;
1095 }
1096
1097 static int
1098 _ase_interval_union_closed_p(ase_interval_union_item_t u)
1099 {
1100         while (u) {
1101                 if (ASE_INTERVALP(u->current)) {
1102                         if (!_ase_interval_closed_p(XASE_INTERVAL(u->current)))
1103                                 return 0;
1104                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
1105                         if (!ase_interval_interior_closed_p(u->current))
1106                                 return 0;
1107                 }
1108                 u = u->next;
1109         }
1110         return 1;
1111 }
1112
1113 Lisp_Object
1114 ase_interval_contains_obj_p(Lisp_Object interval, Lisp_Object obj)
1115 {
1116         if (_ase_interval_contains_obj_p(
1117                     XASE_INTERVAL(interval), obj))
1118                 return interval;
1119         return Qnil;
1120 }
1121
1122 Lisp_Object
1123 ase_interval_contains_intv_p(Lisp_Object i1, Lisp_Object i2)
1124 {
1125         if (_ase_interval_contains_intv_p(
1126                     XASE_INTERVAL(i1), XASE_INTERVAL(i2)))
1127                 return i1;
1128         return Qnil;
1129 }
1130
1131 Lisp_Object
1132 ase_interval_contains_union_p(Lisp_Object i, Lisp_Object u)
1133 {
1134         /* true iff i \supset j \forall j in u */
1135         if (_ase_interval_contains_union_p(
1136                     XASE_INTERVAL(i), XASE_INTERVAL_UNION(u)))
1137                 return Qt;
1138         return Qnil;
1139 }
1140
1141 Lisp_Object
1142 ase_interval_union_contains_obj_p(Lisp_Object iu, Lisp_Object obj)
1143 {
1144         return _ase_interval_union_contains_obj_p(
1145                 XASE_INTERVAL_UNION(iu), obj);
1146 }
1147
1148 Lisp_Object
1149 ase_interval_union_contains_intv_p(Lisp_Object iu, Lisp_Object i)
1150 {
1151         return _ase_interval_union_contains_intv_p(
1152                 XASE_INTERVAL_UNION(iu), XASE_INTERVAL(i));
1153 }
1154
1155 Lisp_Object
1156 ase_interval_union_contains_intr_p(Lisp_Object iu, Lisp_Object iip)
1157 {
1158         return _ase_interval_union_contains_intr_p(
1159                 XASE_INTERVAL_UNION(iu), XASE_CARTESIAN(iip));
1160 }
1161
1162 Lisp_Object
1163 ase_interval_union_contains_union_p(Lisp_Object iu1, Lisp_Object iu2)
1164 {
1165         /* true iff \forall a \in iu2 \exists b \in iu1 : b \supset a */
1166         return _ase_interval_union_contains_union_p(
1167                 XASE_INTERVAL_UNION(iu1), XASE_INTERVAL_UNION(iu2));
1168 }
1169
1170 Lisp_Object
1171 ase_interval_interior_contains_obj_p(Lisp_Object iip1, Lisp_Object iip2)
1172 {
1173         if (!ASE_CARTESIAN_INTERIOR_P(iip2) ||
1174             XASE_CARTESIAN_DIMENSION(iip1) !=
1175             XASE_CARTESIAN_DIMENSION(iip2) ||
1176             !EQ(XASE_CARTESIAN_INTERIOR_TYPE(iip1), Qase_interval)) {
1177                 signal_error(Qembed_error, list2(iip1, iip2));
1178                 return Qnil;
1179         }
1180
1181         return _ase_interval_interior_contains_obj_p(
1182                 XASE_CARTESIAN(iip1), XASE_CARTESIAN(iip2));
1183 }
1184
1185 Lisp_Object
1186 ase_interval_interior_contains_intr_p(Lisp_Object iip1, Lisp_Object iip2)
1187 {
1188         if (XASE_CARTESIAN_DIMENSION(iip1) !=
1189             XASE_CARTESIAN_DIMENSION(iip2) ||
1190             !EQ(XASE_CARTESIAN_INTERIOR_TYPE(iip1), Qase_interval) ||
1191             !EQ(XASE_CARTESIAN_INTERIOR_TYPE(iip2), Qase_interval)) {
1192                 signal_error(Qembed_error, list2(iip1, iip2));
1193                 return Qnil;
1194         }
1195         return _ase_interval_interior_contains_intr_p(
1196                 XASE_CARTESIAN(iip1), XASE_CARTESIAN(iip2));
1197 }
1198
1199 Lisp_Object
1200 ase_interval_interior_contains_union_p(Lisp_Object iip, Lisp_Object iu)
1201 {
1202         return _ase_interval_interior_contains_union_p(
1203                 XASE_CARTESIAN(iip), XASE_INTERVAL_UNION(iu));
1204 }
1205
1206 int ase_interval_connected_p(Lisp_Object i1, Lisp_Object i2)
1207 {
1208         return _ase_interval_connected_p(XASE_INTERVAL(i1), XASE_INTERVAL(i2));
1209 }
1210
1211 int ase_interval_connected_union_p(Lisp_Object i, Lisp_Object iu)
1212 {
1213         return _ase_interval_union_intv_connected_p(
1214                 XASE_INTERVAL_UNION(iu), XASE_INTERVAL(i));
1215 }
1216
1217 int ase_interval_union_connected_intv_p(Lisp_Object iu, Lisp_Object i)
1218 {
1219         return _ase_interval_union_intv_connected_p(
1220                 XASE_INTERVAL_UNION(iu), XASE_INTERVAL(i));
1221 }
1222
1223 int ase_interval_union_connected_intr_p(Lisp_Object iu, Lisp_Object c)
1224 {
1225         return _ase_interval_union_intr_connected_p(
1226                 XASE_INTERVAL_UNION(iu), XASE_CARTESIAN(c));
1227 }
1228
1229 int ase_interval_union_connected_p(Lisp_Object i1, Lisp_Object i2)
1230 {
1231         return _ase_interval_union_connected_p(
1232                 XASE_INTERVAL_UNION(i1), XASE_INTERVAL_UNION(i2));
1233 }
1234
1235 int ase_interval_interior_connected_p(Lisp_Object iip1, Lisp_Object iip2)
1236 {
1237         return _ase_interval_interior_connected_p(
1238                 XASE_CARTESIAN(iip1), XASE_CARTESIAN(iip2));
1239 }
1240
1241 int ase_interval_interior_connected_union_p(Lisp_Object c, Lisp_Object iu)
1242 {
1243         return _ase_interval_union_intr_connected_p(
1244                 XASE_INTERVAL_UNION(iu), XASE_CARTESIAN(c));
1245 }
1246
1247 int ase_interval_disjoint_p(Lisp_Object i1, Lisp_Object i2)
1248 {
1249         return _ase_interval_disjoint_p(XASE_INTERVAL(i1), XASE_INTERVAL(i2));
1250 }
1251
1252 int ase_interval_disjoint_union_p(Lisp_Object i, Lisp_Object iu)
1253 {
1254         return _ase_interval_union_disjoint_intv_p(
1255                 XASE_INTERVAL_UNION(iu), XASE_INTERVAL(i));
1256 }
1257
1258 int ase_interval_interior_disjoint_p(Lisp_Object iip1, Lisp_Object iip2)
1259 {
1260         return _ase_interval_interior_disjoint_p(
1261                 XASE_CARTESIAN(iip1), XASE_CARTESIAN(iip2));
1262 }
1263
1264 int ase_interval_interior_disjoint_union_p(Lisp_Object c, Lisp_Object iu)
1265 {
1266         return _ase_interval_union_disjoint_intr_p(
1267                 XASE_INTERVAL_UNION(iu), XASE_CARTESIAN(c));
1268 }
1269
1270 int ase_interval_union_disjoint_intv_p(Lisp_Object iu, Lisp_Object i)
1271 {
1272         return _ase_interval_union_disjoint_intv_p(
1273                 XASE_INTERVAL_UNION(iu), XASE_INTERVAL(i));
1274 }
1275
1276 int ase_interval_union_disjoint_intr_p(Lisp_Object iu, Lisp_Object c)
1277 {
1278         return _ase_interval_union_disjoint_intr_p(
1279                 XASE_INTERVAL_UNION(iu), XASE_CARTESIAN(c));
1280 }
1281
1282 int ase_interval_union_disjoint_p(Lisp_Object i1, Lisp_Object i2)
1283 {
1284         return _ase_interval_union_disjoint_p(
1285                 XASE_INTERVAL_UNION(i1), XASE_INTERVAL_UNION(i2));
1286 }
1287
1288 int ase_interval_open_p(Lisp_Object intv)
1289 {
1290         return _ase_interval_open_p(XASE_INTERVAL(intv));
1291 }
1292
1293 int ase_interval_closed_p(Lisp_Object intv)
1294 {
1295         return _ase_interval_closed_p(XASE_INTERVAL(intv));
1296 }
1297
1298 int ase_interval_union_open_p(Lisp_Object iu)
1299 {
1300         return _ase_interval_union_open_p(XASE_INTERVAL_UNION_SER(iu));
1301 }
1302
1303 int ase_interval_union_closed_p(Lisp_Object iu)
1304 {
1305         return _ase_interval_union_closed_p(XASE_INTERVAL_UNION_SER(iu));
1306 }
1307
1308 int ase_interval_interior_open_p(Lisp_Object iip)
1309 {
1310         return ase_cartesian_pointwise_pred_p(
1311                 XASE_CARTESIAN(iip), ase_interval_open_p);
1312 }
1313
1314 int ase_interval_interior_closed_p(Lisp_Object iip)
1315 {
1316         return ase_cartesian_pointwise_pred_p(
1317                 XASE_CARTESIAN(iip), ase_interval_closed_p);
1318 }
1319
1320 \f
1321 /* constructors */
1322 static ase_interval_t
1323 _ase_unite_intervals(ase_interval_t a1, ase_interval_t a2)
1324 {
1325 /* Returns a new interval item if a1 and a2 turn out not to be recyclable */
1326         int where = 0;
1327
1328         if (a1 == NULL && a2 == NULL) {
1329                 return NULL;
1330         } else if (a2 == NULL) {
1331                 return a1;
1332         } else if (a1 == NULL) {
1333                 return a2;
1334         } else if (_ase_interval_contains_intv_p(a1, a2)) {
1335                 return a1;
1336         } else if (_ase_interval_contains_intv_p(a2, a1)) {
1337                 return a2;
1338         } else if ((where = _ase_interval_connected_p(a1, a2))) {
1339                 Lisp_Object new_lower, new_upper;
1340                 int new_lower_open_p, new_upper_open_p;
1341
1342                 if (where == 1) {
1343                         new_lower = a1->lower;
1344                         new_lower_open_p = a1->lower_open_p;
1345                         new_upper = a2->upper;
1346                         new_upper_open_p = a2->upper_open_p;
1347                 } else {
1348                         new_lower = a2->lower;
1349                         new_lower_open_p = a2->lower_open_p;
1350                         new_upper = a1->upper;
1351                         new_upper_open_p = a1->upper_open_p;
1352                 }
1353
1354                 return _ase_make_interval(
1355                         new_lower, new_upper,
1356                         new_lower_open_p, new_upper_open_p);
1357         }
1358
1359         return NULL;
1360 }
1361
1362 static inline int
1363 _ase_interval_interior_pointintv_p(ase_cartesian_t c)
1364 {
1365         int pointintvp, i, dim = ase_cartesian_dimension(c);
1366
1367         for (i = 0, pointintvp = 1; i < dim && pointintvp; i++) {
1368                 Lisp_Object a = ase_cartesian_objects(c)[i];
1369                 if (!XASE_INTERVAL(a)->lower_eq_upper_p)
1370                         pointintvp = 0;
1371         }
1372         return pointintvp;
1373 }
1374
1375 static ase_cartesian_t
1376 _ase_unite_intervals_intr(ase_cartesian_t c1, ase_cartesian_t c2)
1377 {
1378         int hypidx, hypplaneeqp = 0;
1379         int i, dim;
1380
1381         if (c1 == NULL)
1382                 return c2;
1383         if (c2 == NULL)
1384                 return c1;
1385         if (!NILP(_ase_interval_interior_contains_intr_p(c1, c2))) {
1386                 /* cartesians lack ref counters atm, hence we cant do: */
1387                 return c1;
1388         } else if (!NILP(_ase_interval_interior_contains_intr_p(c2, c1))) {
1389                 /* cartesians lack ref counters atm, hence we cant do: */
1390                 return c2;
1391         }
1392
1393         dim = ase_cartesian_dimension(c1);
1394         for (hypidx = 0; hypidx < dim; hypidx++) {
1395                 /* we build the hyperplane of the interval by
1396                  * omitting the hypidx-th dimension in the next loop */
1397                 for (i = 0, hypplaneeqp = 1; i < dim && hypplaneeqp; i++) {
1398                         Lisp_Object i1 = ase_cartesian_objects(c1)[i];
1399                         Lisp_Object i2 = ase_cartesian_objects(c2)[i];
1400                         if (i != hypidx &&
1401                             !ase_interval_equal_p(i1, i2))
1402                                 hypplaneeqp = 0;
1403                 }
1404                 if (hypplaneeqp) {
1405                         /* finally found a hyperplane where all
1406                          * intervals coincide, this means, we can merge */
1407                         break;
1408                 }
1409         }
1410         if (hypplaneeqp) {
1411                 /* merge along the hypidx-th dimension */
1412                 Lisp_Object i1 = ase_cartesian_objects(c1)[hypidx];
1413                 Lisp_Object i2 = ase_cartesian_objects(c2)[hypidx];
1414                 ase_interval_t a1 = XASE_INTERVAL(i1);
1415                 ase_interval_t a2 = XASE_INTERVAL(i2);
1416                 ase_interval_t a = _ase_unite_intervals(a1, a2);
1417                 Lisp_Object *tmp = alloca_array(Lisp_Object, dim);
1418
1419                 if (a == NULL)
1420                         return NULL;
1421
1422                 for (i = 0; i < dim; i++)
1423                         tmp[i] = ase_cartesian_objects(c1)[i];
1424                 tmp[hypidx] = _ase_wrap_interval(a);
1425                 return _ase_make_cartesian(dim, tmp, 1);
1426         }
1427
1428         return NULL;
1429 }
1430
1431 static Lisp_Object
1432 ase_unite_intervals_intv(Lisp_Object a1, Lisp_Object a2)
1433 {
1434         ase_interval_t a =
1435                 _ase_unite_intervals(XASE_INTERVAL(a1), XASE_INTERVAL(a2));
1436
1437         if (a)
1438                 return _ase_wrap_interval(a);
1439         else
1440                 return Qnil;
1441 }
1442
1443 static Lisp_Object
1444 ase_unite_intervals_intr(Lisp_Object iip1, Lisp_Object iip2)
1445 {
1446         ase_cartesian_t a = NULL;
1447
1448         if (ASE_INTERVAL_EMPTY_P(iip1))
1449                 return iip2;
1450         if (ASE_INTERVAL_EMPTY_P(iip2))
1451                 return iip1;
1452
1453         a = _ase_unite_intervals_intr(
1454                 XASE_CARTESIAN(iip1), XASE_CARTESIAN(iip2));
1455
1456         if (a)
1457                 return _ase_wrap_cartesian_interior(a);
1458         else
1459                 return Qnil;
1460 }
1461
1462 static Lisp_Object
1463 ase_unite_intervals(Lisp_Object a1, Lisp_Object a2)
1464 {
1465         if (ASE_INTERVAL_INTERIOR_P(a1) || ASE_INTERVAL_INTERIOR_P(a2))
1466                 return ase_unite_intervals_intr(a1, a2);
1467         else if (ASE_INTERVALP(a1) || ASE_INTERVALP(a2))
1468                 return ase_unite_intervals_intv(a1, a2);
1469         else
1470                 return Qnil;
1471 }
1472
1473 static ase_interval_t
1474 _ase_intersect_intv_intv(ase_interval_t a1, ase_interval_t a2)
1475 {
1476 /* Returns a new interval item if a1 and a2 turn out not to be recyclable */
1477         int where = 0;
1478
1479         if (a1 == NULL || a2 == NULL) {
1480                 return NULL;
1481         } else if (_ase_interval_disjoint_p(a1, a2)) {
1482                 return NULL;
1483         } else if (_ase_interval_contains_intv_p(a1, a2)) {
1484                 return a2;
1485         } else if (_ase_interval_contains_intv_p(a2, a1)) {
1486                 return a1;
1487         } else if ((where = _ase_interval_connected_p(a1, a2))) {
1488                 Lisp_Object new_lower, new_upper;
1489                 int new_lower_open_p, new_upper_open_p;
1490
1491                 if (where == 1) {
1492                         new_lower = a2->lower;
1493                         new_lower_open_p = a2->lower_open_p;
1494                         new_upper = a1->upper;
1495                         new_upper_open_p = a1->upper_open_p;
1496                 } else {
1497                         new_lower = a1->lower;
1498                         new_lower_open_p = a1->lower_open_p;
1499                         new_upper = a2->upper;
1500                         new_upper_open_p = a2->upper_open_p;
1501                 }
1502
1503                 return _ase_make_interval(
1504                         new_lower, new_upper,
1505                         new_lower_open_p, new_upper_open_p);
1506         }
1507
1508         return NULL;
1509 }
1510
1511 static Lisp_Object
1512 ase_intersect_intv_intv(Lisp_Object a1, Lisp_Object a2)
1513 {
1514         ase_interval_t a =
1515                 _ase_intersect_intv_intv(XASE_INTERVAL(a1), XASE_INTERVAL(a2));
1516
1517         if (a)
1518                 return _ase_wrap_interval(a);
1519         else
1520                 return Qase_empty_interval;
1521 }
1522
1523 static ase_cartesian_t
1524 _ase_intersect_intr_intr(ase_cartesian_t c1, ase_cartesian_t c2)
1525 {
1526 /* Returns a new interval item if a1 and a2 turn out not to be recyclable */
1527         if (c1 == NULL || c2 == NULL) {
1528                 return NULL;
1529         } else if (_ase_interval_interior_disjoint_p(c1, c2)) {
1530                 return NULL;
1531         } else {
1532                 int i, dim = ase_cartesian_dimension(c1);
1533                 Lisp_Object *newos = alloca_array(Lisp_Object, dim);
1534
1535                 for (i = 0; i < dim; i++) {
1536                         Lisp_Object o1 = ase_cartesian_objects(c1)[i];
1537                         Lisp_Object o2 = ase_cartesian_objects(c2)[i];
1538                         newos[i] = ase_intersect_intv_intv(o1, o2);
1539                 }
1540
1541                 return _ase_make_cartesian(dim, newos, 1);
1542         }
1543
1544         return NULL;
1545 }
1546
1547 static Lisp_Object
1548 ase_intersect_intr_intr(Lisp_Object c1, Lisp_Object c2)
1549 {
1550         ase_cartesian_t c =
1551                 _ase_intersect_intr_intr(
1552                         XASE_CARTESIAN(c1), XASE_CARTESIAN(c2));
1553
1554         if (c)
1555                 return _ase_wrap_cartesian_interior(c);
1556         else
1557                 return Qase_empty_interval;
1558 }
1559
1560 static ase_interval_union_item_t
1561 _ase_intersect_union_intv(ase_interval_union_t iu, ase_interval_t a)
1562 {
1563         ase_interval_union_item_t u = ase_interval_union(iu);
1564         struct ase_interval_union_item_s ures, *ur = &ures;
1565
1566         ur->current = Qase_empty_interval;
1567         ur->next = NULL;
1568         while (u) {
1569                 ase_interval_t a1 = XASE_INTERVAL(u->current);
1570                 ase_interval_t na = _ase_intersect_intv_intv(a1, a);
1571
1572                 if (na)
1573                         ur = ur->next = _ase_make_interval_union_item(
1574                                 _ase_wrap_interval(na));
1575                 u = u->next;
1576         }
1577
1578         return ures.next;
1579 }
1580
1581 static Lisp_Object
1582 ase_intersect_union_intv(Lisp_Object iu, Lisp_Object a)
1583 {
1584         ase_interval_union_item_t nu =
1585                 _ase_intersect_union_intv(
1586                         XASE_INTERVAL_UNION(iu), XASE_INTERVAL(a));
1587
1588         if (nu && nu->next)
1589                 return _ase_wrap_interval_union(
1590                         _ase_make_interval_union(nu));
1591         else if (nu) {
1592                 Lisp_Object na = nu->current;
1593                 _ase_interval_union_item_fini(nu);
1594                 return na;
1595         } else
1596                 return Qase_empty_interval;
1597 }
1598
1599 static Lisp_Object
1600 ase_intersect_intv_union(Lisp_Object a, Lisp_Object iu)
1601 {
1602         return ase_intersect_union_intv(iu, a);
1603 }
1604
1605 static ase_interval_union_item_t
1606 _ase_intersect_union_intr(ase_interval_union_t iu, ase_cartesian_t c)
1607 {
1608         ase_interval_union_item_t u = ase_interval_union(iu);
1609         struct ase_interval_union_item_s ures, *ur = &ures;
1610
1611         ur->current = Qase_empty_interval;
1612         ur->next = NULL;
1613         while (u) {
1614                 ase_cartesian_t c1 = XASE_CARTESIAN(u->current);
1615                 ase_cartesian_t nc = _ase_intersect_intr_intr(c1, c);
1616
1617                 if (nc)
1618                         ur = ur->next = _ase_make_interval_union_item(
1619                                 _ase_wrap_cartesian_interior(nc));
1620                 u = u->next;
1621         }
1622
1623         _ase_normalise_union_intr(&ures);
1624
1625         return ures.next;
1626 }
1627
1628 static Lisp_Object
1629 ase_intersect_union_intr(Lisp_Object iu, Lisp_Object c)
1630 {
1631         ase_interval_union_item_t nu =
1632                 _ase_intersect_union_intr(
1633                         XASE_INTERVAL_UNION(iu), XASE_CARTESIAN(c));
1634
1635         if (nu && nu->next)
1636                 return _ase_wrap_interval_union(
1637                         _ase_make_interval_union(nu));
1638         else if (nu) {
1639                 Lisp_Object na = nu->current;
1640                 _ase_interval_union_item_fini(nu);
1641                 return na;
1642         } else
1643                 return Qase_empty_interval;
1644 }
1645
1646 static Lisp_Object
1647 ase_intersect_intr_union(Lisp_Object c, Lisp_Object iu)
1648 {
1649         return ase_intersect_union_intr(iu, c);
1650 }
1651
1652 static ase_interval_union_item_t
1653 _ase_intersect_union_union(ase_interval_union_t iu1, ase_interval_union_t iu2)
1654 {
1655         ase_interval_union_item_t u = ase_interval_union(iu1);
1656         struct ase_interval_union_item_s ures, *ur = &ures;
1657
1658         ur->current = Qase_empty_interval;
1659         ur->next = NULL;
1660         while (u) {
1661                 ase_interval_union_item_t na = NULL;
1662
1663                 if (ASE_INTERVALP(u->current)) {
1664                         ase_interval_t a1 = XASE_INTERVAL(u->current);
1665                         na = _ase_intersect_union_intv(iu2, a1);
1666                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
1667                         ase_cartesian_t c1 = XASE_CARTESIAN(u->current);
1668                         na = _ase_intersect_union_intr(iu2, c1);
1669                 }
1670
1671                 if (na) {
1672                         ur->next = na;
1673                         /* forewind to the end of ur */
1674                         while (ur->next)
1675                                 ur = ur->next;
1676                 }
1677                 u = u->next;
1678         }
1679
1680         if (ures.next && ASE_INTERVAL_INTERIOR_P(ures.next->current)) {
1681                 _ase_normalise_union_intr(&ures);
1682         }
1683
1684         return ures.next;
1685 }
1686
1687 static Lisp_Object
1688 ase_intersect_union_union(Lisp_Object iu1, Lisp_Object iu2)
1689 {
1690         ase_interval_union_item_t nu =
1691                 _ase_intersect_union_union(
1692                         XASE_INTERVAL_UNION(iu1), XASE_INTERVAL_UNION(iu2));
1693
1694         if (nu && nu->next)
1695                 return _ase_wrap_interval_union(
1696                         _ase_make_interval_union(nu));
1697         else if (nu) {
1698                 Lisp_Object na = nu->current;
1699                 _ase_interval_union_item_fini(nu);
1700                 return na;
1701         } else
1702                 return Qase_empty_interval;
1703 }
1704
1705 static ase_interval_union_item_t
1706 _ase_subtract_intv_intv(ase_interval_t a1, ase_interval_t a2)
1707 {
1708 /* Returns a new interval item if a1 and a2 turn out not to be recyclable */
1709         int where = 0;
1710
1711         if (a1 == NULL)
1712                 return NULL;
1713         if (a2 == NULL) {
1714                 return _ase_make_interval_union_item(
1715                         _ase_wrap_interval(a1));
1716         } else if (_ase_interval_disjoint_p(a1, a2)) {
1717                 return _ase_make_interval_union_item(
1718                         _ase_wrap_interval(a1));
1719         } else if (_ase_interval_contains_intv_p(a2, a1)) {
1720                 return NULL;
1721         } else if (_ase_interval_contains_intv_p(a1, a2)) {
1722                 /* the hard case, now a1 decomposes to two interval items */
1723                 Lisp_Object na1l, na1u, na2l, na2u;
1724                 int na1lop, na1uop, na2lop, na2uop;
1725                 ase_interval_union_item_t ures = NULL, u1 = NULL, u2 = NULL;
1726
1727                 na1l = a1->lower;
1728                 na1lop = a1->lower_open_p;
1729                 na1u = a2->lower;
1730                 na1uop = !a2->lower_open_p;
1731
1732                 na2l = a2->upper;
1733                 na2lop = !a2->upper_open_p;
1734                 na2u = a1->upper;
1735                 na2uop = a1->upper_open_p;
1736
1737                 a1 = _ase_make_interval(na1l, na1u, na1lop, na1uop);
1738                 a2 = _ase_make_interval(na2l, na2u, na2lop, na2uop);
1739
1740                 if (a1) {
1741                         u1 = _ase_make_interval_union_item(
1742                                 _ase_wrap_interval(a1));
1743                 }
1744                 if (a2) {
1745                         u2 = _ase_make_interval_union_item(
1746                                 _ase_wrap_interval(a2));
1747                 }
1748
1749                 if (u1 && u2) {
1750                         ures = u1;
1751                         ures->next = u2;
1752                 } else if (u1) {
1753                         ures = u1;
1754                 } else if (u2) {
1755                         ures = u2;
1756                 }
1757
1758                 return ures;
1759         } else if ((where = _ase_interval_connected_p(a1, a2))) {
1760                 Lisp_Object new_lower, new_upper;
1761                 int new_lower_open_p, new_upper_open_p;
1762
1763                 if (where == 1) {
1764                         new_lower = a1->lower;
1765                         new_lower_open_p = a1->lower_open_p;
1766                         new_upper = a2->lower;
1767                         new_upper_open_p = !a2->lower_open_p;
1768                 } else {
1769                         new_lower = a2->upper;
1770                         new_lower_open_p = !a2->upper_open_p;
1771                         new_upper = a1->upper;
1772                         new_upper_open_p = a1->upper_open_p;
1773                 }
1774
1775                 return _ase_make_interval_union_item(
1776                         _ase_wrap_interval(
1777                                 _ase_make_interval(
1778                                         new_lower, new_upper,
1779                                         new_lower_open_p, new_upper_open_p)));
1780         } else {
1781                 EMOD_ASE_CRITICAL("Desaster!\n");
1782         }
1783
1784         return NULL;
1785 }
1786
1787 static Lisp_Object
1788 ase_subtract_intv_intv(Lisp_Object a1, Lisp_Object a2)
1789 {
1790         ase_interval_union_item_t u =
1791                 _ase_subtract_intv_intv(XASE_INTERVAL(a1), XASE_INTERVAL(a2));
1792
1793         if (u && u->next)
1794                 return _ase_wrap_interval_union(
1795                         _ase_make_interval_union(u));
1796         else if (u) {
1797                 Lisp_Object na = u->current;
1798                 _ase_interval_union_item_fini(u);
1799                 return na;
1800         } else
1801                 return Qase_empty_interval;
1802 }
1803
1804 static ase_interval_union_item_t
1805 _ase_subtract_intr_intr(ase_cartesian_t c1, ase_cartesian_t c2)
1806 {
1807         if (c1 == NULL)
1808                 return NULL;
1809         if (c2 == NULL) {
1810                 return _ase_make_interval_union_item(
1811                         _ase_wrap_cartesian_interior(c1));
1812         } else if (_ase_interval_interior_disjoint_p(c1, c2)) {
1813                 return _ase_make_interval_union_item(
1814                         _ase_wrap_cartesian_interior(c1));
1815         } else if (!NILP(_ase_interval_interior_contains_intr_p(c2, c1))) {
1816                 return NULL;
1817         } else if (_ase_interval_interior_connected_p(c1, c2)) {
1818                 //!NILP(_ase_interval_interior_contains_intr_p(c1, c2)) ||
1819                 /* the hard case, we decompose c1 into at most 2n
1820                  * n-dimensional interval products */
1821                 int i, dim = ase_cartesian_dimension(c1);
1822                 struct ase_interval_union_item_s ures, *ur = &ures;
1823
1824                 for (i = 0; i < dim; i++) {
1825                         Lisp_Object o1 = ase_cartesian_objects(c1)[i];
1826                         Lisp_Object o2 = ase_cartesian_objects(c2)[i];
1827                         ase_interval_union_item_t dec =
1828                                 _ase_subtract_intv_intv(
1829                                         XASE_INTERVAL(o1), XASE_INTERVAL(o2));
1830                         /* dec should now have two elements,
1831                          * one left of o2 in o1, one right of o2 in o1 */
1832                         Lisp_Object *newos = alloca_array(Lisp_Object, dim);
1833                         int j;
1834
1835                         /* copy the (i-1) whole intervals */
1836                         for (j = 0; j < i; j++) {
1837                                 Lisp_Object t1 = ase_cartesian_objects(c1)[j];
1838                                 newos[j] = t1;
1839                         }
1840                         /* now push all the interval components of o2
1841                          * which lie in subspaces of index >i */
1842                         for (j = i+1; j < dim; j++) {
1843                                 Lisp_Object t1 = ase_cartesian_objects(c1)[j];
1844                                 Lisp_Object t2 = ase_cartesian_objects(c2)[j];
1845                                 newos[j] = ase_intersect_intv_intv(t1, t2);
1846                         }
1847                         /* copy the interval left of o2 */
1848                         newos[i] = dec->current;
1849                         ur = ur->next =
1850                                 _ase_make_interval_union_item(
1851                                         ase_make_cartesian(dim, newos, 1));
1852                         /* copy the interval right of o2, if there is one */
1853                         if (dec->next) {
1854                                 newos[i] = dec->next->current;
1855                                 ur = ur->next =
1856                                         _ase_make_interval_union_item(
1857                                                 ase_make_cartesian(
1858                                                         dim, newos, 1));
1859                         }
1860                         _ase_interval_union_item_fini(dec);
1861                 }
1862
1863                 return ures.next;
1864         } else if (_ase_interval_interior_connected_p(c1, c2)) {
1865                 /* kinda hard case, we decompose c1 into 2n-1
1866                  * n-dimensional interval products */
1867                 EMOD_ASE_CRITICAL("Desaster!\n");
1868         } else {
1869                 EMOD_ASE_CRITICAL("Desaster!\n");
1870         }
1871
1872         return NULL;
1873 }
1874
1875 static Lisp_Object
1876 ase_subtract_intr_intr(Lisp_Object c1, Lisp_Object c2)
1877 {
1878         ase_interval_union_item_t u =
1879                 _ase_subtract_intr_intr(XASE_CARTESIAN(c1), XASE_CARTESIAN(c2));
1880
1881         if (u && u->next)
1882                 return _ase_wrap_interval_union(
1883                         _ase_make_interval_union(u));
1884         else if (u) {
1885                 Lisp_Object na = u->current;
1886                 _ase_interval_union_item_fini(u);
1887                 return na;
1888         } else
1889                 return Qase_empty_interval;
1890 }
1891
1892 static ase_interval_union_item_t
1893 _ase_subtract_union_intv(ase_interval_union_item_t u, ase_interval_t a)
1894 {
1895         /* (A u B) \ C = (A \ C u B \ C) */
1896         struct ase_interval_union_item_s ures, *ur = &ures;
1897
1898         ur->current = Qase_empty_interval;
1899         ur->next = NULL;
1900         while (u) {
1901                 ase_interval_t a1 = XASE_INTERVAL(u->current);
1902                 ase_interval_union_item_t na;
1903
1904                 na = _ase_subtract_intv_intv(a1, a);
1905
1906                 if (na) {
1907                         ur->next = na;
1908                         /* forewind to the end of ur */
1909                         while (ur->next)
1910                                 ur = ur->next;
1911                 }
1912                 u = u->next;
1913         }
1914
1915         return ures.next;
1916 }
1917
1918 static Lisp_Object
1919 ase_subtract_union_intv(Lisp_Object iu, Lisp_Object a)
1920 {
1921         /* (A u B) \ C = (A \ C u B \ C) */
1922         ase_interval_union_item_t nu =
1923                 _ase_subtract_union_intv(
1924                         XASE_INTERVAL_UNION_SER(iu),
1925                         XASE_INTERVAL(a));
1926
1927         if (nu && nu->next)
1928                 return _ase_wrap_interval_union(
1929                         _ase_make_interval_union(nu));
1930         else if (nu) {
1931                 Lisp_Object na = nu->current;
1932                 _ase_interval_union_item_fini(nu);
1933                 return na;
1934         } else
1935                 return Qase_empty_interval;
1936 }
1937
1938 static ase_interval_union_item_t
1939 _ase_subtract_union_intr(ase_interval_union_item_t u, ase_cartesian_t c)
1940 {
1941         /* (A u B) \ C = (A \ C u B \ C) */
1942         struct ase_interval_union_item_s ures, *ur = &ures;
1943
1944         ur->current = Qase_empty_interval;
1945         ur->next = NULL;
1946         while (u) {
1947                 ase_cartesian_t c1 = XASE_CARTESIAN(u->current);
1948                 ase_interval_union_item_t na;
1949
1950                 na = _ase_subtract_intr_intr(c1, c);
1951
1952                 if (na) {
1953                         ur->next = na;
1954                         /* forewind to the end of ur */
1955                         while (ur->next)
1956                                 ur = ur->next;
1957                 }
1958                 u = u->next;
1959         }
1960
1961         return ures.next;
1962 }
1963
1964 static Lisp_Object
1965 ase_subtract_union_intr(Lisp_Object iu, Lisp_Object c)
1966 {
1967         /* (A u B) \ C = (A \ C u B \ C) */
1968         ase_interval_union_item_t nu =
1969                 _ase_subtract_union_intr(
1970                         XASE_INTERVAL_UNION_SER(iu),
1971                         XASE_CARTESIAN(c));
1972
1973         if (nu && nu->next)
1974                 return _ase_wrap_interval_union(
1975                         _ase_make_interval_union(nu));
1976         else if (nu) {
1977                 Lisp_Object na = nu->current;
1978                 _ase_interval_union_item_fini(nu);
1979                 return na;
1980         } else
1981                 return Qase_empty_interval;
1982 }
1983
1984 static ase_interval_union_item_t
1985 _ase_subtract_intv_union(ase_interval_t a, ase_interval_union_item_t u)
1986 {
1987         /* A \ (B u C) = (A \ B) \ C */
1988         struct ase_interval_union_item_s ures, *na = &ures;
1989
1990         na->current = _ase_wrap_interval(a);
1991         na->next = NULL;
1992         while (u) {
1993                 ase_interval_t a2 = XASE_INTERVAL(u->current);
1994
1995                 na = _ase_subtract_union_intv(na, a2);
1996
1997                 if (!na)
1998                         break;
1999                 u = u->next;
2000         }
2001         if (na == &ures) {
2002                 /* Copy the local temporary to the heap */
2003                 na = xnew(struct ase_interval_union_item_s);
2004                 assert(na);
2005                 memcpy(na,&ures,sizeof(ures));
2006         }
2007         return na;
2008 }
2009
2010 static Lisp_Object
2011 ase_subtract_intv_union(Lisp_Object a, Lisp_Object iu)
2012 {
2013         /* A \ (B u C) = (A \ B) \ C */
2014         ase_interval_union_item_t nu =
2015                 _ase_subtract_intv_union(
2016                         XASE_INTERVAL(a),
2017                         XASE_INTERVAL_UNION_SER(iu));
2018
2019         if (nu && nu->next)
2020                 return _ase_wrap_interval_union(
2021                         _ase_make_interval_union(nu));
2022         else if (nu) {
2023                 Lisp_Object na = nu->current;
2024                 _ase_interval_union_item_fini(nu);
2025                 return na;
2026         } else
2027                 return Qase_empty_interval;
2028 }
2029
2030 static ase_interval_union_item_t
2031 _ase_subtract_intr_union(ase_cartesian_t c, ase_interval_union_item_t u)
2032 {
2033         /* A \ (B u C) = (A \ B) \ C */
2034         struct ase_interval_union_item_s ures, *na = &ures;
2035
2036         na->current = _ase_wrap_cartesian_interior(c);
2037         na->next = NULL;
2038         while (u) {
2039                 ase_cartesian_t c2 = XASE_CARTESIAN(u->current);
2040
2041                 na = _ase_subtract_union_intr(na, c2);
2042
2043                 if (!na)
2044                         break;
2045                 u = u->next;
2046         }
2047
2048         if (na == &ures) {
2049                 /* Copy the local temporary to the heap */
2050                 na = xnew(struct ase_interval_union_item_s);
2051                 assert(na);
2052                 memcpy(na,&ures,sizeof(ures));
2053         }
2054         return na;
2055 }
2056
2057 static Lisp_Object
2058 ase_subtract_intr_union(Lisp_Object c, Lisp_Object iu)
2059 {
2060         /* A \ (B u C) = (A \ B) \ C */
2061         ase_interval_union_item_t nu =
2062                 _ase_subtract_intr_union(
2063                         XASE_CARTESIAN(c),
2064                         XASE_INTERVAL_UNION_SER(iu));
2065
2066         if (nu && nu->next)
2067                 return _ase_wrap_interval_union(
2068                         _ase_make_interval_union(nu));
2069         else if (nu) {
2070                 Lisp_Object na = nu->current;
2071                 _ase_interval_union_item_fini(nu);
2072                 return na;
2073         } else
2074                 return Qase_empty_interval;
2075 }
2076
2077 static ase_interval_union_item_t
2078 _ase_subtract_union_union(ase_interval_union_t iu1, ase_interval_union_t iu2)
2079 {
2080         /* (A u B) \ (C u D) = ((A u B) \ C) \ D */
2081         ase_interval_union_item_t na = ase_interval_union(iu1);
2082         ase_interval_union_item_t u = ase_interval_union(iu2);
2083
2084         while (u) {
2085                 if (ASE_INTERVALP(u->current)) {
2086                         ase_interval_t a = XASE_INTERVAL(u->current);
2087                         na = _ase_subtract_union_intv(na, a);
2088                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
2089                         ase_cartesian_t c = XASE_CARTESIAN(u->current);
2090                         na = _ase_subtract_union_intr(na, c);
2091                 }
2092
2093                 if (!na)
2094                         break;
2095                 u = u->next;
2096         }
2097
2098         return na;
2099 }
2100
2101 static Lisp_Object
2102 ase_subtract_union_union(Lisp_Object iu1, Lisp_Object iu2)
2103 {
2104         /* (A u B) \ (C u D) = ((A u B) \ C) \ D */
2105         ase_interval_union_item_t nu =
2106                 _ase_subtract_union_union(
2107                         XASE_INTERVAL_UNION(iu1), XASE_INTERVAL_UNION(iu2));
2108
2109         if (nu && nu->next)
2110                 return _ase_wrap_interval_union(
2111                         _ase_make_interval_union(nu));
2112         else if (nu) {
2113                 Lisp_Object na = nu->current;
2114                 _ase_interval_union_item_fini(nu);
2115                 return na;
2116         } else
2117                 return Qase_empty_interval;
2118 }
2119
2120
2121 static Lisp_Object
2122 _ase_copy_interval(ase_interval_t a)
2123 {
2124         Lisp_Object result = Qnil;
2125
2126         XSETASE_INTERVAL(result, a);
2127         return result;
2128 }
2129
2130 Lisp_Object ase_copy_interval(Lisp_Object intv)
2131 {
2132         return _ase_copy_interval(XASE_INTERVAL(intv));
2133 }
2134
2135 static Lisp_Object*
2136 _ase_interval_union_explode_array(int nargs, Lisp_Object *args, int add)
2137 {
2138         ase_interval_union_item_t u;
2139         Lisp_Object *newargs = args;
2140         int j, mov = 0;
2141
2142         for (j = 0; j < nargs+add; ) {
2143                 if (ASE_INTERVAL_UNION_P(args[j])) {
2144                         u = ase_interval_union(XASE_INTERVAL_UNION(args[j]));
2145                         newargs[j] = u->current;
2146                         u = u->next;
2147                         while (u) {
2148                                 newargs[nargs+mov] = u->current;
2149                                 u = u->next;
2150                                 mov++;
2151                         }
2152                 }
2153                 j++;
2154         }
2155         return newargs;
2156 }
2157
2158 static int
2159 _ase_normalise_union(ase_interval_union_item_t u)
2160 {
2161         /* assumes first item of u is sorta head, we cant change that */
2162         ase_interval_union_item_t u1 = u->next, u2 = NULL, pu = u;
2163         Lisp_Object a1, a2, atmp;
2164         int i = 1;
2165
2166         while ((u2 = u1->next)) {
2167                 a1 = u1->current;
2168                 a2 = u2->current;
2169
2170                 /* connectivity can solely occur at upper-lower */
2171                 atmp = ase_unite_intervals(a1, a2);
2172                 if (!NILP(atmp)) {
2173                         ase_interval_union_item_t tmp;
2174
2175                         tmp = _ase_make_interval_union_item(atmp);
2176                         tmp->next = u2->next;
2177
2178                         _ase_interval_union_item_fini(u1);
2179                         _ase_interval_union_item_fini(u2);
2180
2181                         pu->next = u1 = tmp;
2182                 } else {
2183                         pu = u1;
2184                         u1 = u2;
2185                         i++;
2186                 }
2187         }
2188         return i;
2189 }
2190
2191 static int
2192 _ase_normalise_union_intr(ase_interval_union_item_t u)
2193 {
2194         /* assumes first item of u is sorta head, we cant change that */
2195         ase_interval_union_item_t u1 = u->next, u2 = NULL, pu1 = u, pu2;
2196         Lisp_Object a1, a2, atmp;
2197         int i = 1;
2198
2199         while (u1) {
2200                 u2 = u1->next;
2201                 pu2 = u1;
2202                 while (u2) {
2203                         a1 = u1->current;
2204                         a2 = u2->current;
2205
2206                         /* connectivity can occur everywhere! */
2207                         atmp = ase_unite_intervals(a1, a2);
2208                         if (!NILP(atmp)) {
2209                                 ase_interval_union_item_t tmp, u2n;
2210
2211                                 tmp = _ase_make_interval_union_item(atmp);
2212                                 if (u1->next == u2) {
2213                                         tmp->next = u2->next;
2214                                 } else {
2215                                         tmp->next = u1->next;
2216                                 }
2217                                 u2n = u2->next;
2218                                 pu1->next = tmp;
2219                                 pu2->next = u2n;
2220
2221                                 _ase_interval_union_item_fini(u1);
2222                                 _ase_interval_union_item_fini(u2);
2223
2224                                 /* we start over from the very beginning
2225                                  * there might be new merge opportunities now
2226                                  * if speed is important, we should allow
2227                                  * a merge depth of 1, settint u1 to tmp
2228                                  * would be the equivalent action for this */
2229                                 u1 = u;
2230                                 break;
2231                         } else {
2232                                 pu2 = u2;
2233                                 u2 = u2->next;
2234                                 i++;
2235                         }
2236                 }
2237                 pu1 = u1;
2238                 u1 = u1->next;
2239         }
2240         return i;
2241 }
2242
2243 static ase_interval_union_item_t
2244 _ase_interval_boundary(ase_interval_t a)
2245 {
2246         Lisp_Object blo = Qnil, bup = Qnil;
2247         ase_interval_union_item_t ures = NULL;
2248
2249         if (a == NULL || a->lower_eq_upper_p)
2250                 return NULL;
2251
2252         blo = _ase_wrap_interval(
2253                 _ase_make_interval(a->lower, a->lower, 0, 0));
2254         if (!_ase_equal_p(a->lower, a->upper)) {
2255                 bup = _ase_wrap_interval(
2256                         _ase_make_interval(a->upper, a->upper, 0, 0));
2257         }
2258
2259         ures = _ase_make_interval_union_item(blo);
2260         if (!NILP(bup))
2261                 ures->next = _ase_make_interval_union_item(bup);
2262
2263         return ures;
2264 }
2265
2266 Lisp_Object ase_interval_boundary(Lisp_Object intv)
2267 {
2268         ase_interval_union_item_t u =
2269                 _ase_interval_boundary(XASE_INTERVAL(intv));
2270
2271         if (!u)
2272                 return Qase_empty_interval;
2273
2274         return _ase_wrap_interval_union(
2275                 _ase_make_interval_union(u));
2276 }
2277
2278 static ase_interval_union_item_t
2279 _ase_interval_interior_boundary(ase_cartesian_t c)
2280 {
2281         struct ase_interval_union_item_s ures, *ur = &ures;
2282         int i, dim = ase_cartesian_dimension(c);
2283
2284         ur->current = Qase_empty_interval;
2285         ur->next = NULL;
2286         for (i = 0; i < dim; i++) {
2287                 ase_interval_union_item_t tmp =
2288                         _ase_interval_boundary(
2289                                 XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2290                 Lisp_Object *newos = alloca_array(Lisp_Object, dim);
2291                 int j;
2292
2293                 if (!tmp)
2294                         continue;
2295
2296                 for (j = 0; j < dim; j++) {
2297                         newos[j] = ase_cartesian_objects(c)[j];
2298                 }
2299                 /* replace i-th component with one boundary point */
2300                 newos[i] = tmp->current;
2301                 /* replace with the new interior product */
2302                 tmp->current =
2303                         _ase_wrap_cartesian_interior(
2304                                 _ase_make_cartesian(dim, newos, 1));
2305                 /* replace i-th component with the other boundary point */
2306                 newos[i] = tmp->next->current;
2307                 /* and replace again with new interior product */
2308                 tmp->next->current =
2309                         _ase_wrap_cartesian_interior(
2310                                 _ase_make_cartesian(dim, newos, 1));
2311
2312                 /* pump the stuff into ur */
2313                 ur->next = tmp;
2314                 ur = tmp->next;
2315         }
2316
2317         return ures.next;
2318 }
2319
2320 static ase_interval_union_item_t
2321 _ase_interval_union_boundary(ase_interval_union_item_t u)
2322 {
2323         struct ase_interval_union_item_s ures, *ur = &ures;
2324         Lisp_Object lastiv;
2325
2326         lastiv = ur->current = Qase_empty_interval;
2327         ur->next = NULL;
2328         while (u) {
2329                 ase_interval_union_item_t tmp = NULL;
2330                 Lisp_Object curiv;
2331
2332                 if (ASE_INTERVALP(u->current)) {
2333                         tmp = _ase_interval_boundary(
2334                                 XASE_INTERVAL(u->current));
2335                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
2336                         tmp = _ase_interval_interior_boundary(
2337                                 XASE_CARTESIAN(u->current));
2338                 }
2339
2340                 u = u->next;
2341                 if (!tmp)
2342                         continue;
2343
2344                 /* disjoint intervals may have equal boundary points */
2345                 curiv = tmp->current;
2346                 if (!ase_interval_equal_p(lastiv, curiv)) {
2347                         ur->next = tmp;
2348                 } else {
2349                         ur->next = tmp->next;
2350                 }
2351                 while (ur->next)
2352                         ur = ur->next;
2353                 lastiv = ur->current;
2354         }
2355
2356         if (ASE_INTERVAL_INTERIOR_P(lastiv)) {
2357                 _ase_normalise_union_intr(&ures);
2358         }
2359
2360         return ures.next;
2361 }
2362
2363 Lisp_Object ase_interval_interior_boundary(Lisp_Object intv_intr_prod)
2364 {
2365         ase_interval_union_item_t u =
2366                 _ase_interval_interior_boundary(
2367                         XASE_CARTESIAN(intv_intr_prod));
2368
2369         if (!u)
2370                 return Qase_empty_interval;
2371
2372         return _ase_wrap_interval_union(
2373                 _ase_make_interval_union(u));
2374 }
2375
2376 Lisp_Object ase_interval_union_boundary(Lisp_Object intv_union)
2377 {
2378         ase_interval_union_item_t u =
2379                 _ase_interval_union_boundary(
2380                         XASE_INTERVAL_UNION_SER(intv_union));
2381
2382         if (!u)
2383                 return Qase_empty_interval;
2384
2385         return _ase_wrap_interval_union(
2386                 _ase_make_interval_union(u));
2387 }
2388
2389 static ase_interval_t
2390 _ase_interval_closure(ase_interval_t a)
2391 {
2392         if (a == NULL)
2393                 return NULL;
2394         if (_ase_interval_closed_p(a))
2395                 return a;
2396
2397         return _ase_make_interval(a->lower, a->upper, 0, 0);
2398 }
2399
2400 Lisp_Object ase_interval_closure(Lisp_Object intv)
2401 {
2402         ase_interval_t u =
2403                 _ase_interval_closure(XASE_INTERVAL(intv));
2404
2405         if (!u)
2406                 return Qase_empty_interval;
2407
2408         return _ase_wrap_interval(u);
2409 }
2410
2411 static ase_cartesian_t
2412 _ase_interval_interior_closure(ase_cartesian_t c)
2413 {
2414         int i, dim = ase_cartesian_dimension(c);
2415         Lisp_Object *os = ase_cartesian_objects(c);
2416         Lisp_Object *newos = alloca_array(Lisp_Object, dim);
2417
2418         for (i = 0; i < dim; i++) {
2419                 newos[i] = ase_interval_closure(os[i]);
2420         }
2421
2422         return _ase_make_cartesian(dim, newos, 1);
2423 }
2424
2425 Lisp_Object ase_interval_interior_closure(Lisp_Object intv_intr_prod)
2426 {
2427         ase_cartesian_t c =
2428                 _ase_interval_interior_closure(
2429                         XASE_CARTESIAN(intv_intr_prod));
2430
2431         if (!c)
2432                 return Qase_empty_interval;
2433
2434         return _ase_wrap_cartesian_interior(c);
2435 }
2436
2437 static ase_interval_union_item_t
2438 _ase_interval_union_closure(ase_interval_union_item_t u)
2439 {
2440         struct ase_interval_union_item_s ures, *ur = &ures;
2441
2442         if (_ase_interval_union_closed_p(u))
2443                 return u;
2444
2445         ur->current = Qase_empty_interval;
2446         ur->next = NULL;
2447         while (u) {
2448                 Lisp_Object ltmp = Qnil;
2449                 if (ASE_INTERVALP(u->current)) {
2450                         ase_interval_t tmp =
2451                                 _ase_interval_closure(
2452                                         XASE_INTERVAL(u->current));
2453                         u = u->next;
2454                         if (!tmp)
2455                                 continue;
2456                         ltmp = _ase_wrap_interval(tmp);
2457                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
2458                         ase_cartesian_t tmp =
2459                                 _ase_interval_interior_closure(
2460                                         XASE_CARTESIAN(u->current));
2461                         u = u->next;
2462                         if (!tmp)
2463                                 continue;
2464                         ltmp = _ase_wrap_cartesian_interior(tmp);
2465                 }
2466                 ur = ur->next = _ase_make_interval_union_item(ltmp);
2467         }
2468
2469         _ase_normalise_union(&ures);
2470
2471         return ures.next;
2472 }
2473
2474 Lisp_Object ase_interval_union_closure(Lisp_Object intv_union)
2475 {
2476         ase_interval_union_item_t u =
2477                 _ase_interval_union_closure(
2478                         XASE_INTERVAL_UNION_SER(intv_union));
2479
2480         if (!u)
2481                 return Qase_empty_interval;
2482
2483         if (u->next)
2484                 return _ase_wrap_interval_union(
2485                         _ase_make_interval_union(u));
2486
2487         return u->current;
2488 }
2489
2490 static ase_interval_t
2491 _ase_interval_interior(ase_interval_t a)
2492 {
2493         if (a == NULL || _ase_equal_p(a->lower, a->upper))
2494                 return NULL;
2495
2496         if (_ase_interval_open_p(a))
2497                 return a;
2498
2499         return _ase_make_interval(a->lower, a->upper, 1, 1);
2500 }
2501
2502 Lisp_Object ase_interval_interior(Lisp_Object intv)
2503 {
2504         ase_interval_t u =
2505                 _ase_interval_interior(XASE_INTERVAL(intv));
2506
2507         if (!u)
2508                 return Qase_empty_interval;
2509
2510         return _ase_wrap_interval(u);
2511 }
2512
2513 static ase_cartesian_t
2514 _ase_interval_interior_interior(ase_cartesian_t c)
2515 {
2516         int i, dim = ase_cartesian_dimension(c);
2517         Lisp_Object *os = ase_cartesian_objects(c);
2518         Lisp_Object *newos = alloca_array(Lisp_Object, dim);
2519
2520         for (i = 0; i < dim; i++) {
2521                 newos[i] = ase_interval_interior(os[i]);
2522         }
2523
2524         return _ase_make_cartesian(dim, newos, 1);
2525 }
2526
2527 Lisp_Object ase_interval_interior_interior(Lisp_Object intv_intr_prod)
2528 {
2529         ase_cartesian_t c =
2530                 _ase_interval_interior_interior(
2531                         XASE_CARTESIAN(intv_intr_prod));
2532
2533         if (!c)
2534                 return Qase_empty_interval;
2535
2536         return _ase_wrap_cartesian_interior(c);
2537 }
2538
2539 static ase_interval_union_item_t
2540 _ase_interval_union_interior(ase_interval_union_item_t u)
2541 {
2542         struct ase_interval_union_item_s ures, *ur = &ures;
2543
2544         if (_ase_interval_union_open_p(u))
2545                 return u;
2546
2547         ur->current = Qase_empty_interval;
2548         ur->next = NULL;
2549         while (u) {
2550                 Lisp_Object ltmp = Qnil;
2551                 if (ASE_INTERVALP(u->current)) {
2552                         ase_interval_t tmp =
2553                                 _ase_interval_interior(
2554                                         XASE_INTERVAL(u->current));
2555                         u = u->next;
2556                         if (!tmp)
2557                                 continue;
2558                         ltmp = _ase_wrap_interval(tmp);
2559                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
2560                         ase_cartesian_t tmp =
2561                                 _ase_interval_interior_interior(
2562                                         XASE_CARTESIAN(u->current));
2563                         u = u->next;
2564                         if (!tmp)
2565                                 continue;
2566                         ltmp = _ase_wrap_cartesian_interior(tmp);
2567                 }
2568                 ur = ur->next = _ase_make_interval_union_item(ltmp);
2569         }
2570
2571         return ures.next;
2572 }
2573
2574 Lisp_Object ase_interval_union_interior(Lisp_Object intv_union)
2575 {
2576         ase_interval_union_item_t u =
2577                 _ase_interval_union_interior(
2578                         XASE_INTERVAL_UNION_SER(intv_union));
2579
2580         if (!u)
2581                 return Qase_empty_interval;
2582
2583         if (u->next)
2584                 return _ase_wrap_interval_union(
2585                         _ase_make_interval_union(u));
2586
2587         return u->current;
2588 }
2589
2590 static ase_interval_type_t
2591 ase_interval_type(Lisp_Object o)
2592 {
2593         if (ASE_INTERVALP(o)) {
2594                 return ASE_ITYPE_INTERVAL;
2595         } else if (ASE_INTERVAL_UNION_P(o)) {
2596                 return ASE_ITYPE_UNION;
2597         } else if (ASE_INTERVAL_INTERIOR_P(o)) {
2598                 return ASE_ITYPE_INTERIOR;
2599         } else {
2600                 return ASE_ITYPE_OBJECT;
2601         }
2602 }
2603
2604 static inline void
2605 _ase_heapsort_sift(Lisp_Object *args, int start, int count,
2606                    ase_order_relation_f lessp)
2607 {
2608         int root = start, child;
2609
2610         while (2*root  + 1 < count) {
2611                 child = 2*root + 1;
2612
2613                 if (child < count-1 && lessp(args[child], args[child+1]))
2614                         child++;
2615                 if (lessp(args[root], args[child])) {
2616                         _ase_swap(args, root, child);
2617                         root = child;
2618                 } else {
2619                         return;
2620                 }
2621         }
2622         return;
2623 }
2624
2625 static inline void
2626 _ase_heapsort(int nargs, Lisp_Object *args, ase_order_relation_f lessp)
2627 {
2628         int start = nargs/2 - 1, end = nargs-1;
2629
2630         while (start >= 0) {
2631                 _ase_heapsort_sift(args, start, nargs, lessp);
2632                 start--;
2633         }
2634         while (end > 0) {
2635                 _ase_swap(args, end, 0);
2636                 _ase_heapsort_sift(args, 0, end, lessp);
2637                 end--;
2638         }
2639         return;
2640 }
2641
2642 static Lisp_Object
2643 ase_interval_connected_p_heapify(int nargs, Lisp_Object *args)
2644 {
2645         /* special case for flat intervals,
2646          * uses a heapsort to ease the connectivity question */
2647         Lisp_Object *newargs;
2648         int j, add = 0;
2649
2650         /* check for ASE_INTERVALs and sort empty intervals to the tail */
2651         for (j = 0; j < nargs; ) {
2652                 if (ASE_INTERVAL_UNION_P(args[j])) {
2653                         /* remember the number of additional elements we need */
2654                         add += XASE_INTERVAL_UNION(args[j])->no_intv-1;
2655                         j++;
2656                 } else if (!ASE_INTERVAL_EMPTY_P(args[j])) {
2657                         j++;
2658                 } else {
2659                         _ase_swap(args, nargs-1, j);
2660                         nargs--;
2661                 }
2662         }
2663
2664         if (nargs == 0)
2665                 return Qt;
2666         else if (nargs == 1)    /* reflexivity! */
2667                 return (ASE_INTERVAL_UNION_P(args[0]) ? Qnil : Qt);
2668
2669         if (add > 0) {
2670                 EMOD_ASE_DEBUG_INTV("exploding %d union items\n", add);
2671                 newargs = alloca_array(Lisp_Object, nargs+add);
2672                 /* move the first nargs args here */
2673                 memmove(newargs, args, nargs*sizeof(Lisp_Object));
2674                 /* now explode the whole story */
2675                 args = _ase_interval_union_explode_array(nargs, newargs, add);
2676                 nargs += add;
2677         }
2678
2679         /* sort intervals in less-p metric */
2680         _ase_heapsort(nargs, args, ase_interval_less_p);
2681
2682         for (j = 1; j < nargs; j++) {
2683                 Lisp_Object o1 = args[j-1], o2 = args[j];
2684                 if (!ase_interval_connected_p(o1, o2))
2685                         return Qnil;
2686         }
2687
2688         return Qt;
2689 }
2690
2691 static Lisp_Object
2692 ase_interval_connected_p_nsquare(int nargs, Lisp_Object *args)
2693 {
2694         int i, j;
2695         ase_interval_type_t t1, t2;
2696         ase_st_relation_f relf = NULL;
2697
2698         if (nargs == 0)
2699                 return Qt;
2700         else if (nargs == 1 && !ASE_INTERVAL_UNION_P(args[0]))
2701                 return Qt;
2702         else if (nargs == 1 &&
2703                  ASE_INTERVAL_INTERIOR_P(XASE_INTERVAL_UNION_FIRST(args[0]))) {
2704                 ase_interval_union_item_t u1, u2;
2705                 u1 = XASE_INTERVAL_UNION_SER(args[0]);
2706                 t1 = t2 = ASE_ITYPE_INTERIOR;
2707                 relf = ase_optable_connected[t1][t2];
2708                 while ((u2 = u1->next)) {
2709                         Lisp_Object o1 = u1->current;
2710                         Lisp_Object o2 = u2->current;
2711                         if (!relf(o1, o2))
2712                                 return Qnil;
2713                         u1 = u1->next;
2714                 }
2715                 return Qt;
2716         } else if (nargs == 1)
2717                 return Qnil;
2718
2719         /* the slow approach */
2720         /* connectivity itself is an intransitive relation,
2721          * but if any two are (locally) connected then all items are
2722          * globally connected */
2723         for (i = 0; i < nargs-1; i++) {
2724                 Lisp_Object o1 = args[i];
2725                 int foundp = 0;
2726                 t1 = ase_interval_type(o1);
2727                 for (j = i+1; j < nargs && !foundp; j++) {
2728                         Lisp_Object o2 = args[j];
2729                         t2 = ase_interval_type(o2);
2730                         relf = ase_optable_connected[t1][t2];
2731                         if (relf && relf(o1, o2))
2732                                 foundp = 1;
2733                 }
2734                 if (!foundp)
2735                         return Qnil;
2736         }
2737
2738         return Qt;
2739 }
2740
2741 static Lisp_Object
2742 ase_interval_disjoint_p_nsquare(int nargs, Lisp_Object *args)
2743 {
2744         int i, j;
2745         ase_interval_type_t t1, t2;
2746         ase_st_relation_f relf = NULL;
2747
2748         if (nargs == 0)
2749                 return Qt;
2750         else if (nargs == 1)    /* irreflexivity! */
2751                 return Qnil;
2752
2753         /* don't think that sorting helps here, but i'll profile this one day */
2754         /* pairwise (local) disjunction implies global disjunction */
2755         for (i = 0; i < nargs-1; i++) {
2756                 Lisp_Object o1 = args[i];
2757                 t1 = ase_interval_type(o1);
2758                 for (j = i+1; j < nargs; j++) {
2759                         Lisp_Object o2 = args[j];
2760                         t2 = ase_interval_type(o2);
2761                         relf = ase_optable_disjoint[t1][t2];
2762                         if (relf && !relf(o1, o2))
2763                                 return Qnil;
2764                 }
2765         }
2766
2767         return Qt;
2768 }
2769
2770 static int
2771 ase_interval_dimension(Lisp_Object o)
2772 {
2773         switch (ase_interval_type(o)) {
2774         case ASE_ITYPE_INTERVAL:
2775                 return 1;
2776         case ASE_ITYPE_INTERIOR:
2777                 return XASE_CARTESIAN_DIMENSION(o);
2778         case ASE_ITYPE_UNION:
2779                 return ase_interval_dimension(XASE_INTERVAL_UNION_FIRST(o));
2780
2781         case ASE_ITYPE_OBJECT:
2782         case NUMBER_OF_ASE_ITYPES:
2783         default:
2784                 return -1;
2785         }
2786 }
2787
2788 static int
2789 ase_interval_check_dimensions(int nargs, Lisp_Object *args)
2790 {
2791         int i, predicdim = 0;
2792
2793         if (nargs == 0)
2794                 return 0;
2795
2796         /* partial loop unrolling */
2797         for (i = 0; i < nargs; i++) {
2798                 CHECK_ASE_UBERINTERVAL(args[i]);
2799                 if (!ASE_INTERVAL_EMPTY_P(args[i])) {
2800                         predicdim = ase_interval_dimension(args[i]);
2801                         break;
2802                 }
2803         }
2804         for (i++; i < nargs; i++) {
2805                 CHECK_ASE_UBERINTERVAL(args[i]);
2806                 if (!ASE_INTERVAL_EMPTY_P(args[i]) &&
2807                     predicdim != ase_interval_dimension(args[i]))
2808                         return -1;
2809         }
2810         return predicdim;
2811 }
2812
2813
2814 \f
2815 /* Measures */
2816 static Lisp_Object
2817 _ase_interval_compute_lebesgue(ase_interval_t a)
2818 {
2819         if (a == NULL)
2820                 return Qzero;
2821
2822         return ent_binop(ASE_BINARY_OP_DIFF, a->upper, a->lower);
2823 }
2824
2825 static inline void
2826 _ase_interval_update_lebesgue(ase_interval_t a)
2827 {
2828         if (a && NILP(a->lebesgue_measure))
2829                 a->lebesgue_measure = _ase_interval_compute_lebesgue(a);
2830         return;
2831 }
2832
2833 static inline Lisp_Object
2834 _ase_interval_lebesgue(ase_interval_t a)
2835 {
2836         if (a)
2837                 return a->lebesgue_measure;
2838         else
2839                 return Qzero;
2840 }
2841
2842 static Lisp_Object
2843 _ase_interval_compute_rational(ase_interval_t a)
2844 {
2845         Lisp_Object args[2];
2846         Lisp_Object result;
2847
2848         if (a == NULL)
2849                 return Qzero;
2850
2851         if (a->lower == a->upper) {
2852                 /* special case of 1 point intervals */
2853                 if (INTEGERP(a->lower))
2854                         return make_int(1);
2855                 else
2856                         return Qzero;
2857         }
2858
2859         if (_ase_equal_p((args[0] = Ftruncate(a->upper)), a->upper))
2860                 args[0] = Fsub1(a->upper);
2861         args[1] = Ftruncate(a->lower);
2862
2863         /* care for alternation of the signum */
2864         if (!NILP(Fnonnegativep(a->upper)) &&
2865             NILP(Fnonnegativep(a->lower)) &&
2866             !_ase_equal_p(args[1], a->lower))
2867                 args[1] = Fsub1(args[1]);
2868
2869         result = ent_binop_many(ASE_BINARY_OP_DIFF, countof(args), args);
2870
2871         if (INTEGERP(a->upper) && !a->upper_open_p)
2872                 result = Fadd1(result);
2873         if (INTEGERP(a->lower) && !a->lower_open_p)
2874                 result = Fadd1(result);
2875
2876         return result;
2877 }
2878
2879 static inline void
2880 _ase_interval_update_rational(ase_interval_t a)
2881 {
2882         if (a && NILP(a->rational_measure))
2883                 a->rational_measure = _ase_interval_compute_rational(a);
2884         return;
2885 }
2886
2887 static inline Lisp_Object
2888 _ase_interval_rational(ase_interval_t a)
2889 {
2890         if (a)
2891                 return a->rational_measure;
2892         else
2893                 return Qzero;
2894 }
2895
2896 static int
2897 __ase_interval_interior_update_lebesgue(ase_cartesian_t c)
2898 {
2899         int i = 0, dim = ase_cartesian_dimension(c);
2900         for (i = 0; i < dim; i++) {
2901                 _ase_interval_update_lebesgue(
2902                         XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2903         }
2904         return dim;
2905 }
2906
2907 static Lisp_Object
2908 __ase_interval_interior_lebesgue(ase_cartesian_t c)
2909 {
2910         Lisp_Object *args;
2911         int i = 0, dim = __ase_interval_interior_update_lebesgue(c);
2912
2913         if (dim == 0)
2914                 return Qzero;
2915
2916         args = alloca_array(Lisp_Object, dim);
2917         for (i = 0; i < dim; i++) {
2918                 args[i] = _ase_interval_lebesgue(
2919                         XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2920         }
2921         return ent_binop_many(ASE_BINARY_OP_PROD, dim, args);
2922 }
2923
2924 static int
2925 __ase_interval_interior_update_rational(ase_cartesian_t c)
2926 {
2927         int i = 0, dim = ase_cartesian_dimension(c);
2928         for (i = 0; i < dim; i++) {
2929                 _ase_interval_update_rational(
2930                         XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2931         }
2932         return dim;
2933 }
2934
2935 static Lisp_Object
2936 __ase_interval_interior_rational(ase_cartesian_t c)
2937 {
2938         Lisp_Object *args;
2939         int i = 0, dim = __ase_interval_interior_update_rational(c);
2940
2941         if (dim == 0)
2942                 return Qzero;
2943
2944         args = alloca_array(Lisp_Object, dim);
2945         for (i = 0; i < dim; i++) {
2946                 args[i] = _ase_interval_rational(
2947                         XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2948         }
2949         return ent_binop_many(ASE_BINARY_OP_PROD, dim, args);
2950 }
2951
2952 static void
2953 _ase_interval_interior_update_lebesgue(ase_cartesian_t c)
2954         __attribute__((always_inline));
2955 static inline void
2956 _ase_interval_interior_update_lebesgue(ase_cartesian_t c)
2957 {
2958         if (NILP(c->lebesgue_measure))
2959                 c->lebesgue_measure =
2960                         __ase_interval_interior_lebesgue(c);
2961         return;
2962 }
2963
2964 static Lisp_Object
2965 _ase_interval_interior_lebesgue(ase_cartesian_t c)
2966 {
2967         return c->lebesgue_measure;
2968 }
2969
2970 static void
2971 _ase_interval_interior_update_rational(ase_cartesian_t c)
2972 {
2973         if (NILP(c->rational_measure))
2974                 c->rational_measure =
2975                         __ase_interval_interior_rational(c);
2976         return;
2977 }
2978
2979 static inline Lisp_Object
2980 _ase_interval_interior_rational(ase_cartesian_t c)
2981 {
2982         return c->rational_measure;
2983 }
2984
2985 static inline int
2986 __ase_interval_union_update_lebesgue(ase_interval_union_item_t u)
2987         __attribute__((always_inline));
2988 static inline int
2989 __ase_interval_union_update_lebesgue(ase_interval_union_item_t u)
2990 {
2991         int i = 0;
2992         while (u) {
2993                 if (ASE_INTERVALP(u->current)) {
2994                         _ase_interval_update_lebesgue(
2995                                 XASE_INTERVAL(u->current));
2996                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
2997                         _ase_interval_interior_update_lebesgue(
2998                                 XASE_CARTESIAN(u->current));
2999                 }
3000                 u = u->next;
3001                 i++;
3002         }
3003         return i;
3004 }
3005
3006 static Lisp_Object
3007 __ase_interval_union_lebesgue(ase_interval_union_item_t u)
3008 {
3009         Lisp_Object *args;
3010         int i = 0, nargs = __ase_interval_union_update_lebesgue(u);
3011
3012         if (nargs == 0)
3013                 return Qzero;
3014
3015         args = alloca_array(Lisp_Object, nargs);
3016         while (u) {
3017                 if (ASE_INTERVALP(u->current)) {
3018                         args[i] = _ase_interval_lebesgue(
3019                                 XASE_INTERVAL(u->current));
3020                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
3021                         args[i] = _ase_interval_interior_lebesgue(
3022                                 XASE_CARTESIAN(u->current));
3023                 }
3024                 i++;
3025                 u = u->next;
3026         }
3027         return ent_binop_many(ASE_BINARY_OP_SUM, nargs, args);
3028 }
3029
3030 static int
3031 __ase_interval_union_update_rational(ase_interval_union_item_t u)
3032 {
3033         int i = 0;
3034         while (u) {
3035                 if (ASE_INTERVALP(u->current)) {
3036                         _ase_interval_update_rational(
3037                                 XASE_INTERVAL(u->current));
3038                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
3039                         _ase_interval_interior_update_rational(
3040                                 XASE_CARTESIAN(u->current));
3041                 }
3042                 u = u->next;
3043                 i++;
3044         }
3045         return i;
3046 }
3047
3048 static Lisp_Object
3049 __ase_interval_union_rational(ase_interval_union_item_t u)
3050 {
3051         int i = 0, nargs = __ase_interval_union_update_rational(u);
3052         if (nargs == 0)
3053                 return Qzero;
3054         {
3055                 Lisp_Object args[nargs];
3056                 for ( i = nargs; i > 0; )
3057                         args[--i] = Qnil;
3058
3059                 while (u) {
3060                         if (ASE_INTERVALP(u->current)) {
3061                                 args[i] = _ase_interval_rational(
3062                                         XASE_INTERVAL(u->current));
3063                         } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
3064                                 args[i] = _ase_interval_interior_rational(
3065                                         XASE_CARTESIAN(u->current));
3066                         }
3067                         i++;
3068                         u = u->next;
3069                 }
3070                 return ent_binop_many(ASE_BINARY_OP_SUM, nargs, args);
3071         }
3072 }
3073
3074 static inline void
3075 _ase_interval_union_update_lebesgue(ase_interval_union_t iu)
3076 {
3077         if (NILP(iu->lebesgue_measure))
3078                 iu->lebesgue_measure =
3079                         __ase_interval_union_lebesgue(ase_interval_union(iu));
3080         return;
3081 }
3082
3083 static inline Lisp_Object
3084 _ase_interval_union_lebesgue(ase_interval_union_t iu)
3085 {
3086         return iu->lebesgue_measure;
3087 }
3088
3089 static inline void
3090 _ase_interval_union_update_rational(ase_interval_union_t iu)
3091 {
3092         if (NILP(iu->rational_measure))
3093                 iu->rational_measure =
3094                         __ase_interval_union_rational(ase_interval_union(iu));
3095         return;
3096 }
3097
3098 static inline Lisp_Object
3099 _ase_interval_union_rational(ase_interval_union_t iu)
3100 {
3101         return iu->rational_measure;
3102 }
3103
3104 Lisp_Object
3105 ase_interval_lebesgue_measure(ase_interval_t a)
3106 {
3107         _ase_interval_update_lebesgue(a);
3108         return _ase_interval_lebesgue(a);
3109 }
3110
3111 Lisp_Object
3112 ase_interval_rational_measure(ase_interval_t a)
3113 {
3114         _ase_interval_update_rational(a);
3115         return _ase_interval_rational(a);
3116 }
3117
3118 Lisp_Object
3119 ase_interval_interior_lebesgue_measure(ase_cartesian_t c)
3120 {
3121         _ase_interval_interior_update_lebesgue(c);
3122         return _ase_interval_interior_lebesgue(c);
3123 }
3124
3125 Lisp_Object
3126 ase_interval_interior_rational_measure(ase_cartesian_t c)
3127 {
3128         _ase_interval_interior_update_rational(c);
3129         return _ase_interval_interior_rational(c);
3130 }
3131
3132 Lisp_Object
3133 ase_interval_union_lebesgue_measure(ase_interval_union_t iu)
3134 {
3135         _ase_interval_union_update_lebesgue(iu);
3136         return _ase_interval_union_lebesgue(iu);
3137 }
3138
3139 Lisp_Object
3140 ase_interval_union_rational_measure(ase_interval_union_t iu)
3141 {
3142         _ase_interval_union_update_rational(iu);
3143         return _ase_interval_union_rational(iu);
3144 }
3145
3146 /* arithmetical operations */
3147 /* I x Q -> I : (a, b) + x -> (a+x, b+x) */
3148 /* I x I -> I : (a, b) + (c, d) -> (a+c, b+d) */
3149 /* U x Q -> U : (a, b) u (c, d) + x -> (a, b) + x u (c, d) + x */
3150 /* U x I -> U : (a, b) u (c, d) + (e, f) -> (a, b) + (e, f) u (c, d) + (e, f) */
3151 /* U x U -> U : A u B + C u D u E -> A+C u B+C u A+D u B+D u A+E u B+E */
3152
3153 \f
3154 /* lisp level */
3155 DEFUN("ase-intervalp", Fase_intervalp, 1, 1, 0, /*
3156 Return non-`nil' iff OBJECT is an ase interval.
3157 */
3158       (object))
3159 {
3160         if (ASE_INTERVALP(object))
3161                 return Qt;
3162
3163         return Qnil;
3164 }
3165
3166 DEFUN("ase-interval-union-p", Fase_interval_union_p, 1, 1, 0, /*
3167 Return non-`nil' iff OBJECT is an ase interval or union thereof.
3168 */
3169       (object))
3170 {
3171         if (ASE_INTERVAL_OR_UNION_P(object))
3172                 return Qt;
3173
3174         return Qnil;
3175 }
3176
3177 DEFUN("ase-interval-empty-p", Fase_interval_empty_p, 1, 1, 0, /*
3178 Return non-`nil' iff INTERVAL is the empty interval.
3179 */
3180       (interval))
3181 {
3182         CHECK_ASE_INTERVAL(interval);
3183
3184         if (ASE_INTERVAL_EMPTY_P(interval))
3185                 return Qt;
3186
3187         return Qnil;
3188 }
3189
3190 DEFUN("ase-interval-imprimitive-p", Fase_interval_imprimitive_p, 1, 1, 0, /*
3191 Return non-`nil' iff INTERVAL is not a primitive interval.
3192 */
3193       (interval))
3194 {
3195         CHECK_ASE_UBERINTERVAL(interval);
3196
3197         if (ASE_INTERVALP(interval))
3198                 return Qnil;
3199
3200         return Qt;
3201 }
3202
3203 DEFUN("ase-interval-open-p", Fase_interval_open_p, 1, 1, 0, /*
3204 Return non-`nil' iff INTERVAL (or a union thereof) is an open set
3205 with respect to the standard topology.
3206 */
3207       (interval))
3208 {
3209         CHECK_ASE_UBERINTERVAL(interval);
3210
3211         if (ASE_INTERVALP(interval)) {
3212                 if (ASE_INTERVAL_EMPTY_P(interval))
3213                         return Qt;
3214                 if (ase_interval_open_p(interval))
3215                         return Qt;
3216         } else if (ASE_INTERVAL_UNION_P(interval)) {
3217                 if (ase_interval_union_open_p(interval))
3218                         return Qt;
3219         } else if (ASE_INTERVAL_INTERIOR_P(interval)) {
3220                 if (ase_interval_interior_open_p(interval))
3221                         return Qt;
3222         }
3223         return Qnil;
3224 }
3225
3226 DEFUN("ase-interval-closed-p", Fase_interval_closed_p, 1, 1, 0, /*
3227 Return non-`nil' iff INTERVAL (or a union thereof) is a closed set
3228 with respect to the standard metric.
3229
3230 An interval is said to be closed iff the complement is open.
3231 */
3232       (interval))
3233 {
3234         CHECK_ASE_UBERINTERVAL(interval);
3235
3236         if (ASE_INTERVALP(interval)) {
3237                 if (ASE_INTERVAL_EMPTY_P(interval))
3238                         return Qt;
3239                 if (ase_interval_closed_p(interval))
3240                         return Qt;
3241         } else if (ASE_INTERVAL_UNION_P(interval)) {
3242                 if (ase_interval_union_closed_p(interval))
3243                         return Qt;
3244         } else if (ASE_INTERVAL_INTERIOR_P(interval)) {
3245                 if (ase_interval_interior_closed_p(interval))
3246                         return Qt;
3247         }
3248         return Qnil;
3249 }
3250
3251
3252 /* constructors */
3253 /* ###autoload */
3254 DEFUN("ase-empty-interval", Fase_empty_interval, 0, 0, 0, /*
3255 Return the empty interval.
3256 */
3257       ())
3258 {
3259         return Qase_empty_interval;
3260 }
3261
3262 /* ###autoload */
3263 DEFUN("ase-universe-interval", Fase_universe_interval, 0, 0, 0, /*
3264 Return the universe interval.
3265 */
3266       ())
3267 {
3268         return Qase_universe_interval;
3269 }
3270
3271 /* ###autoload */
3272 DEFUN("ase-interval", Fase_interval, 1, 4, 0, /*
3273 Return a (primitive) interval with lower bound LOWER and upper bound UPPER.
3274 To construct a (degenerated) one point interval, leave out the UPPER part.
3275
3276 ASE's definition of an interval:
3277 With respect to a (strict) partial order, an interval is a connected
3278 subset of a poset.
3279
3280 If no special partial order is given, it defaults to less-equal-p (<=).
3281 If no special topology is given, it defaults to the po topology.
3282 */
3283       (lower, upper, lower_open_p, upper_open_p))
3284 {
3285         Lisp_Object result = Qnil;
3286         Lisp_Object args[2] = {lower, upper};
3287
3288         CHECK_COMPARABLE(lower);
3289         if (NILP(upper))
3290                 args[1] = upper = lower;
3291         else
3292                 CHECK_COMPARABLE(upper);
3293
3294         if (_ase_less_p(lower, upper))
3295                 result = ase_make_interval(
3296                         lower, upper, !NILP(lower_open_p), !NILP(upper_open_p));
3297         else
3298                 result = ase_make_interval(
3299                         upper, lower, !NILP(upper_open_p), !NILP(lower_open_p));
3300
3301         return result;
3302 }
3303
3304 DEFUN("ase-interval-contains-p", Fase_interval_contains_p, 2, 2, 0, /*
3305 Return non-`nil' iff INTERVAL (or a union thereof) contains OBJECT
3306 as one of its elements.  OBJECT can also be another interval or
3307 interval union to obtain the subset relation.
3308 */
3309       (interval, object))
3310 {
3311         ase_interval_type_t sup, sub;
3312         ase_element_relation_f relf = NULL;
3313
3314         CHECK_ASE_UBERINTERVAL(interval);
3315
3316         sup = ase_interval_type(interval);
3317         sub = ase_interval_type(object);
3318
3319         if ((relf = ase_optable_superset[sup][sub]) &&
3320             (!NILP(relf(interval, object))))
3321                 return Qt;
3322
3323         return Qnil;
3324 }
3325
3326 DEFUN("ase-interval-contains-where", Fase_interval_contains_where, 2, 2, 0, /*
3327 Return non-`nil' iff INTERVAL contains OBJECT as one of its elements.
3328 ELEMENT can also be another interval to obtain the subset relation.
3329
3330 The non-`nil' value returned is the primitive interval which
3331 contained OBJECT.
3332 */
3333       (interval, object))
3334 {
3335         ase_interval_type_t sup, sub;
3336         ase_element_relation_f relf = NULL;
3337
3338         CHECK_ASE_UBERINTERVAL(interval);
3339
3340         sup = ase_interval_type(interval);
3341         sub = ase_interval_type(object);
3342
3343         if ((relf = ase_optable_superset[sup][sub]))
3344                 return relf(interval, object);
3345
3346         return Qnil;
3347 }
3348
3349 DEFUN("ase-interval-connected-p", Fase_interval_connected_p, 0, MANY, 0, /*
3350 Return non-`nil' iff INTERVALS are connected.
3351 Arguments: &rest intervals
3352
3353 Zero intervals are trivially connected, as is one interval.
3354 */
3355       (int nargs, Lisp_Object *args))
3356 {
3357         /* trivial cases */
3358         if (nargs == 0)
3359                 return Qt;
3360
3361         switch (ase_interval_check_dimensions(nargs, args)) {
3362         case 0:
3363                 return Qt;
3364         case 1:
3365                 return ase_interval_connected_p_heapify(nargs, args);
3366         case -1:
3367                 signal_error(Qembed_error, Qnil);
3368                 return Qnil;
3369         default:
3370                 return ase_interval_connected_p_nsquare(nargs, args);
3371         }
3372 }
3373
3374 DEFUN("ase-interval-disjoint-p", Fase_interval_disjoint_p, 0, MANY, 0, /*
3375 Arguments: &rest intervals
3376 Return non-`nil' iff INTERVALS are (pairwise) disjoint.
3377
3378 Zero intervals are trivially disjoint, while one interval is
3379 trivially not disjoint.
3380 */
3381       (int nargs, Lisp_Object *args))
3382 {
3383         /* trivial cases */
3384         if (nargs == 0)
3385                 return Qt;
3386
3387         switch (ase_interval_check_dimensions(nargs, args)) {
3388         case 0:
3389                 return Qt;
3390         case -1:
3391                 signal_error(Qembed_error, Qnil);
3392                 return Qnil;
3393         default:
3394                 return ase_interval_disjoint_p_nsquare(nargs, args);
3395         }
3396 }
3397
3398 DEFUN("ase-interval-equal-p", Fase_interval_equal_p, 2, 2, 0, /*
3399 Return non-`nil' if I1 and I2 are equal in some sense, equality
3400 hereby means that I1 and I2 contain each other.
3401
3402 In fact, this is just a convenience function and totally equivalent
3403 to
3404   (and (ase-interval-contains-p i1 i2) (ase-interval-contains-p i2 i1))
3405 */
3406       (i1, i2))
3407 {
3408         Lisp_Object i1in2, i2in1;
3409
3410         CHECK_ASE_UBERINTERVAL(i1);
3411         CHECK_ASE_UBERINTERVAL(i2);
3412
3413         i1in2 = Fase_interval_contains_p(i1, i2);
3414         i2in1 = Fase_interval_contains_p(i2, i1);
3415
3416         if (!NILP(i1in2) && !NILP(i2in1))
3417                 return Qt;
3418
3419         return Qnil;
3420 }
3421
3422 /* more constructors */
3423 static Lisp_Object
3424 ase_interval_union_heapify(int nargs, Lisp_Object *args)
3425 {
3426         Lisp_Object result = Qnil, *newargs;
3427         int j, add = 0;
3428         struct ase_interval_union_item_s _ures, *ures = &_ures, *u;
3429         ase_interval_union_t ires;
3430
3431         /* check for ASE_INTERVALs and sort empty intervals to the tail */
3432         for (j = 0; j < nargs; ) {
3433                 if (ASE_INTERVAL_UNION_P(args[j])) {
3434                         /* remember the number of additional elements we need */
3435                         add += XASE_INTERVAL_UNION(args[j])->no_intv-1;
3436                         j++;
3437                 } else if (!ASE_INTERVAL_EMPTY_P(args[j])) {
3438                         j++;
3439                 } else {
3440                         _ase_swap(args, nargs-1, j);
3441                         nargs--;
3442                 }
3443         }
3444
3445         if (nargs == 0)
3446                 return Qase_empty_interval;
3447         if (nargs == 1)
3448                 return args[0];
3449
3450         if (add > 0) {
3451                 EMOD_ASE_DEBUG_INTV("exploding %d union items\n", add);
3452                 newargs = alloca_array(Lisp_Object, nargs+add);
3453                 /* move the first nargs args here */
3454                 memmove(newargs, args, nargs*sizeof(Lisp_Object));
3455                 /* now explode the whole story */
3456                 args = _ase_interval_union_explode_array(nargs, newargs, add);
3457                 nargs += add;
3458         }
3459
3460         /* sort intervals in less-p metric */
3461         _ase_heapsort(nargs, args, ase_interval_less_p);
3462
3463         /* we start with the empty union and unite left-associatively from
3464            the left */
3465         ures->current = Qase_empty_interval;
3466         u = ures->next = _ase_make_interval_union_item(args[0]);
3467         for (j = 1; j < nargs; j++) {
3468                 u = u->next = _ase_make_interval_union_item(args[j]);
3469         }
3470
3471         j = _ase_normalise_union(ures);
3472         if (j > 1) {
3473                 /* only return a union when there _is_ a union */
3474                 ires = _ase_make_interval_union(ures->next);
3475                 ires->no_intv = j;
3476
3477                 XSETASE_INTERVAL_UNION(result, ires);
3478                 return result;
3479         } else {
3480                 /* otherwise downgrade to a primitive interval */
3481                 result = ures->next->current;
3482                 _ase_interval_union_item_fini(ures->next);
3483                 return result;
3484         }
3485 }
3486
3487 static inline Lisp_Object
3488 ase_interval_union_nsquare(int nargs, Lisp_Object *args)
3489 {
3490         int i, j = 0;
3491         struct ase_interval_union_item_s _ures, *ures = &_ures, *u;
3492         ase_interval_union_t ires;
3493         Lisp_Object result = Qnil;
3494
3495         if (nargs == 0)
3496                 return Qase_empty_interval;
3497         else if (nargs == 1)
3498                 return args[0];
3499
3500         /* the slow approach */
3501         /* we start with the empty union and unite left-associatively from
3502            the left */
3503         ures->current = Qase_empty_interval;
3504         u = ures;
3505         for (i = 0; i < nargs; i++) {
3506                 Lisp_Object tmp = args[i];
3507                 if (ASE_INTERVAL_INTERIOR_P(tmp))
3508                         u = u->next = _ase_make_interval_union_item(tmp);
3509                 else if (ASE_INTERVAL_UNION_P(tmp)) {
3510                         ase_interval_union_item_t tra =
3511                                 XASE_INTERVAL_UNION_SER(tmp);
3512                         while (tra) {
3513                                 Lisp_Object c = tra->current;
3514                                 u = u->next = _ase_make_interval_union_item(c);
3515                                 tra = tra->next;
3516                         }
3517                 }
3518         }
3519
3520         j = _ase_normalise_union_intr(ures);
3521         if (j > 1) {
3522                 /* only return a union when there _is_ a union */
3523                 ires = _ase_make_interval_union(ures->next);
3524                 ires->no_intv = j;
3525
3526                 XSETASE_INTERVAL_UNION(result, ires);
3527                 return result;
3528         } else {
3529                 /* otherwise downgrade to a primitive interval */
3530                 result = ures->next->current;
3531                 _ase_interval_union_item_fini(ures->next);
3532                 return result;
3533         }
3534 }
3535
3536 DEFUN("ase-interval-union", Fase_interval_union, 0, MANY, 0, /*
3537 Arguments: &rest intervals
3538 Return the union of all INTERVALS.
3539 */
3540       (int nargs, Lisp_Object *args))
3541 {
3542         int dim;
3543
3544         /* trivial cases */
3545         if (nargs == 0)
3546                 return Qase_empty_interval;
3547
3548         dim = ase_interval_check_dimensions(nargs, args);
3549         switch (dim) {
3550         case 0:
3551                 return Qase_empty_interval;
3552         case 1:
3553                 return ase_interval_union_heapify(nargs, args);
3554         case -1:
3555                 signal_error(Qembed_error, Qnil);
3556                 return Qnil;
3557         default:
3558                 return ase_interval_union_nsquare(nargs, args);
3559         }
3560 }
3561
3562 static int
3563 ase_interval_intersection_maybe_empty(int nargs, Lisp_Object *args)
3564 {
3565         /* check for empty intervals, return 1 if there are some */
3566         int j;
3567
3568         for (j = 0; j < nargs; j++) {
3569                 if (ASE_INTERVAL_EMPTY_P(args[j])) {
3570                         return 1;
3571                 }
3572         }
3573         return 0;
3574 }
3575
3576 static Lisp_Object
3577 ase_interval_intersection_heapify(int nargs, Lisp_Object *args)
3578 {
3579         int j;
3580
3581         if (nargs == 0)
3582                 return Qase_empty_interval;
3583         else if (nargs == 1)
3584                 return args[0];
3585         else if (ase_interval_intersection_maybe_empty(nargs, args))
3586                 return Qase_empty_interval;
3587
3588         _ase_heapsort(nargs, args, ase_interval_or_union_less_p);
3589
3590         /* we start with the universe and intersect left-associatively from
3591            the left */
3592         for (j = 1; j < nargs; j++) {
3593                 ase_interval_type_t t1 = ase_interval_type(args[0]);
3594                 ase_interval_type_t t2 = ase_interval_type(args[j]);
3595                 ase_binary_operation_f opf = ase_optable_intersect[t1][t2];
3596
3597                 if (opf) {
3598                         args[0] = opf(args[0], args[j]);
3599                 }
3600         }
3601
3602         return args[0];
3603 }
3604
3605 static Lisp_Object
3606 ase_interval_intersection_nsquare(int nargs, Lisp_Object *args)
3607 {
3608         int j;
3609
3610         if (nargs == 0)
3611                 return Qase_empty_interval;
3612         else if (nargs == 1)
3613                 return args[0];
3614         else if (ase_interval_intersection_maybe_empty(nargs, args))
3615                 return Qase_empty_interval;
3616
3617         /* we start with the universe and intersect left-associatively from
3618            the left */
3619         for (j = 1; j < nargs; j++) {
3620                 ase_interval_type_t t1 = ase_interval_type(args[0]);
3621                 ase_interval_type_t t2 = ase_interval_type(args[j]);
3622                 ase_binary_operation_f opf = ase_optable_intersect[t1][t2];
3623
3624                 if (opf) {
3625                         args[0] = opf(args[0], args[j]);
3626                 }
3627         }
3628
3629         return args[0];
3630 }
3631
3632 DEFUN("ase-interval-intersection", Fase_interval_intersection, 0, MANY, 0, /*
3633 Arguments: &rest intervals
3634 Return the intersection of all INTERVALS.
3635 */
3636       (int nargs, Lisp_Object *args))
3637 {
3638         /* trivial cases */
3639         if (nargs == 0)
3640                 return Qase_empty_interval;
3641         else if (nargs == 1)
3642                 return args[0];
3643
3644         switch (ase_interval_check_dimensions(nargs, args)) {
3645         case 0:
3646                 return Qase_empty_interval;
3647         case 1:
3648                 return ase_interval_intersection_heapify(nargs, args);
3649         case -1:
3650                 signal_error(Qembed_error, Qnil);
3651                 return Qnil;
3652         default:
3653                 return ase_interval_intersection_nsquare(nargs, args);
3654         }
3655 }
3656
3657 static inline Lisp_Object
3658 ase_interval_difference_nsquare(int nargs, Lisp_Object *args)
3659 {
3660         int j;
3661
3662         /* check for ASE_INTERVALs and sort empty intervals to the tail */
3663         for (j = 1; j < nargs; j++) {
3664                 /* we can only resort empty intervals for j >= 1 */
3665                 if (ASE_INTERVAL_EMPTY_P(args[j])) {
3666                         _ase_swap(args, nargs-1, j);
3667                         nargs--;
3668                 }
3669         }
3670
3671         if (nargs == 0)
3672                 return Qase_empty_interval;
3673         if (nargs == 1)
3674                 return args[0];
3675
3676         /* we must not use heapsort here, since subtracting sets is
3677          * not commutative */
3678
3679         /* we start with args[0] and subtract left-associatively from
3680            the left */
3681         for (j = 1; j < nargs; j++) {
3682                 ase_interval_type_t t1 = ase_interval_type(args[0]);
3683                 ase_interval_type_t t2 = ase_interval_type(args[j]);
3684                 ase_binary_operation_f opf = ase_optable_subtract[t1][t2];
3685
3686                 if (opf) {
3687                         args[0] = opf(args[0], args[j]);
3688                 }
3689         }
3690
3691         return args[0];
3692 }
3693
3694 DEFUN("ase-interval-difference", Fase_interval_difference, 0, MANY, 0, /*
3695 Arguments: &rest intervals
3696 Return the difference of all INTERVALS from left to right.
3697 */
3698       (int nargs, Lisp_Object *args))
3699 {
3700         /* Treat the case args[0] = ( ) specially */
3701         if (nargs == 0)
3702                 return Qase_empty_interval;
3703         else if (nargs == 1)
3704                 return args[0];
3705
3706         switch (ase_interval_check_dimensions(nargs, args)) {
3707         case 0:
3708                 return Qase_empty_interval;
3709         case -1:
3710                 signal_error(Qembed_error, Qnil);
3711                 return Qnil;
3712         default:
3713                 return ase_interval_difference_nsquare(nargs, args);
3714         }
3715 }
3716
3717 DEFUN("ase-copy-interval", Fase_copy_interval, 1, 1, 0, /*
3718 Return a copy of INTERVAL.
3719 */
3720       (interval))
3721 {
3722         CHECK_ASE_INTERVAL(interval);
3723
3724         return ase_copy_interval(interval);
3725 }
3726
3727 DEFUN("ase-interval-boundary", Fase_interval_boundary, 1, 1, 0, /*
3728 Return the boundary of INTERVAL, that is the interior of INTERVAL
3729 subtracted from the closure of INTERVAL.
3730 */
3731       (interval))
3732 {
3733         CHECK_ASE_UBERINTERVAL(interval);
3734
3735         if (ASE_INTERVAL_EMPTY_P(interval))
3736                 return Qase_empty_interval;
3737         else if (ASE_INTERVALP(interval))
3738                 return ase_interval_boundary(interval);
3739         else if (ASE_INTERVAL_INTERIOR_P(interval))
3740                 return ase_interval_interior_boundary(interval);
3741         else if (ASE_INTERVAL_UNION_P(interval))
3742                 return ase_interval_union_boundary(interval);
3743
3744         return Qnil;
3745 }
3746
3747 DEFUN("ase-interval-closure", Fase_interval_closure, 1, 1, 0, /*
3748 Return the closure of INTERVAL, that is the smallest closed set
3749 that contains INTERVAL.
3750 */
3751       (interval))
3752 {
3753         CHECK_ASE_UBERINTERVAL(interval);
3754
3755         if (ASE_INTERVAL_EMPTY_P(interval))
3756                 return Qase_empty_interval;
3757         else if (ASE_INTERVALP(interval))
3758                 return ase_interval_closure(interval);
3759         else if (ASE_INTERVAL_INTERIOR_P(interval))
3760                 return ase_interval_interior_closure(interval);
3761         else if (ASE_INTERVAL_UNION_P(interval))
3762                 return ase_interval_union_closure(interval);
3763
3764         return Qnil;
3765 }
3766
3767 DEFUN("ase-interval-interior", Fase_interval_interior, 1, 1, 0, /*
3768 Return the interior of INTERVAL, that is the largest open set that
3769 is contained in INTERVAL.
3770 */
3771       (interval))
3772 {
3773         CHECK_ASE_UBERINTERVAL(interval);
3774
3775         if (ASE_INTERVAL_EMPTY_P(interval))
3776                 return Qase_empty_interval;
3777         else if (ASE_INTERVALP(interval))
3778                 return ase_interval_interior(interval);
3779         else if (ASE_INTERVAL_INTERIOR_P(interval))
3780                 return ase_interval_interior_interior(interval);
3781         else if (ASE_INTERVAL_UNION_P(interval))
3782                 return ase_interval_union_interior(interval);
3783
3784         return Qnil;
3785 }
3786
3787 /* Accessors */
3788 DEFUN("ase-interval-lower", Fase_interval_lower, 1, 1, 0, /*
3789 Return the lower bound of INTERVAL or `nil' if empty.
3790 Only the numerical value is returned.
3791 */
3792       (interval))
3793 {
3794         CHECK_ASE_INTERVAL(interval);
3795
3796         if (ASE_INTERVAL_EMPTY_P(interval))
3797                 return Qnil;
3798
3799         return XASE_INTERVAL(interval)->lower;
3800 }
3801
3802 DEFUN("ase-interval-upper", Fase_interval_upper, 1, 1, 0, /*
3803 Return the upper bound of INTERVAL or `nil' if empty.
3804 Only the numerical value is returned.
3805 */
3806       (interval))
3807 {
3808         CHECK_ASE_INTERVAL(interval);
3809
3810         if (ASE_INTERVAL_EMPTY_P(interval))
3811                 return Qnil;
3812
3813         return XASE_INTERVAL(interval)->upper;
3814 }
3815
3816 DEFUN("ase-interval-lower*", Fase_interval_lower_, 1, 1, 0, /*
3817 Return the lower bound of INTERVAL or `nil' if empty
3818 along with the boundary shape.
3819 */
3820       (interval))
3821 {
3822         Lisp_Object res;
3823
3824         CHECK_ASE_INTERVAL(interval);
3825         if (ASE_INTERVAL_EMPTY_P(interval))
3826                 return Qnil;
3827
3828         res = XASE_INTERVAL(interval)->lower;
3829         if (XASE_INTERVAL(interval)->lower_open_p)
3830                 return Fcons(Q_open, res);
3831         else
3832                 return Fcons(Q_closed, res);
3833 }
3834
3835 DEFUN("ase-interval-upper*", Fase_interval_upper_, 1, 1, 0, /*
3836 Return the upper bound of INTERVAL or `nil' if empty
3837 along with the boundary shape.
3838 */
3839       (interval))
3840 {
3841         Lisp_Object res;
3842
3843         CHECK_ASE_INTERVAL(interval);
3844         if (ASE_INTERVAL_EMPTY_P(interval))
3845                 return Qnil;
3846
3847         res = XASE_INTERVAL(interval)->upper;
3848         if (XASE_INTERVAL(interval)->upper_open_p)
3849                 return Fcons(Q_open, res);
3850         else
3851                 return Fcons(Q_closed, res);
3852 }
3853
3854 DEFUN("ase-interval-explode-union", Fase_interval_explode_union, 1, 1, 0, /*
3855 Return IUNION exploded into primitive intervals and listed in a dllist.
3856 */
3857       (iunion))
3858 {
3859         Lisp_Object result = Qnil;
3860         dllist_t resdll = make_dllist();
3861         ase_interval_union_item_t u;
3862
3863         CHECK_ASE_INTERVAL_UNION(iunion);
3864         u = XASE_INTERVAL_UNION_SER(iunion);
3865         while (u) {
3866                 dllist_append(resdll, (void*)u->current);
3867                 u = u->next;
3868         }
3869
3870         XSETDLLIST(result, resdll);
3871         return result;
3872 }
3873
3874
3875 /* Measures */
3876 DEFUN("ase-interval-lebesgue-measure",
3877       Fase_interval_lebesgue_measure, 1, 1, 0, /*
3878 Return the Lebesgue measure of INTERVAL.
3879 */
3880       (interval))
3881 {
3882         CHECK_ASE_UBERINTERVAL(interval);
3883
3884         if (ASE_INTERVALP(interval))
3885                 return ase_interval_lebesgue_measure(XASE_INTERVAL(interval));
3886         else if (ASE_INTERVAL_INTERIOR_P(interval))
3887                 return ase_interval_interior_lebesgue_measure(
3888                         XASE_CARTESIAN(interval));
3889         else if (ASE_INTERVAL_UNION_P(interval))
3890                 return ase_interval_union_lebesgue_measure(
3891                         XASE_INTERVAL_UNION(interval));
3892         return Qnil;
3893 }
3894
3895 DEFUN("ase-interval-rational-measure",
3896       Fase_interval_rational_measure, 1, 1, 0, /*
3897 Return the number of rational integers in INTERVAL.
3898 */
3899       (interval))
3900 {
3901         CHECK_ASE_UBERINTERVAL(interval);
3902
3903         if (ASE_INTERVALP(interval))
3904                 return ase_interval_rational_measure(XASE_INTERVAL(interval));
3905         else if (ASE_INTERVAL_INTERIOR_P(interval))
3906                 return ase_interval_interior_rational_measure(
3907                         XASE_CARTESIAN(interval));
3908         else if (ASE_INTERVAL_UNION_P(interval))
3909                 return ase_interval_union_rational_measure(
3910                         XASE_INTERVAL_UNION(interval));
3911         return Qnil;
3912 }
3913
3914 DEFUN("ase-interval-dump", Fase_interval_dump, 1, 1, 0, /*
3915 */
3916       (interval))
3917 {
3918         CHECK_ASE_INTERVAL_OR_UNION(interval);
3919
3920         if (ASE_INTERVALP(interval)) {
3921                 ase_interval_prnt(interval, Qexternal_debugging_output, 0);
3922                 write_c_string("\n", Qexternal_debugging_output);
3923                 return Qt;
3924         } else {
3925                 ase_interval_union_prnt(
3926                         interval, Qexternal_debugging_output, 0);
3927                 write_c_string("\n", Qexternal_debugging_output);
3928                 return Qt;
3929         }
3930 }
3931
3932 \f
3933 static inline Lisp_Object
3934 ase_interval_add_i_obj(Lisp_Object intv, Lisp_Object number)
3935 {
3936         int lopenp = XASE_INTERVAL(intv)->lower_open_p;
3937         int uopenp = XASE_INTERVAL(intv)->upper_open_p;
3938         int lequp = XASE_INTERVAL(intv)->lower_eq_upper_p;
3939         Lisp_Object args[2] = {Qnil, number};
3940         Lisp_Object newl, newu;
3941
3942         args[0] = XASE_INTERVAL(intv)->lower;
3943         newl = ent_binop(ASE_BINARY_OP_SUM, args[0], args[1]);
3944         if (!lequp) {
3945                 args[0] = XASE_INTERVAL(intv)->upper;
3946                 newu = ent_binop(ASE_BINARY_OP_SUM, args[0], args[1]);
3947                 return ase_make_interval(newl, newu, lopenp, uopenp);
3948         } else {
3949                 return ase_make_interval(newl, newl, lopenp, uopenp);
3950         }
3951 }
3952
3953 static inline Lisp_Object
3954 ase_interval_add_obj_i(Lisp_Object number, Lisp_Object intv)
3955 {
3956         return ase_interval_add_i_obj(intv, number);
3957 }
3958
3959 \f
3960 /* initialiser stuff */
3961 static inline void
3962 ase_interval_binary_optable_init(void)
3963 {
3964         int idx = ase_optable_index_typesym(Qase_interval);
3965         ent_binop_register(ASE_BINARY_OP_SUM,
3966                            idx, INT_T, ase_interval_add_i_obj);
3967         ent_binop_register(ASE_BINARY_OP_SUM,
3968                            INT_T, idx, ase_interval_add_obj_i);
3969         ent_binop_register(ASE_BINARY_OP_SUM,
3970                            idx, FLOAT_T, ase_interval_add_obj_i);
3971         ent_binop_register(ASE_BINARY_OP_SUM,
3972                            FLOAT_T, idx, ase_interval_add_obj_i);
3973 }
3974
3975 void
3976 EMOD_PUBINIT(void)
3977 {
3978         /* constructors */
3979         DEFSUBR(Fase_empty_interval);
3980         DEFSUBR(Fase_universe_interval);
3981         DEFSUBR(Fase_interval);
3982         DEFSUBR(Fase_interval_union);
3983         DEFSUBR(Fase_interval_intersection);
3984         DEFSUBR(Fase_interval_difference);
3985         DEFSUBR(Fase_copy_interval);
3986         DEFSUBR(Fase_interval_boundary);
3987         DEFSUBR(Fase_interval_interior);
3988         DEFSUBR(Fase_interval_closure);
3989         /* predicates */
3990         DEFSUBR(Fase_intervalp);
3991         DEFSUBR(Fase_interval_union_p);
3992         DEFSUBR(Fase_interval_empty_p);
3993         DEFSUBR(Fase_interval_imprimitive_p);
3994         DEFSUBR(Fase_interval_open_p);
3995         DEFSUBR(Fase_interval_closed_p);
3996         DEFSUBR(Fase_interval_contains_p);
3997         DEFSUBR(Fase_interval_contains_where);
3998         DEFSUBR(Fase_interval_connected_p);
3999         DEFSUBR(Fase_interval_disjoint_p);
4000         DEFSUBR(Fase_interval_equal_p);
4001         /* accessors */
4002         DEFSUBR(Fase_interval_lower);
4003         DEFSUBR(Fase_interval_lower_);
4004         DEFSUBR(Fase_interval_upper);
4005         DEFSUBR(Fase_interval_upper_);
4006         DEFSUBR(Fase_interval_explode_union);
4007         /* measures */
4008         DEFSUBR(Fase_interval_lebesgue_measure);
4009         DEFSUBR(Fase_interval_rational_measure);
4010
4011         DEFASETYPE_WITH_OPS(Qase_interval, "ase:interval");
4012         defsymbol(&Qase_intervalp, "ase:intervalp");
4013         DEFASETYPE_WITH_OPS(Qase_interval_union, "ase:interval-union");
4014         defsymbol(&Qase_interval_union_p, "ase:interval-union-p");
4015
4016         defsymbol(&Q_less, ":<");
4017         defsymbol(&Q_greater, ":>");
4018         defsymbol(&Q_eql, ":=");
4019         DEFKEYWORD(Q_unknown);
4020         DEFKEYWORD(Q_open);
4021         DEFKEYWORD(Q_closed);
4022         DEFKEYWORD(Q_disjoint);
4023         DEFKEYWORD(Q_connected);
4024
4025         /* debugging */
4026         DEFSUBR(Fase_interval_dump);
4027
4028         ase_interval_binary_optable_init();
4029
4030         EMOD_PUBREINIT();
4031
4032         DEFVAR_CONST_LISP("ase-empty-interval", &Qase_empty_interval /*
4033 The interval which contains no elements.
4034                                                                      */);
4035         DEFVAR_CONST_LISP("ase-universe-interval", &Qase_universe_interval /*
4036 The interval which contains all elements.
4037                                                                            */);
4038
4039         Fprovide(intern("ase-interval"));
4040         return;
4041 }
4042
4043 void
4044 EMOD_PUBREINIT(void)
4045 {
4046         Qase_empty_interval = ase_empty_interval();
4047         Qase_universe_interval = ase_universe_interval();
4048         staticpro(&Qase_empty_interval);
4049         staticpro(&Qase_universe_interval);
4050
4051         if (LIKELY(ase_empty_sets != NULL)) {
4052                 dllist_append(ase_empty_sets, (void*)Qase_empty_interval);
4053         } else {
4054                 EMOD_ASE_CRITICAL("Cannot proclaim empty elements\n");
4055         }
4056         return;
4057 }
4058
4059 void
4060 EMOD_PUBDEINIT(void)
4061 {
4062         Frevoke(intern("ase-interval"));
4063         return;
4064 }
4065
4066 /* ase-interval ends here */