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

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