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