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                 (void)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                         _ase_interval_union_item_fini(tmp);
2351                 }
2352                 while (ur->next)
2353                         ur = ur->next;
2354                 lastiv = ur->current;
2355         }
2356
2357         if (ASE_INTERVAL_INTERIOR_P(lastiv)) {
2358                 _ase_normalise_union_intr(&ures);
2359         }
2360
2361         return ures.next;
2362 }
2363
2364 Lisp_Object ase_interval_interior_boundary(Lisp_Object intv_intr_prod)
2365 {
2366         ase_interval_union_item_t u =
2367                 _ase_interval_interior_boundary(
2368                         XASE_CARTESIAN(intv_intr_prod));
2369
2370         if (!u)
2371                 return Qase_empty_interval;
2372
2373         return _ase_wrap_interval_union(
2374                 _ase_make_interval_union(u));
2375 }
2376
2377 Lisp_Object ase_interval_union_boundary(Lisp_Object intv_union)
2378 {
2379         ase_interval_union_item_t u =
2380                 _ase_interval_union_boundary(
2381                         XASE_INTERVAL_UNION_SER(intv_union));
2382
2383         if (!u)
2384                 return Qase_empty_interval;
2385
2386         return _ase_wrap_interval_union(
2387                 _ase_make_interval_union(u));
2388 }
2389
2390 static ase_interval_t
2391 _ase_interval_closure(ase_interval_t a)
2392 {
2393         if (a == NULL)
2394                 return NULL;
2395         if (_ase_interval_closed_p(a))
2396                 return a;
2397
2398         return _ase_make_interval(a->lower, a->upper, 0, 0);
2399 }
2400
2401 Lisp_Object ase_interval_closure(Lisp_Object intv)
2402 {
2403         ase_interval_t u =
2404                 _ase_interval_closure(XASE_INTERVAL(intv));
2405
2406         if (!u)
2407                 return Qase_empty_interval;
2408
2409         return _ase_wrap_interval(u);
2410 }
2411
2412 static ase_cartesian_t
2413 _ase_interval_interior_closure(ase_cartesian_t c)
2414 {
2415         int i, dim = ase_cartesian_dimension(c);
2416         Lisp_Object *os = ase_cartesian_objects(c);
2417         Lisp_Object *newos = alloca_array(Lisp_Object, dim);
2418
2419         for (i = 0; i < dim; i++) {
2420                 newos[i] = ase_interval_closure(os[i]);
2421         }
2422
2423         return _ase_make_cartesian(dim, newos, 1);
2424 }
2425
2426 Lisp_Object ase_interval_interior_closure(Lisp_Object intv_intr_prod)
2427 {
2428         ase_cartesian_t c =
2429                 _ase_interval_interior_closure(
2430                         XASE_CARTESIAN(intv_intr_prod));
2431
2432         if (!c)
2433                 return Qase_empty_interval;
2434
2435         return _ase_wrap_cartesian_interior(c);
2436 }
2437
2438 static ase_interval_union_item_t
2439 _ase_interval_union_closure(ase_interval_union_item_t u)
2440 {
2441         struct ase_interval_union_item_s ures, *ur = &ures;
2442
2443         if (_ase_interval_union_closed_p(u))
2444                 return u;
2445
2446         ur->current = Qase_empty_interval;
2447         ur->next = NULL;
2448         while (u) {
2449                 Lisp_Object ltmp = Qnil;
2450                 if (ASE_INTERVALP(u->current)) {
2451                         ase_interval_t tmp =
2452                                 _ase_interval_closure(
2453                                         XASE_INTERVAL(u->current));
2454                         u = u->next;
2455                         if (!tmp)
2456                                 continue;
2457                         ltmp = _ase_wrap_interval(tmp);
2458                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
2459                         ase_cartesian_t tmp =
2460                                 _ase_interval_interior_closure(
2461                                         XASE_CARTESIAN(u->current));
2462                         u = u->next;
2463                         if (!tmp)
2464                                 continue;
2465                         ltmp = _ase_wrap_cartesian_interior(tmp);
2466                 }
2467                 ur = ur->next = _ase_make_interval_union_item(ltmp);
2468         }
2469
2470         _ase_normalise_union(&ures);
2471
2472         return ures.next;
2473 }
2474
2475 Lisp_Object ase_interval_union_closure(Lisp_Object intv_union)
2476 {
2477         ase_interval_union_item_t u =
2478                 _ase_interval_union_closure(
2479                         XASE_INTERVAL_UNION_SER(intv_union));
2480
2481         if (!u)
2482                 return Qase_empty_interval;
2483
2484         if (u->next)
2485                 return _ase_wrap_interval_union(
2486                         _ase_make_interval_union(u));
2487
2488         return u->current;
2489 }
2490
2491 static ase_interval_t
2492 _ase_interval_interior(ase_interval_t a)
2493 {
2494         if (a == NULL || _ase_equal_p(a->lower, a->upper))
2495                 return NULL;
2496
2497         if (_ase_interval_open_p(a))
2498                 return a;
2499
2500         return _ase_make_interval(a->lower, a->upper, 1, 1);
2501 }
2502
2503 Lisp_Object ase_interval_interior(Lisp_Object intv)
2504 {
2505         ase_interval_t u =
2506                 _ase_interval_interior(XASE_INTERVAL(intv));
2507
2508         if (!u)
2509                 return Qase_empty_interval;
2510
2511         return _ase_wrap_interval(u);
2512 }
2513
2514 static ase_cartesian_t
2515 _ase_interval_interior_interior(ase_cartesian_t c)
2516 {
2517         int i, dim = ase_cartesian_dimension(c);
2518         Lisp_Object *os = ase_cartesian_objects(c);
2519         Lisp_Object *newos = alloca_array(Lisp_Object, dim);
2520
2521         for (i = 0; i < dim; i++) {
2522                 newos[i] = ase_interval_interior(os[i]);
2523         }
2524
2525         return _ase_make_cartesian(dim, newos, 1);
2526 }
2527
2528 Lisp_Object ase_interval_interior_interior(Lisp_Object intv_intr_prod)
2529 {
2530         ase_cartesian_t c =
2531                 _ase_interval_interior_interior(
2532                         XASE_CARTESIAN(intv_intr_prod));
2533
2534         if (!c)
2535                 return Qase_empty_interval;
2536
2537         return _ase_wrap_cartesian_interior(c);
2538 }
2539
2540 static ase_interval_union_item_t
2541 _ase_interval_union_interior(ase_interval_union_item_t u)
2542 {
2543         struct ase_interval_union_item_s ures, *ur = &ures;
2544
2545         if (_ase_interval_union_open_p(u))
2546                 return u;
2547
2548         ur->current = Qase_empty_interval;
2549         ur->next = NULL;
2550         while (u) {
2551                 Lisp_Object ltmp = Qnil;
2552                 if (ASE_INTERVALP(u->current)) {
2553                         ase_interval_t tmp =
2554                                 _ase_interval_interior(
2555                                         XASE_INTERVAL(u->current));
2556                         u = u->next;
2557                         if (!tmp)
2558                                 continue;
2559                         ltmp = _ase_wrap_interval(tmp);
2560                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
2561                         ase_cartesian_t tmp =
2562                                 _ase_interval_interior_interior(
2563                                         XASE_CARTESIAN(u->current));
2564                         u = u->next;
2565                         if (!tmp)
2566                                 continue;
2567                         ltmp = _ase_wrap_cartesian_interior(tmp);
2568                 }
2569                 ur = ur->next = _ase_make_interval_union_item(ltmp);
2570         }
2571
2572         return ures.next;
2573 }
2574
2575 Lisp_Object ase_interval_union_interior(Lisp_Object intv_union)
2576 {
2577         ase_interval_union_item_t u =
2578                 _ase_interval_union_interior(
2579                         XASE_INTERVAL_UNION_SER(intv_union));
2580
2581         if (!u)
2582                 return Qase_empty_interval;
2583
2584         if (u->next)
2585                 return _ase_wrap_interval_union(
2586                         _ase_make_interval_union(u));
2587
2588         return u->current;
2589 }
2590
2591 static ase_interval_type_t
2592 ase_interval_type(Lisp_Object o)
2593 {
2594         if (ASE_INTERVALP(o)) {
2595                 return ASE_ITYPE_INTERVAL;
2596         } else if (ASE_INTERVAL_UNION_P(o)) {
2597                 return ASE_ITYPE_UNION;
2598         } else if (ASE_INTERVAL_INTERIOR_P(o)) {
2599                 return ASE_ITYPE_INTERIOR;
2600         } else {
2601                 return ASE_ITYPE_OBJECT;
2602         }
2603 }
2604
2605 static inline void
2606 _ase_heapsort_sift(Lisp_Object *args, int start, int count,
2607                    ase_order_relation_f lessp)
2608 {
2609         int root = start, child;
2610
2611         while (2*root  + 1 < count) {
2612                 child = 2*root + 1;
2613
2614                 if (child < count-1 && lessp(args[child], args[child+1]))
2615                         child++;
2616                 if (lessp(args[root], args[child])) {
2617                         _ase_swap(args, root, child);
2618                         root = child;
2619                 } else {
2620                         return;
2621                 }
2622         }
2623         return;
2624 }
2625
2626 static inline void
2627 _ase_heapsort(int nargs, Lisp_Object *args, ase_order_relation_f lessp)
2628 {
2629         int start = nargs/2 - 1, end = nargs-1;
2630
2631         while (start >= 0) {
2632                 _ase_heapsort_sift(args, start, nargs, lessp);
2633                 start--;
2634         }
2635         while (end > 0) {
2636                 _ase_swap(args, end, 0);
2637                 _ase_heapsort_sift(args, 0, end, lessp);
2638                 end--;
2639         }
2640         return;
2641 }
2642
2643 static Lisp_Object
2644 ase_interval_connected_p_heapify(int nargs, Lisp_Object *args)
2645 {
2646         /* special case for flat intervals,
2647          * uses a heapsort to ease the connectivity question */
2648         Lisp_Object *newargs;
2649         int j, add = 0;
2650
2651         /* check for ASE_INTERVALs and sort empty intervals to the tail */
2652         for (j = 0; j < nargs; ) {
2653                 if (ASE_INTERVAL_UNION_P(args[j])) {
2654                         /* remember the number of additional elements we need */
2655                         add += XASE_INTERVAL_UNION(args[j])->no_intv-1;
2656                         j++;
2657                 } else if (!ASE_INTERVAL_EMPTY_P(args[j])) {
2658                         j++;
2659                 } else {
2660                         _ase_swap(args, nargs-1, j);
2661                         nargs--;
2662                 }
2663         }
2664
2665         if (nargs == 0)
2666                 return Qt;
2667         else if (nargs == 1)    /* reflexivity! */
2668                 return (ASE_INTERVAL_UNION_P(args[0]) ? Qnil : Qt);
2669
2670         if (add > 0) {
2671                 EMOD_ASE_DEBUG_INTV("exploding %d union items\n", add);
2672                 newargs = alloca_array(Lisp_Object, nargs+add);
2673                 /* move the first nargs args here */
2674                 memmove(newargs, args, nargs*sizeof(Lisp_Object));
2675                 /* now explode the whole story */
2676                 args = _ase_interval_union_explode_array(nargs, newargs, add);
2677                 nargs += add;
2678         }
2679
2680         /* sort intervals in less-p metric */
2681         _ase_heapsort(nargs, args, ase_interval_less_p);
2682
2683         for (j = 1; j < nargs; j++) {
2684                 Lisp_Object o1 = args[j-1], o2 = args[j];
2685                 if (!ase_interval_connected_p(o1, o2))
2686                         return Qnil;
2687         }
2688
2689         return Qt;
2690 }
2691
2692 static Lisp_Object
2693 ase_interval_connected_p_nsquare(int nargs, Lisp_Object *args)
2694 {
2695         int i, j;
2696         ase_interval_type_t t1, t2;
2697         ase_st_relation_f relf = NULL;
2698
2699         if (nargs == 0)
2700                 return Qt;
2701         else if (nargs == 1 && !ASE_INTERVAL_UNION_P(args[0]))
2702                 return Qt;
2703         else if (nargs == 1 &&
2704                  ASE_INTERVAL_INTERIOR_P(XASE_INTERVAL_UNION_FIRST(args[0]))) {
2705                 ase_interval_union_item_t u1, u2;
2706                 u1 = XASE_INTERVAL_UNION_SER(args[0]);
2707                 t1 = t2 = ASE_ITYPE_INTERIOR;
2708                 relf = ase_optable_connected[t1][t2];
2709                 while ((u2 = u1->next)) {
2710                         Lisp_Object o1 = u1->current;
2711                         Lisp_Object o2 = u2->current;
2712                         if (!relf(o1, o2))
2713                                 return Qnil;
2714                         u1 = u1->next;
2715                 }
2716                 return Qt;
2717         } else if (nargs == 1)
2718                 return Qnil;
2719
2720         /* the slow approach */
2721         /* connectivity itself is an intransitive relation,
2722          * but if any two are (locally) connected then all items are
2723          * globally connected */
2724         for (i = 0; i < nargs-1; i++) {
2725                 Lisp_Object o1 = args[i];
2726                 int foundp = 0;
2727                 t1 = ase_interval_type(o1);
2728                 for (j = i+1; j < nargs && !foundp; j++) {
2729                         Lisp_Object o2 = args[j];
2730                         t2 = ase_interval_type(o2);
2731                         relf = ase_optable_connected[t1][t2];
2732                         if (relf && relf(o1, o2))
2733                                 foundp = 1;
2734                 }
2735                 if (!foundp)
2736                         return Qnil;
2737         }
2738
2739         return Qt;
2740 }
2741
2742 static Lisp_Object
2743 ase_interval_disjoint_p_nsquare(int nargs, Lisp_Object *args)
2744 {
2745         int i, j;
2746         ase_interval_type_t t1, t2;
2747         ase_st_relation_f relf = NULL;
2748
2749         if (nargs == 0)
2750                 return Qt;
2751         else if (nargs == 1)    /* irreflexivity! */
2752                 return Qnil;
2753
2754         /* don't think that sorting helps here, but i'll profile this one day */
2755         /* pairwise (local) disjunction implies global disjunction */
2756         for (i = 0; i < nargs-1; i++) {
2757                 Lisp_Object o1 = args[i];
2758                 t1 = ase_interval_type(o1);
2759                 for (j = i+1; j < nargs; j++) {
2760                         Lisp_Object o2 = args[j];
2761                         t2 = ase_interval_type(o2);
2762                         relf = ase_optable_disjoint[t1][t2];
2763                         if (relf && !relf(o1, o2))
2764                                 return Qnil;
2765                 }
2766         }
2767
2768         return Qt;
2769 }
2770
2771 static int
2772 ase_interval_dimension(Lisp_Object o)
2773 {
2774         switch (ase_interval_type(o)) {
2775         case ASE_ITYPE_INTERVAL:
2776                 return 1;
2777         case ASE_ITYPE_INTERIOR:
2778                 return XASE_CARTESIAN_DIMENSION(o);
2779         case ASE_ITYPE_UNION:
2780                 return ase_interval_dimension(XASE_INTERVAL_UNION_FIRST(o));
2781
2782         case ASE_ITYPE_OBJECT:
2783         case NUMBER_OF_ASE_ITYPES:
2784         default:
2785                 return -1;
2786         }
2787 }
2788
2789 static int
2790 ase_interval_check_dimensions(int nargs, Lisp_Object *args)
2791 {
2792         int i, predicdim = 0;
2793
2794         if (nargs == 0)
2795                 return 0;
2796
2797         /* partial loop unrolling */
2798         for (i = 0; i < nargs; i++) {
2799                 CHECK_ASE_UBERINTERVAL(args[i]);
2800                 if (!ASE_INTERVAL_EMPTY_P(args[i])) {
2801                         predicdim = ase_interval_dimension(args[i]);
2802                         break;
2803                 }
2804         }
2805         for (i++; i < nargs; i++) {
2806                 CHECK_ASE_UBERINTERVAL(args[i]);
2807                 if (!ASE_INTERVAL_EMPTY_P(args[i]) &&
2808                     predicdim != ase_interval_dimension(args[i]))
2809                         return -1;
2810         }
2811         return predicdim;
2812 }
2813
2814
2815 \f
2816 /* Measures */
2817 static Lisp_Object
2818 _ase_interval_compute_lebesgue(ase_interval_t a)
2819 {
2820         if (a == NULL)
2821                 return Qzero;
2822
2823         return ent_binop(ASE_BINARY_OP_DIFF, a->upper, a->lower);
2824 }
2825
2826 static inline void
2827 _ase_interval_update_lebesgue(ase_interval_t a)
2828 {
2829         if (a && NILP(a->lebesgue_measure))
2830                 a->lebesgue_measure = _ase_interval_compute_lebesgue(a);
2831         return;
2832 }
2833
2834 static inline Lisp_Object
2835 _ase_interval_lebesgue(ase_interval_t a)
2836 {
2837         if (a)
2838                 return a->lebesgue_measure;
2839         else
2840                 return Qzero;
2841 }
2842
2843 static Lisp_Object
2844 _ase_interval_compute_rational(ase_interval_t a)
2845 {
2846         Lisp_Object args[2];
2847         Lisp_Object result;
2848
2849         if (a == NULL)
2850                 return Qzero;
2851
2852         if (a->lower == a->upper) {
2853                 /* special case of 1 point intervals */
2854                 if (INTEGERP(a->lower))
2855                         return make_int(1);
2856                 else
2857                         return Qzero;
2858         }
2859
2860         if (_ase_equal_p((args[0] = Ftruncate(a->upper)), a->upper))
2861                 args[0] = Fsub1(a->upper);
2862         args[1] = Ftruncate(a->lower);
2863
2864         /* care for alternation of the signum */
2865         if (!NILP(Fnonnegativep(a->upper)) &&
2866             NILP(Fnonnegativep(a->lower)) &&
2867             !_ase_equal_p(args[1], a->lower))
2868                 args[1] = Fsub1(args[1]);
2869
2870         result = ent_binop_many(ASE_BINARY_OP_DIFF, countof(args), args);
2871
2872         if (INTEGERP(a->upper) && !a->upper_open_p)
2873                 result = Fadd1(result);
2874         if (INTEGERP(a->lower) && !a->lower_open_p)
2875                 result = Fadd1(result);
2876
2877         return result;
2878 }
2879
2880 static inline void
2881 _ase_interval_update_rational(ase_interval_t a)
2882 {
2883         if (a && NILP(a->rational_measure))
2884                 a->rational_measure = _ase_interval_compute_rational(a);
2885         return;
2886 }
2887
2888 static inline Lisp_Object
2889 _ase_interval_rational(ase_interval_t a)
2890 {
2891         if (a)
2892                 return a->rational_measure;
2893         else
2894                 return Qzero;
2895 }
2896
2897 static int
2898 __ase_interval_interior_update_lebesgue(ase_cartesian_t c)
2899 {
2900         int i = 0, dim = ase_cartesian_dimension(c);
2901         for (i = 0; i < dim; i++) {
2902                 _ase_interval_update_lebesgue(
2903                         XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2904         }
2905         return dim;
2906 }
2907
2908 static Lisp_Object
2909 __ase_interval_interior_lebesgue(ase_cartesian_t c)
2910 {
2911         Lisp_Object *args;
2912         int i = 0, dim = __ase_interval_interior_update_lebesgue(c);
2913
2914         if (dim == 0)
2915                 return Qzero;
2916
2917         args = alloca_array(Lisp_Object, dim);
2918         for (i = 0; i < dim; i++) {
2919                 args[i] = _ase_interval_lebesgue(
2920                         XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2921         }
2922         return ent_binop_many(ASE_BINARY_OP_PROD, dim, args);
2923 }
2924
2925 static int
2926 __ase_interval_interior_update_rational(ase_cartesian_t c)
2927 {
2928         int i = 0, dim = ase_cartesian_dimension(c);
2929         for (i = 0; i < dim; i++) {
2930                 _ase_interval_update_rational(
2931                         XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2932         }
2933         return dim;
2934 }
2935
2936 static Lisp_Object
2937 __ase_interval_interior_rational(ase_cartesian_t c)
2938 {
2939         Lisp_Object *args;
2940         int i = 0, dim = __ase_interval_interior_update_rational(c);
2941
2942         if (dim == 0)
2943                 return Qzero;
2944
2945         args = alloca_array(Lisp_Object, dim);
2946         for (i = 0; i < dim; i++) {
2947                 args[i] = _ase_interval_rational(
2948                         XASE_INTERVAL(ase_cartesian_objects(c)[i]));
2949         }
2950         return ent_binop_many(ASE_BINARY_OP_PROD, dim, args);
2951 }
2952
2953 static void
2954 _ase_interval_interior_update_lebesgue(ase_cartesian_t c)
2955         __attribute__((always_inline));
2956 static inline void
2957 _ase_interval_interior_update_lebesgue(ase_cartesian_t c)
2958 {
2959         if (NILP(c->lebesgue_measure))
2960                 c->lebesgue_measure =
2961                         __ase_interval_interior_lebesgue(c);
2962         return;
2963 }
2964
2965 static Lisp_Object
2966 _ase_interval_interior_lebesgue(ase_cartesian_t c)
2967 {
2968         return c->lebesgue_measure;
2969 }
2970
2971 static void
2972 _ase_interval_interior_update_rational(ase_cartesian_t c)
2973 {
2974         if (NILP(c->rational_measure))
2975                 c->rational_measure =
2976                         __ase_interval_interior_rational(c);
2977         return;
2978 }
2979
2980 static inline Lisp_Object
2981 _ase_interval_interior_rational(ase_cartesian_t c)
2982 {
2983         return c->rational_measure;
2984 }
2985
2986 static inline int
2987 __ase_interval_union_update_lebesgue(ase_interval_union_item_t u)
2988         __attribute__((always_inline));
2989 static inline int
2990 __ase_interval_union_update_lebesgue(ase_interval_union_item_t u)
2991 {
2992         int i = 0;
2993         while (u) {
2994                 if (ASE_INTERVALP(u->current)) {
2995                         _ase_interval_update_lebesgue(
2996                                 XASE_INTERVAL(u->current));
2997                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
2998                         _ase_interval_interior_update_lebesgue(
2999                                 XASE_CARTESIAN(u->current));
3000                 }
3001                 u = u->next;
3002                 i++;
3003         }
3004         return i;
3005 }
3006
3007 static Lisp_Object
3008 __ase_interval_union_lebesgue(ase_interval_union_item_t u)
3009 {
3010         Lisp_Object *args;
3011         int i = 0, nargs = __ase_interval_union_update_lebesgue(u);
3012
3013         if (nargs == 0)
3014                 return Qzero;
3015
3016         args = alloca_array(Lisp_Object, nargs);
3017         while (u) {
3018                 if (ASE_INTERVALP(u->current)) {
3019                         args[i] = _ase_interval_lebesgue(
3020                                 XASE_INTERVAL(u->current));
3021                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
3022                         args[i] = _ase_interval_interior_lebesgue(
3023                                 XASE_CARTESIAN(u->current));
3024                 }
3025                 i++;
3026                 u = u->next;
3027         }
3028         return ent_binop_many(ASE_BINARY_OP_SUM, nargs, args);
3029 }
3030
3031 static int
3032 __ase_interval_union_update_rational(ase_interval_union_item_t u)
3033 {
3034         int i = 0;
3035         while (u) {
3036                 if (ASE_INTERVALP(u->current)) {
3037                         _ase_interval_update_rational(
3038                                 XASE_INTERVAL(u->current));
3039                 } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
3040                         _ase_interval_interior_update_rational(
3041                                 XASE_CARTESIAN(u->current));
3042                 }
3043                 u = u->next;
3044                 i++;
3045         }
3046         return i;
3047 }
3048
3049 static Lisp_Object
3050 __ase_interval_union_rational(ase_interval_union_item_t u)
3051 {
3052         int i = 0, nargs = __ase_interval_union_update_rational(u);
3053         if (nargs == 0)
3054                 return Qzero;
3055         {
3056                 Lisp_Object args[nargs];
3057                 for ( i = nargs; i > 0; )
3058                         args[--i] = Qnil;
3059
3060                 while (u) {
3061                         if (ASE_INTERVALP(u->current)) {
3062                                 args[i] = _ase_interval_rational(
3063                                         XASE_INTERVAL(u->current));
3064                         } else if (ASE_INTERVAL_INTERIOR_P(u->current)) {
3065                                 args[i] = _ase_interval_interior_rational(
3066                                         XASE_CARTESIAN(u->current));
3067                         }
3068                         i++;
3069                         u = u->next;
3070                 }
3071                 return ent_binop_many(ASE_BINARY_OP_SUM, nargs, args);
3072         }
3073 }
3074
3075 static inline void
3076 _ase_interval_union_update_lebesgue(ase_interval_union_t iu)
3077 {
3078         if (NILP(iu->lebesgue_measure))
3079                 iu->lebesgue_measure =
3080                         __ase_interval_union_lebesgue(ase_interval_union(iu));
3081         return;
3082 }
3083
3084 static inline Lisp_Object
3085 _ase_interval_union_lebesgue(ase_interval_union_t iu)
3086 {
3087         return iu->lebesgue_measure;
3088 }
3089
3090 static inline void
3091 _ase_interval_union_update_rational(ase_interval_union_t iu)
3092 {
3093         if (NILP(iu->rational_measure))
3094                 iu->rational_measure =
3095                         __ase_interval_union_rational(ase_interval_union(iu));
3096         return;
3097 }
3098
3099 static inline Lisp_Object
3100 _ase_interval_union_rational(ase_interval_union_t iu)
3101 {
3102         return iu->rational_measure;
3103 }
3104
3105 Lisp_Object
3106 ase_interval_lebesgue_measure(ase_interval_t a)
3107 {
3108         _ase_interval_update_lebesgue(a);
3109         return _ase_interval_lebesgue(a);
3110 }
3111
3112 Lisp_Object
3113 ase_interval_rational_measure(ase_interval_t a)
3114 {
3115         _ase_interval_update_rational(a);
3116         return _ase_interval_rational(a);
3117 }
3118
3119 Lisp_Object
3120 ase_interval_interior_lebesgue_measure(ase_cartesian_t c)
3121 {
3122         _ase_interval_interior_update_lebesgue(c);
3123         return _ase_interval_interior_lebesgue(c);
3124 }
3125
3126 Lisp_Object
3127 ase_interval_interior_rational_measure(ase_cartesian_t c)
3128 {
3129         _ase_interval_interior_update_rational(c);
3130         return _ase_interval_interior_rational(c);
3131 }
3132
3133 Lisp_Object
3134 ase_interval_union_lebesgue_measure(ase_interval_union_t iu)
3135 {
3136         _ase_interval_union_update_lebesgue(iu);
3137         return _ase_interval_union_lebesgue(iu);
3138 }
3139
3140 Lisp_Object
3141 ase_interval_union_rational_measure(ase_interval_union_t iu)
3142 {
3143         _ase_interval_union_update_rational(iu);
3144         return _ase_interval_union_rational(iu);
3145 }
3146
3147 /* arithmetical operations */
3148 /* I x Q -> I : (a, b) + x -> (a+x, b+x) */
3149 /* I x I -> I : (a, b) + (c, d) -> (a+c, b+d) */
3150 /* U x Q -> U : (a, b) u (c, d) + x -> (a, b) + x u (c, d) + x */
3151 /* U x I -> U : (a, b) u (c, d) + (e, f) -> (a, b) + (e, f) u (c, d) + (e, f) */
3152 /* 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 */
3153
3154 \f
3155 /* lisp level */
3156 DEFUN("ase-intervalp", Fase_intervalp, 1, 1, 0, /*
3157 Return non-`nil' iff OBJECT is an ase interval.
3158 */
3159       (object))
3160 {
3161         if (ASE_INTERVALP(object))
3162                 return Qt;
3163
3164         return Qnil;
3165 }
3166
3167 DEFUN("ase-interval-union-p", Fase_interval_union_p, 1, 1, 0, /*
3168 Return non-`nil' iff OBJECT is an ase interval or union thereof.
3169 */
3170       (object))
3171 {
3172         if (ASE_INTERVAL_OR_UNION_P(object))
3173                 return Qt;
3174
3175         return Qnil;
3176 }
3177
3178 DEFUN("ase-interval-empty-p", Fase_interval_empty_p, 1, 1, 0, /*
3179 Return non-`nil' iff INTERVAL is the empty interval.
3180 */
3181       (interval))
3182 {
3183         CHECK_ASE_INTERVAL(interval);
3184
3185         if (ASE_INTERVAL_EMPTY_P(interval))
3186                 return Qt;
3187
3188         return Qnil;
3189 }
3190
3191 DEFUN("ase-interval-imprimitive-p", Fase_interval_imprimitive_p, 1, 1, 0, /*
3192 Return non-`nil' iff INTERVAL is not a primitive interval.
3193 */
3194       (interval))
3195 {
3196         CHECK_ASE_UBERINTERVAL(interval);
3197
3198         if (ASE_INTERVALP(interval))
3199                 return Qnil;
3200
3201         return Qt;
3202 }
3203
3204 DEFUN("ase-interval-open-p", Fase_interval_open_p, 1, 1, 0, /*
3205 Return non-`nil' iff INTERVAL (or a union thereof) is an open set
3206 with respect to the standard topology.
3207 */
3208       (interval))
3209 {
3210         CHECK_ASE_UBERINTERVAL(interval);
3211
3212         if (ASE_INTERVALP(interval)) {
3213                 if (ASE_INTERVAL_EMPTY_P(interval))
3214                         return Qt;
3215                 if (ase_interval_open_p(interval))
3216                         return Qt;
3217         } else if (ASE_INTERVAL_UNION_P(interval)) {
3218                 if (ase_interval_union_open_p(interval))
3219                         return Qt;
3220         } else if (ASE_INTERVAL_INTERIOR_P(interval)) {
3221                 if (ase_interval_interior_open_p(interval))
3222                         return Qt;
3223         }
3224         return Qnil;
3225 }
3226
3227 DEFUN("ase-interval-closed-p", Fase_interval_closed_p, 1, 1, 0, /*
3228 Return non-`nil' iff INTERVAL (or a union thereof) is a closed set
3229 with respect to the standard metric.
3230
3231 An interval is said to be closed iff the complement is open.
3232 */
3233       (interval))
3234 {
3235         CHECK_ASE_UBERINTERVAL(interval);
3236
3237         if (ASE_INTERVALP(interval)) {
3238                 if (ASE_INTERVAL_EMPTY_P(interval))
3239                         return Qt;
3240                 if (ase_interval_closed_p(interval))
3241                         return Qt;
3242         } else if (ASE_INTERVAL_UNION_P(interval)) {
3243                 if (ase_interval_union_closed_p(interval))
3244                         return Qt;
3245         } else if (ASE_INTERVAL_INTERIOR_P(interval)) {
3246                 if (ase_interval_interior_closed_p(interval))
3247                         return Qt;
3248         }
3249         return Qnil;
3250 }
3251
3252
3253 /* constructors */
3254 /* ###autoload */
3255 DEFUN("ase-empty-interval", Fase_empty_interval, 0, 0, 0, /*
3256 Return the empty interval.
3257 */
3258       ())
3259 {
3260         return Qase_empty_interval;
3261 }
3262
3263 /* ###autoload */
3264 DEFUN("ase-universe-interval", Fase_universe_interval, 0, 0, 0, /*
3265 Return the universe interval.
3266 */
3267       ())
3268 {
3269         return Qase_universe_interval;
3270 }
3271
3272 /* ###autoload */
3273 DEFUN("ase-interval", Fase_interval, 1, 4, 0, /*
3274 Return a (primitive) interval with lower bound LOWER and upper bound UPPER.
3275 To construct a (degenerated) one point interval, leave out the UPPER part.
3276
3277 ASE's definition of an interval:
3278 With respect to a (strict) partial order, an interval is a connected
3279 subset of a poset.
3280
3281 If no special partial order is given, it defaults to less-equal-p (<=).
3282 If no special topology is given, it defaults to the po topology.
3283 */
3284       (lower, upper, lower_open_p, upper_open_p))
3285 {
3286         Lisp_Object result = Qnil;
3287         Lisp_Object args[2] = {lower, upper};
3288
3289         CHECK_COMPARABLE(lower);
3290         if (NILP(upper))
3291                 args[1] = upper = lower;
3292         else
3293                 CHECK_COMPARABLE(upper);
3294
3295         if (_ase_less_p(lower, upper))
3296                 result = ase_make_interval(
3297                         lower, upper, !NILP(lower_open_p), !NILP(upper_open_p));
3298         else
3299                 result = ase_make_interval(
3300                         upper, lower, !NILP(upper_open_p), !NILP(lower_open_p));
3301
3302         return result;
3303 }
3304
3305 DEFUN("ase-interval-contains-p", Fase_interval_contains_p, 2, 2, 0, /*
3306 Return non-`nil' iff INTERVAL (or a union thereof) contains OBJECT
3307 as one of its elements.  OBJECT can also be another interval or
3308 interval union to obtain the subset relation.
3309 */
3310       (interval, object))
3311 {
3312         ase_interval_type_t sup, sub;
3313         ase_element_relation_f relf = NULL;
3314
3315         CHECK_ASE_UBERINTERVAL(interval);
3316
3317         sup = ase_interval_type(interval);
3318         sub = ase_interval_type(object);
3319
3320         if ((relf = ase_optable_superset[sup][sub]) &&
3321             (!NILP(relf(interval, object))))
3322                 return Qt;
3323
3324         return Qnil;
3325 }
3326
3327 DEFUN("ase-interval-contains-where", Fase_interval_contains_where, 2, 2, 0, /*
3328 Return non-`nil' iff INTERVAL contains OBJECT as one of its elements.
3329 ELEMENT can also be another interval to obtain the subset relation.
3330
3331 The non-`nil' value returned is the primitive interval which
3332 contained OBJECT.
3333 */
3334       (interval, object))
3335 {
3336         ase_interval_type_t sup, sub;
3337         ase_element_relation_f relf = NULL;
3338
3339         CHECK_ASE_UBERINTERVAL(interval);
3340
3341         sup = ase_interval_type(interval);
3342         sub = ase_interval_type(object);
3343
3344         if ((relf = ase_optable_superset[sup][sub]))
3345                 return relf(interval, object);
3346
3347         return Qnil;
3348 }
3349
3350 DEFUN("ase-interval-connected-p", Fase_interval_connected_p, 0, MANY, 0, /*
3351 Return non-`nil' iff INTERVALS are connected.
3352 Arguments: &rest intervals
3353
3354 Zero intervals are trivially connected, as is one interval.
3355 */
3356       (int nargs, Lisp_Object *args))
3357 {
3358         /* trivial cases */
3359         if (nargs == 0)
3360                 return Qt;
3361
3362         switch (ase_interval_check_dimensions(nargs, args)) {
3363         case 0:
3364                 return Qt;
3365         case 1:
3366                 return ase_interval_connected_p_heapify(nargs, args);
3367         case -1:
3368                 signal_error(Qembed_error, Qnil);
3369                 return Qnil;
3370         default:
3371                 return ase_interval_connected_p_nsquare(nargs, args);
3372         }
3373 }
3374
3375 DEFUN("ase-interval-disjoint-p", Fase_interval_disjoint_p, 0, MANY, 0, /*
3376 Arguments: &rest intervals
3377 Return non-`nil' iff INTERVALS are (pairwise) disjoint.
3378
3379 Zero intervals are trivially disjoint, while one interval is
3380 trivially not disjoint.
3381 */
3382       (int nargs, Lisp_Object *args))
3383 {
3384         /* trivial cases */
3385         if (nargs == 0)
3386                 return Qt;
3387
3388         switch (ase_interval_check_dimensions(nargs, args)) {
3389         case 0:
3390                 return Qt;
3391         case -1:
3392                 signal_error(Qembed_error, Qnil);
3393                 return Qnil;
3394         default:
3395                 return ase_interval_disjoint_p_nsquare(nargs, args);
3396         }
3397 }
3398
3399 DEFUN("ase-interval-equal-p", Fase_interval_equal_p, 2, 2, 0, /*
3400 Return non-`nil' if I1 and I2 are equal in some sense, equality
3401 hereby means that I1 and I2 contain each other.
3402
3403 In fact, this is just a convenience function and totally equivalent
3404 to
3405   (and (ase-interval-contains-p i1 i2) (ase-interval-contains-p i2 i1))
3406 */
3407       (i1, i2))
3408 {
3409         Lisp_Object i1in2, i2in1;
3410
3411         CHECK_ASE_UBERINTERVAL(i1);
3412         CHECK_ASE_UBERINTERVAL(i2);
3413
3414         i1in2 = Fase_interval_contains_p(i1, i2);
3415         i2in1 = Fase_interval_contains_p(i2, i1);
3416
3417         if (!NILP(i1in2) && !NILP(i2in1))
3418                 return Qt;
3419
3420         return Qnil;
3421 }
3422
3423 /* more constructors */
3424 static Lisp_Object
3425 ase_interval_union_heapify(int nargs, Lisp_Object *args)
3426 {
3427         Lisp_Object result = Qnil, *newargs;
3428         int j, add = 0;
3429         struct ase_interval_union_item_s _ures, *ures = &_ures, *u;
3430         ase_interval_union_t ires;
3431
3432         /* check for ASE_INTERVALs and sort empty intervals to the tail */
3433         for (j = 0; j < nargs; ) {
3434                 if (ASE_INTERVAL_UNION_P(args[j])) {
3435                         /* remember the number of additional elements we need */
3436                         add += XASE_INTERVAL_UNION(args[j])->no_intv-1;
3437                         j++;
3438                 } else if (!ASE_INTERVAL_EMPTY_P(args[j])) {
3439                         j++;
3440                 } else {
3441                         _ase_swap(args, nargs-1, j);
3442                         nargs--;
3443                 }
3444         }
3445
3446         if (nargs == 0)
3447                 return Qase_empty_interval;
3448         if (nargs == 1)
3449                 return args[0];
3450
3451         if (add > 0) {
3452                 EMOD_ASE_DEBUG_INTV("exploding %d union items\n", add);
3453                 newargs = alloca_array(Lisp_Object, nargs+add);
3454                 /* move the first nargs args here */
3455                 memmove(newargs, args, nargs*sizeof(Lisp_Object));
3456                 /* now explode the whole story */
3457                 args = _ase_interval_union_explode_array(nargs, newargs, add);
3458                 nargs += add;
3459         }
3460
3461         /* sort intervals in less-p metric */
3462         _ase_heapsort(nargs, args, ase_interval_less_p);
3463
3464         /* we start with the empty union and unite left-associatively from
3465            the left */
3466         ures->current = Qase_empty_interval;
3467         u = ures->next = _ase_make_interval_union_item(args[0]);
3468         for (j = 1; j < nargs; j++) {
3469                 u = u->next = _ase_make_interval_union_item(args[j]);
3470         }
3471
3472         j = _ase_normalise_union(ures);
3473         if (j > 1) {
3474                 /* only return a union when there _is_ a union */
3475                 ires = _ase_make_interval_union(ures->next);
3476                 ires->no_intv = j;
3477
3478                 XSETASE_INTERVAL_UNION(result, ires);
3479                 return result;
3480         } else {
3481                 /* otherwise downgrade to a primitive interval */
3482                 result = ures->next->current;
3483                 _ase_interval_union_item_fini(ures->next);
3484                 return result;
3485         }
3486 }
3487
3488 static inline Lisp_Object
3489 ase_interval_union_nsquare(int nargs, Lisp_Object *args)
3490 {
3491         int i, j = 0;
3492         struct ase_interval_union_item_s _ures, *ures = &_ures, *u;
3493         ase_interval_union_t ires;
3494         Lisp_Object result = Qnil;
3495
3496         if (nargs == 0)
3497                 return Qase_empty_interval;
3498         else if (nargs == 1)
3499                 return args[0];
3500
3501         /* the slow approach */
3502         /* we start with the empty union and unite left-associatively from
3503            the left */
3504         ures->current = Qase_empty_interval;
3505         u = ures;
3506         for (i = 0; i < nargs; i++) {
3507                 Lisp_Object tmp = args[i];
3508                 if (ASE_INTERVAL_INTERIOR_P(tmp))
3509                         u = u->next = _ase_make_interval_union_item(tmp);
3510                 else if (ASE_INTERVAL_UNION_P(tmp)) {
3511                         ase_interval_union_item_t tra =
3512                                 XASE_INTERVAL_UNION_SER(tmp);
3513                         while (tra) {
3514                                 Lisp_Object c = tra->current;
3515                                 u = u->next = _ase_make_interval_union_item(c);
3516                                 tra = tra->next;
3517                         }
3518                 }
3519         }
3520
3521         j = _ase_normalise_union_intr(ures);
3522         if (j > 1) {
3523                 /* only return a union when there _is_ a union */
3524                 ires = _ase_make_interval_union(ures->next);
3525                 ires->no_intv = j;
3526
3527                 XSETASE_INTERVAL_UNION(result, ires);
3528                 return result;
3529         } else {
3530                 /* otherwise downgrade to a primitive interval */
3531                 result = ures->next->current;
3532                 _ase_interval_union_item_fini(ures->next);
3533                 return result;
3534         }
3535 }
3536
3537 DEFUN("ase-interval-union", Fase_interval_union, 0, MANY, 0, /*
3538 Arguments: &rest intervals
3539 Return the union of all INTERVALS.
3540 */
3541       (int nargs, Lisp_Object *args))
3542 {
3543         int dim;
3544
3545         /* trivial cases */
3546         if (nargs == 0)
3547                 return Qase_empty_interval;
3548
3549         dim = ase_interval_check_dimensions(nargs, args);
3550         switch (dim) {
3551         case 0:
3552                 return Qase_empty_interval;
3553         case 1:
3554                 return ase_interval_union_heapify(nargs, args);
3555         case -1:
3556                 signal_error(Qembed_error, Qnil);
3557                 return Qnil;
3558         default:
3559                 return ase_interval_union_nsquare(nargs, args);
3560         }
3561 }
3562
3563 static int
3564 ase_interval_intersection_maybe_empty(int nargs, Lisp_Object *args)
3565 {
3566         /* check for empty intervals, return 1 if there are some */
3567         int j;
3568
3569         for (j = 0; j < nargs; j++) {
3570                 if (ASE_INTERVAL_EMPTY_P(args[j])) {
3571                         return 1;
3572                 }
3573         }
3574         return 0;
3575 }
3576
3577 static Lisp_Object
3578 ase_interval_intersection_heapify(int nargs, Lisp_Object *args)
3579 {
3580         int j;
3581
3582         if (nargs == 0)
3583                 return Qase_empty_interval;
3584         else if (nargs == 1)
3585                 return args[0];
3586         else if (ase_interval_intersection_maybe_empty(nargs, args))
3587                 return Qase_empty_interval;
3588
3589         _ase_heapsort(nargs, args, ase_interval_or_union_less_p);
3590
3591         /* we start with the universe and intersect left-associatively from
3592            the left */
3593         for (j = 1; j < nargs; j++) {
3594                 ase_interval_type_t t1 = ase_interval_type(args[0]);
3595                 ase_interval_type_t t2 = ase_interval_type(args[j]);
3596                 ase_binary_operation_f opf = ase_optable_intersect[t1][t2];
3597
3598                 if (opf) {
3599                         args[0] = opf(args[0], args[j]);
3600                 }
3601         }
3602
3603         return args[0];
3604 }
3605
3606 static Lisp_Object
3607 ase_interval_intersection_nsquare(int nargs, Lisp_Object *args)
3608 {
3609         int j;
3610
3611         if (nargs == 0)
3612                 return Qase_empty_interval;
3613         else if (nargs == 1)
3614                 return args[0];
3615         else if (ase_interval_intersection_maybe_empty(nargs, args))
3616                 return Qase_empty_interval;
3617
3618         /* we start with the universe and intersect left-associatively from
3619            the left */
3620         for (j = 1; j < nargs; j++) {
3621                 ase_interval_type_t t1 = ase_interval_type(args[0]);
3622                 ase_interval_type_t t2 = ase_interval_type(args[j]);
3623                 ase_binary_operation_f opf = ase_optable_intersect[t1][t2];
3624
3625                 if (opf) {
3626                         args[0] = opf(args[0], args[j]);
3627                 }
3628         }
3629
3630         return args[0];
3631 }
3632
3633 DEFUN("ase-interval-intersection", Fase_interval_intersection, 0, MANY, 0, /*
3634 Arguments: &rest intervals
3635 Return the intersection of all INTERVALS.
3636 */
3637       (int nargs, Lisp_Object *args))
3638 {
3639         /* trivial cases */
3640         if (nargs == 0)
3641                 return Qase_empty_interval;
3642         else if (nargs == 1)
3643                 return args[0];
3644
3645         switch (ase_interval_check_dimensions(nargs, args)) {
3646         case 0:
3647                 return Qase_empty_interval;
3648         case 1:
3649                 return ase_interval_intersection_heapify(nargs, args);
3650         case -1:
3651                 signal_error(Qembed_error, Qnil);
3652                 return Qnil;
3653         default:
3654                 return ase_interval_intersection_nsquare(nargs, args);
3655         }
3656 }
3657
3658 static inline Lisp_Object
3659 ase_interval_difference_nsquare(int nargs, Lisp_Object *args)
3660 {
3661         int j;
3662
3663         /* check for ASE_INTERVALs and sort empty intervals to the tail */
3664         for (j = 1; j < nargs; j++) {
3665                 /* we can only resort empty intervals for j >= 1 */
3666                 if (ASE_INTERVAL_EMPTY_P(args[j])) {
3667                         _ase_swap(args, nargs-1, j);
3668                         nargs--;
3669                 }
3670         }
3671
3672         if (nargs == 0)
3673                 return Qase_empty_interval;
3674         if (nargs == 1)
3675                 return args[0];
3676
3677         /* we must not use heapsort here, since subtracting sets is
3678          * not commutative */
3679
3680         /* we start with args[0] and subtract left-associatively from
3681            the left */
3682         for (j = 1; j < nargs; j++) {
3683                 ase_interval_type_t t1 = ase_interval_type(args[0]);
3684                 ase_interval_type_t t2 = ase_interval_type(args[j]);
3685                 ase_binary_operation_f opf = ase_optable_subtract[t1][t2];
3686
3687                 if (opf) {
3688                         args[0] = opf(args[0], args[j]);
3689                 }
3690         }
3691
3692         return args[0];
3693 }
3694
3695 DEFUN("ase-interval-difference", Fase_interval_difference, 0, MANY, 0, /*
3696 Arguments: &rest intervals
3697 Return the difference of all INTERVALS from left to right.
3698 */
3699       (int nargs, Lisp_Object *args))
3700 {
3701         /* Treat the case args[0] = ( ) specially */
3702         if (nargs == 0)
3703                 return Qase_empty_interval;
3704         else if (nargs == 1)
3705                 return args[0];
3706
3707         switch (ase_interval_check_dimensions(nargs, args)) {
3708         case 0:
3709                 return Qase_empty_interval;
3710         case -1:
3711                 signal_error(Qembed_error, Qnil);
3712                 return Qnil;
3713         default:
3714                 return ase_interval_difference_nsquare(nargs, args);
3715         }
3716 }
3717
3718 DEFUN("ase-copy-interval", Fase_copy_interval, 1, 1, 0, /*
3719 Return a copy of INTERVAL.
3720 */
3721       (interval))
3722 {
3723         CHECK_ASE_INTERVAL(interval);
3724
3725         return ase_copy_interval(interval);
3726 }
3727
3728 DEFUN("ase-interval-boundary", Fase_interval_boundary, 1, 1, 0, /*
3729 Return the boundary of INTERVAL, that is the interior of INTERVAL
3730 subtracted from the closure of INTERVAL.
3731 */
3732       (interval))
3733 {
3734         CHECK_ASE_UBERINTERVAL(interval);
3735
3736         if (ASE_INTERVAL_EMPTY_P(interval))
3737                 return Qase_empty_interval;
3738         else if (ASE_INTERVALP(interval))
3739                 return ase_interval_boundary(interval);
3740         else if (ASE_INTERVAL_INTERIOR_P(interval))
3741                 return ase_interval_interior_boundary(interval);
3742         else if (ASE_INTERVAL_UNION_P(interval))
3743                 return ase_interval_union_boundary(interval);
3744
3745         return Qnil;
3746 }
3747
3748 DEFUN("ase-interval-closure", Fase_interval_closure, 1, 1, 0, /*
3749 Return the closure of INTERVAL, that is the smallest closed set
3750 that contains INTERVAL.
3751 */
3752       (interval))
3753 {
3754         CHECK_ASE_UBERINTERVAL(interval);
3755
3756         if (ASE_INTERVAL_EMPTY_P(interval))
3757                 return Qase_empty_interval;
3758         else if (ASE_INTERVALP(interval))
3759                 return ase_interval_closure(interval);
3760         else if (ASE_INTERVAL_INTERIOR_P(interval))
3761                 return ase_interval_interior_closure(interval);
3762         else if (ASE_INTERVAL_UNION_P(interval))
3763                 return ase_interval_union_closure(interval);
3764
3765         return Qnil;
3766 }
3767
3768 DEFUN("ase-interval-interior", Fase_interval_interior, 1, 1, 0, /*
3769 Return the interior of INTERVAL, that is the largest open set that
3770 is contained in INTERVAL.
3771 */
3772       (interval))
3773 {
3774         CHECK_ASE_UBERINTERVAL(interval);
3775
3776         if (ASE_INTERVAL_EMPTY_P(interval))
3777                 return Qase_empty_interval;
3778         else if (ASE_INTERVALP(interval))
3779                 return ase_interval_interior(interval);
3780         else if (ASE_INTERVAL_INTERIOR_P(interval))
3781                 return ase_interval_interior_interior(interval);
3782         else if (ASE_INTERVAL_UNION_P(interval))
3783                 return ase_interval_union_interior(interval);
3784
3785         return Qnil;
3786 }
3787
3788 /* Accessors */
3789 DEFUN("ase-interval-lower", Fase_interval_lower, 1, 1, 0, /*
3790 Return the lower bound of INTERVAL or `nil' if empty.
3791 Only the numerical value is returned.
3792 */
3793       (interval))
3794 {
3795         CHECK_ASE_INTERVAL(interval);
3796
3797         if (ASE_INTERVAL_EMPTY_P(interval))
3798                 return Qnil;
3799
3800         return XASE_INTERVAL(interval)->lower;
3801 }
3802
3803 DEFUN("ase-interval-upper", Fase_interval_upper, 1, 1, 0, /*
3804 Return the upper bound of INTERVAL or `nil' if empty.
3805 Only the numerical value is returned.
3806 */
3807       (interval))
3808 {
3809         CHECK_ASE_INTERVAL(interval);
3810
3811         if (ASE_INTERVAL_EMPTY_P(interval))
3812                 return Qnil;
3813
3814         return XASE_INTERVAL(interval)->upper;
3815 }
3816
3817 DEFUN("ase-interval-lower*", Fase_interval_lower_, 1, 1, 0, /*
3818 Return the lower bound of INTERVAL or `nil' if empty
3819 along with the boundary shape.
3820 */
3821       (interval))
3822 {
3823         Lisp_Object res;
3824
3825         CHECK_ASE_INTERVAL(interval);
3826         if (ASE_INTERVAL_EMPTY_P(interval))
3827                 return Qnil;
3828
3829         res = XASE_INTERVAL(interval)->lower;
3830         if (XASE_INTERVAL(interval)->lower_open_p)
3831                 return Fcons(Q_open, res);
3832         else
3833                 return Fcons(Q_closed, res);
3834 }
3835
3836 DEFUN("ase-interval-upper*", Fase_interval_upper_, 1, 1, 0, /*
3837 Return the upper bound of INTERVAL or `nil' if empty
3838 along with the boundary shape.
3839 */
3840       (interval))
3841 {
3842         Lisp_Object res;
3843
3844         CHECK_ASE_INTERVAL(interval);
3845         if (ASE_INTERVAL_EMPTY_P(interval))
3846                 return Qnil;
3847
3848         res = XASE_INTERVAL(interval)->upper;
3849         if (XASE_INTERVAL(interval)->upper_open_p)
3850                 return Fcons(Q_open, res);
3851         else
3852                 return Fcons(Q_closed, res);
3853 }
3854
3855 DEFUN("ase-interval-explode-union", Fase_interval_explode_union, 1, 1, 0, /*
3856 Return IUNION exploded into primitive intervals and listed in a dllist.
3857 */
3858       (iunion))
3859 {
3860         Lisp_Object result = Qnil;
3861         dllist_t resdll = make_dllist();
3862         ase_interval_union_item_t u;
3863
3864         CHECK_ASE_INTERVAL_UNION(iunion);
3865         u = XASE_INTERVAL_UNION_SER(iunion);
3866         while (u) {
3867                 dllist_append(resdll, (void*)u->current);
3868                 u = u->next;
3869         }
3870
3871         XSETDLLIST(result, resdll);
3872         return result;
3873 }
3874
3875
3876 /* Measures */
3877 DEFUN("ase-interval-lebesgue-measure",
3878       Fase_interval_lebesgue_measure, 1, 1, 0, /*
3879 Return the Lebesgue measure of INTERVAL.
3880 */
3881       (interval))
3882 {
3883         CHECK_ASE_UBERINTERVAL(interval);
3884
3885         if (ASE_INTERVALP(interval))
3886                 return ase_interval_lebesgue_measure(XASE_INTERVAL(interval));
3887         else if (ASE_INTERVAL_INTERIOR_P(interval))
3888                 return ase_interval_interior_lebesgue_measure(
3889                         XASE_CARTESIAN(interval));
3890         else if (ASE_INTERVAL_UNION_P(interval))
3891                 return ase_interval_union_lebesgue_measure(
3892                         XASE_INTERVAL_UNION(interval));
3893         return Qnil;
3894 }
3895
3896 DEFUN("ase-interval-rational-measure",
3897       Fase_interval_rational_measure, 1, 1, 0, /*
3898 Return the number of rational integers in INTERVAL.
3899 */
3900       (interval))
3901 {
3902         CHECK_ASE_UBERINTERVAL(interval);
3903
3904         if (ASE_INTERVALP(interval))
3905                 return ase_interval_rational_measure(XASE_INTERVAL(interval));
3906         else if (ASE_INTERVAL_INTERIOR_P(interval))
3907                 return ase_interval_interior_rational_measure(
3908                         XASE_CARTESIAN(interval));
3909         else if (ASE_INTERVAL_UNION_P(interval))
3910                 return ase_interval_union_rational_measure(
3911                         XASE_INTERVAL_UNION(interval));
3912         return Qnil;
3913 }
3914
3915 DEFUN("ase-interval-dump", Fase_interval_dump, 1, 1, 0, /*
3916 */
3917       (interval))
3918 {
3919         CHECK_ASE_INTERVAL_OR_UNION(interval);
3920
3921         if (ASE_INTERVALP(interval)) {
3922                 ase_interval_prnt(interval, Qexternal_debugging_output, 0);
3923                 write_c_string("\n", Qexternal_debugging_output);
3924                 return Qt;
3925         } else {
3926                 ase_interval_union_prnt(
3927                         interval, Qexternal_debugging_output, 0);
3928                 write_c_string("\n", Qexternal_debugging_output);
3929                 return Qt;
3930         }
3931 }
3932
3933 \f
3934 static inline Lisp_Object
3935 ase_interval_add_i_obj(Lisp_Object intv, Lisp_Object number)
3936 {
3937         int lopenp = XASE_INTERVAL(intv)->lower_open_p;
3938         int uopenp = XASE_INTERVAL(intv)->upper_open_p;
3939         int lequp = XASE_INTERVAL(intv)->lower_eq_upper_p;
3940         Lisp_Object args[2] = {Qnil, number};
3941         Lisp_Object newl, newu;
3942
3943         args[0] = XASE_INTERVAL(intv)->lower;
3944         newl = ent_binop(ASE_BINARY_OP_SUM, args[0], args[1]);
3945         if (!lequp) {
3946                 args[0] = XASE_INTERVAL(intv)->upper;
3947                 newu = ent_binop(ASE_BINARY_OP_SUM, args[0], args[1]);
3948                 return ase_make_interval(newl, newu, lopenp, uopenp);
3949         } else {
3950                 return ase_make_interval(newl, newl, lopenp, uopenp);
3951         }
3952 }
3953
3954 static inline Lisp_Object
3955 ase_interval_add_obj_i(Lisp_Object number, Lisp_Object intv)
3956 {
3957         return ase_interval_add_i_obj(intv, number);
3958 }
3959
3960 \f
3961 /* initialiser stuff */
3962 static inline void
3963 ase_interval_binary_optable_init(void)
3964 {
3965         int idx = ase_optable_index_typesym(Qase_interval);
3966         ent_binop_register(ASE_BINARY_OP_SUM,
3967                            idx, INT_T, ase_interval_add_i_obj);
3968         ent_binop_register(ASE_BINARY_OP_SUM,
3969                            INT_T, idx, ase_interval_add_obj_i);
3970         ent_binop_register(ASE_BINARY_OP_SUM,
3971                            idx, FLOAT_T, ase_interval_add_obj_i);
3972         ent_binop_register(ASE_BINARY_OP_SUM,
3973                            FLOAT_T, idx, ase_interval_add_obj_i);
3974 }
3975
3976 void
3977 EMOD_PUBINIT(void)
3978 {
3979         /* constructors */
3980         DEFSUBR(Fase_empty_interval);
3981         DEFSUBR(Fase_universe_interval);
3982         DEFSUBR(Fase_interval);
3983         DEFSUBR(Fase_interval_union);
3984         DEFSUBR(Fase_interval_intersection);
3985         DEFSUBR(Fase_interval_difference);
3986         DEFSUBR(Fase_copy_interval);
3987         DEFSUBR(Fase_interval_boundary);
3988         DEFSUBR(Fase_interval_interior);
3989         DEFSUBR(Fase_interval_closure);
3990         /* predicates */
3991         DEFSUBR(Fase_intervalp);
3992         DEFSUBR(Fase_interval_union_p);
3993         DEFSUBR(Fase_interval_empty_p);
3994         DEFSUBR(Fase_interval_imprimitive_p);
3995         DEFSUBR(Fase_interval_open_p);
3996         DEFSUBR(Fase_interval_closed_p);
3997         DEFSUBR(Fase_interval_contains_p);
3998         DEFSUBR(Fase_interval_contains_where);
3999         DEFSUBR(Fase_interval_connected_p);
4000         DEFSUBR(Fase_interval_disjoint_p);
4001         DEFSUBR(Fase_interval_equal_p);
4002         /* accessors */
4003         DEFSUBR(Fase_interval_lower);
4004         DEFSUBR(Fase_interval_lower_);
4005         DEFSUBR(Fase_interval_upper);
4006         DEFSUBR(Fase_interval_upper_);
4007         DEFSUBR(Fase_interval_explode_union);
4008         /* measures */
4009         DEFSUBR(Fase_interval_lebesgue_measure);
4010         DEFSUBR(Fase_interval_rational_measure);
4011
4012         DEFASETYPE_WITH_OPS(Qase_interval, "ase:interval");
4013         defsymbol(&Qase_intervalp, "ase:intervalp");
4014         DEFASETYPE_WITH_OPS(Qase_interval_union, "ase:interval-union");
4015         defsymbol(&Qase_interval_union_p, "ase:interval-union-p");
4016
4017         defsymbol(&Q_less, ":<");
4018         defsymbol(&Q_greater, ":>");
4019         defsymbol(&Q_eql, ":=");
4020         DEFKEYWORD(Q_unknown);
4021         DEFKEYWORD(Q_open);
4022         DEFKEYWORD(Q_closed);
4023         DEFKEYWORD(Q_disjoint);
4024         DEFKEYWORD(Q_connected);
4025
4026         /* debugging */
4027         DEFSUBR(Fase_interval_dump);
4028
4029         ase_interval_binary_optable_init();
4030
4031         EMOD_PUBREINIT();
4032
4033         DEFVAR_CONST_LISP("ase-empty-interval", &Qase_empty_interval /*
4034 The interval which contains no elements.
4035                                                                      */);
4036         DEFVAR_CONST_LISP("ase-universe-interval", &Qase_universe_interval /*
4037 The interval which contains all elements.
4038                                                                            */);
4039
4040         Fprovide(intern("ase-interval"));
4041         return;
4042 }
4043
4044 void
4045 EMOD_PUBREINIT(void)
4046 {
4047         Qase_empty_interval = ase_empty_interval();
4048         Qase_universe_interval = ase_universe_interval();
4049         staticpro(&Qase_empty_interval);
4050         staticpro(&Qase_universe_interval);
4051
4052         if (LIKELY(ase_empty_sets != NULL)) {
4053                 dllist_append(ase_empty_sets, (void*)Qase_empty_interval);
4054         } else {
4055                 EMOD_ASE_CRITICAL("Cannot proclaim empty elements\n");
4056         }
4057         return;
4058 }
4059
4060 void
4061 EMOD_PUBDEINIT(void)
4062 {
4063         Frevoke(intern("ase-interval"));
4064         return;
4065 }
4066
4067 /* ase-interval ends here */